* 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.

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))))