aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog14
-rw-r--r--src/interp/Makefile.in5
-rw-r--r--src/interp/define.boot14
-rw-r--r--src/interp/lisplib.boot18
-rw-r--r--src/interp/sys-driver.boot11
-rw-r--r--src/interp/sys-globals.boot5
-rw-r--r--src/interp/sys-macros.lisp5
-rw-r--r--src/interp/sys-utility.boot3
-rw-r--r--src/lisp/core.lisp.in4
9 files changed, 66 insertions, 13 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 4500762e..68248438 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
2008-11-16 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * lisp/core.lisp.in (|getOptionValue|): Make second argument optional.
+ * interp/sys-driver.boot (initializeGlobalState): Set
+ $compileExportsOnly.
+ * interp/lisplib.boot (compDefineExports): New.
+ * interp/define.boot (skipCategoryPackage?): New.
+ (compDefineCategory1): Use it.
+ (compDefineFunctor): Don't compile to NRLIB if interested only in
+ exports.
+ (compDefineFunctor1): Honor $compileExportsOnly.
+ * interp/sys-macros.lisp (|withOutputFile|): New.
+ * interp/sys-utility.boot (quoteForm): Likewise.
+
+2008-11-16 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/define.boot: More cleanup.
* interp/iterator.boot: Likewise.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index bac06488..4c6bf1a3 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -306,11 +306,12 @@ compiler.$(FASLEXT): msgdb.$(FASLEXT) \
pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
nrunopt.$(FASLEXT): c-util.$(FASLEXT)
nrunfast.$(FASLEXT): c-util.$(FASLEXT)
-nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
+nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) \
+ simpbool.$(FASLEXT) functor.$(FASLEXT)
nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
iterator.$(FASLEXT): g-util.$(FASLEXT)
define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \
- functor.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT)
+ nruncomp.$(FASLEXT) database.$(FASLEXT)
database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
functor.$(FASLEXT): category.$(FASLEXT) nrungo.$(FASLEXT) lisplib.$(FASLEXT)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index c32b0c07..8b9b5677 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -341,6 +341,12 @@ mkEvalableCategoryForm c ==
m=$Category => x
MKQ c
+++ Return true if we should skip compilation of category package.
+++ This situation happens either when there is no default, of we are in
+++ bootstrap mode, or we are compiling only for exports.
+skipCategoryPackage? capsule ==
+ null capsule or $bootStrapMode or $compileExportsOnly
+
compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
categoryCapsule :=
body is ['add,cat,capsule] =>
@@ -348,7 +354,7 @@ compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
capsule
nil
[d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
- if categoryCapsule and not $bootStrapMode then [.,.,e] :=
+ if not skipCategoryPackage? categoryCapsule then [.,.,e] :=
$insideCategoryPackageIfTrue: local := true
$categoryPredicateList: local :=
makeCategoryPredicates(form,$lisplibCategory)
@@ -523,8 +529,9 @@ compDefineFunctor(df,m,e,prefix,fal) ==
$profileCompiler: local := true
$profileAlist: local := nil
$mutableDomain: fluid := false
- $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
- compDefineFunctor1(df,m,e,prefix,fal)
+ $compileExportsOnly or not $LISPLIB =>
+ compDefineFunctor1(df,m,e,prefix,fal)
+ compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
m,$e,$prefix,$formalArgList) ==
@@ -575,6 +582,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
$e:= giveFormalParametersValues(argl,$e)
[ds,.,$e]:= compMakeCategoryObject(target,$e) or return
stackAndThrow('" cannot produce category object: %1pb",[target])
+ $compileExportsOnly => compDefineExports($op, ds, signature',$e)
$domainShell:= COPY_-SEQ ds
--+ copy needed since slot1 is reset; compMake.. can return a cached vector
attributeList := disallowNilAttribute ds.2 --see below under "loadTimeAlist"
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index f491569e..755e3f8e 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -35,7 +35,10 @@
import nlib
import c_-util
import debug
+
namespace BOOT
+module lisplib
+
++
$functionLocations := []
@@ -701,3 +704,18 @@ getIndexTable dir ==
-- index file doesn't exist but mark this directory as a Lisplib.
WITH_-OPEN_-FILE(stream(indexFile,KEYWORD::DIRECTION,KEYWORD::OUTPUT),
nil)
+
+--%
+compDefineExports(op,catobj,sig,e) ==
+ not $LISPLIB => systemErrorHere "compDefineExports"
+ libName := getConstructorAbbreviation op
+ exportsFile := strconc(STRING libName,'".sig")
+ removeFile exportsFile
+ withOutputFile(s,exportsFile,
+ PRETTYPRINT(
+ ["put", quoteForm op, quoteForm "isFunctor", quoteForm catobj.1,
+ ["addModemap", quoteForm op, quoteForm first sig,
+ quoteForm sig, true, quoteForm op,
+ ["put", quoteForm op, quoteForm "mode",
+ quoteForm ["Mapping",:sig], "$CategoryFrame"]]], s))
+ [op,["Mapping",:sig],e]
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 4d21a797..7e3284fd 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -187,10 +187,10 @@ initializeGlobalState() ==
$currentLine := nil
$NEWSPAD := true
$SPAD := true
- $buildingSystemAlgebra :=
- getOptionValue(Option '"system-algebra",%systemOptions())
- $verbose := getOptionValue(Option '"verbose",%systemOptions())
- $bootStrapMode := getOptionValue(Option '"bootstrap",%systemOptions())
+ $buildingSystemAlgebra := getOptionValue "system-algebra"
+ $verbose := getOptionValue "verbose"
+ $bootStrapMode := getOptionValue "bootstrap"
+ $compileExportsOnly := getOptionValue "exports-only"
GCMSG(NIL)
if have_to then
$superHash := MAKE_-HASHTABLE('UEQUAL)
@@ -268,8 +268,7 @@ compileSpadLibrary(progname,options,file) ==
$verbose := false
$ProcessInteractiveValue := true
$PrintCompilerMessageIfTrue := $verbose
- setCompilerOptimizations
- getOptionValue(Option '"optimize",%systemOptions())
+ setCompilerOptimizations getOptionValue "optimize"
CATCH($intTopLevel,
CATCH("SpadCompileItem",
CATCH($SpadReaderTag,compiler [file])))
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index ec56043b..3c8d32c0 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -483,3 +483,8 @@ $buildingSystemAlgebra := false
++ code generation, etc.
$verbose := true
+++ True if the compiler is invoked to produced only exports of
+++ a domain or a category. For a category, the compilation of
+++ defaults, if any, is suppressed.
+$compileExportsOnly := false
+
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index b66eb7c5..1564206b 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1313,5 +1313,10 @@
(make-synonym-stream '*standard-output*))))
,cmd))
+(defmacro |withOutputFile| (stream filespec form)
+ `(with-open-file (,stream ,filespec :direction :output
+ :if-exists :supersede)
+ ,form))
+
(defmacro |spadConstant| (dollar n)
`(spadcall (svref ,dollar (the fixnum ,n))))
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 073bc1c8..e352786b 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -274,3 +274,6 @@ closeFile file ==
makeByteBuffer(n,b == 0) ==
MAKE_-ARRAY(n,KEYWORD::ELEMENT_-TYPE,"%Byte",
KEYWORD::FILL_-POINTER,0, KEYWORD::INITIAL_-ELEMENT,b)
+
+quoteForm t ==
+ ["QUOTE",t]
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index af3f27d0..a030755a 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -344,8 +344,8 @@
(|Option| option))))
;; Returns the value specified for OPTION. Otherwise, return nil
-(defun |getOptionValue| (opt options)
- (let ((val (assoc opt options)))
+(defun |getOptionValue| (opt &optional (options (|%systemOptions|)))
+ (let ((val (assoc (|Option| opt) options)))
(cond (val (cdr val))
(t nil))))