* interp/sys-utility.boot (loadExports): New.

	* interp/sys-driver.boot (initializeGlobalState): Set
	$compileDefaultsOnly.
	* interp/lisplib.boot (isFunctor): Load exports file if present.
	* interp/define.boot (compDefineCategory2): Don't write out
	category load time stuff if we are compiling only defaults.
	* interp/boot-pkg.lisp: Import loadFileIfPresent.
	* lisp/core.lisp.in (|loadFileIfPresent|): New.
	(|loadIfPresent|): Use it.

8 files changed, 50 insertions, 18 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index f9328308..580f35bf 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,17 @@
 2008-11-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/sys-utility.boot (loadExports): New.
+	* interp/sys-driver.boot (initializeGlobalState): Set
+	$compileDefaultsOnly.
+	* interp/lisplib.boot (isFunctor): Load exports file if present.
+	* interp/define.boot (compDefineCategory2): Don't write out
+	category load time stuff if we are compiling only defaults.
+	* interp/boot-pkg.lisp: Import loadFileIfPresent.
+	* lisp/core.lisp.in (|loadFileIfPresent|): New.
+	(|loadIfPresent|): Use it.
+
+2008-11-18  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/nrunfast.boot (resolveNiladicConstructors): New.
 	(newHasTest): Use it to handle signature export test.
 	* testsuite/interpreter/has.input: New.
diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp
index 5cb96d12..da92dd24 100644
--- a/src/interp/boot-pkg.lisp
+++ b/src/interp/boot-pkg.lisp
@@ -42,6 +42,7 @@
 		"systemLibraryDirectory"
 		"loadNativeModule"
 		"loadSystemRuntimeCore"
+		"loadFileIfPresent"
                 "$InteractiveMode"
 		"string2BootTree"))
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 5526a3fb..bfcfa996 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -358,7 +358,11 @@ compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
     $insideCategoryPackageIfTrue: local := true
     $categoryPredicateList: local :=
         makeCategoryPredicates(form,$lisplibCategory)
-    compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
+    T := compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
+           or return stackSemanticError(
+                        ['"cannot compile defaults of",:bright opOf form],nil)
+    if $compileDefaultsOnly then 
+      [d,m,e] := T
   [d,m,e]
 
 $tvl := []
@@ -470,15 +474,19 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     pairlis:= [[a,:v] for a in argl for v in $FormalMapVariableList]
     parSignature:= SUBLIS(pairlis,signature')
     parForm:= SUBLIS(pairlis,form)
-    lisplibWrite('"compilerInfo",
-      removeZeroOne ['SETQ,'$CategoryFrame,
-       ['put,['QUOTE,op'],'
-        (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
-          MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
-    --Equivalent to the following two lines, we hope
-    if null sargl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
+    -- If we are only interested in the defaults, there is no point
+    -- in writing out compiler info and load-time stuff for 
+    --the category which is assumed to have already been translated.
+    if not $compileDefaultsOnly then
+      lisplibWrite('"compilerInfo",
+        removeZeroOne ['SETQ,'$CategoryFrame,
+         ['put,['QUOTE,op'],'
+          (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
+            MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
+      --Equivalent to the following two lines, we hope
+      if null sargl then
+        evalAndRwriteLispForm('NILADIC,
+              ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
  
 --   6. put modemaps into InteractiveModemapFrame
     $domainShell := eval [op',:MAPCAR('MKQ,sargl)]
@@ -510,9 +518,9 @@ compDefineCategory(df,m,e,prefix,fal) ==
   ctor := opOf second df
   kind := getConstructorKindFromDB ctor
   kind ^= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
-  not $insideFunctorIfTrue and $LISPLIB =>
-    compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
-  compDefineCategory1(df,m,e,prefix,fal)
+  $insideFunctorIfTrue or not $LISPLIB or $compileDefaultsOnly =>
+    compDefineCategory1(df,m,e,prefix,fal)
+  compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
 
 
 %CatObjRes                   -- result of compiling a category
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 5619a231..fe0972da 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -648,11 +648,10 @@ isFunctor x ==
     MEMQ(getConstructorKindFromDB op,'(domain package))
   u:= get(op,'isFunctor,$CategoryFrame)
     or MEMQ(op,'(SubDomain Union Record Enumeration)) => u
-  constructor? op =>
-    prop := get(op,'isFunctor,$CategoryFrame) => prop
+  ab := getConstructorAbbreviationFromDB op =>
     if getConstructorKindFromDB op = "category"
       then updateCategoryFrameForCategory op
-      else updateCategoryFrameForConstructor op
+      else loadExports ab or updateCategoryFrameForConstructor op
     get(op,'isFunctor,$CategoryFrame)
   nil
 
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 7e3284fd..9a53ca2f 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -191,6 +191,7 @@ initializeGlobalState() ==
   $verbose := getOptionValue "verbose"
   $bootStrapMode := getOptionValue "bootstrap"
   $compileExportsOnly := getOptionValue "exports-only"
+  $compileDefaultsOnly := getOptionValue "defaults-only"
   GCMSG(NIL)
   if have_to then
     $superHash := MAKE_-HASHTABLE('UEQUAL)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 3c8d32c0..5f71143d 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -483,8 +483,12 @@ $buildingSystemAlgebra := false
 ++ code generation, etc.
 $verbose := true
 
-++ True if the compiler is invoked to produced only exports of
+++ True if the compiler is invoked to produce only exports of
 ++ a domain or a category.  For a category, the compilation of
 ++ defaults, if any, is suppressed.
 $compileExportsOnly := false
 
+++ True if the compiler is invoked to produce implementation
+++ of category defaults only.  This is meaningful only when
+++ compiling categories.
+$compileDefaultsOnly := false
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index e352786b..9b01dae7 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -206,6 +206,9 @@ loadModule(path,name) ==
   FMAKUNBOUND name
   LOAD path
 
+loadExports name ==
+  loadFileIfPresent strconc(STRING name,'".sig")
+
 --% numerics
 log10 x ==
   LOG(x,10)
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index a030755a..bf32b60f 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -93,6 +93,7 @@
            "ensureTrailingSlash"
            "getOutputPathname"
            "loadPathname"
+	   "loadFileIfPresent"
            "compileLispFile"
            "compileLispHandler"
            "Option"
@@ -907,10 +908,13 @@
                  :name module
 		 :type "btx"))
 
+(defun |loadFileIfPresent| (file)
+  (load file :if-does-not-exist nil))
+
 (defun |loadIfPresent| (module)
   (if (|alreadyLoaded?| module)
       module
-    (when (load module :if-does-not-exist nil)
+    (when (|loadFileIfPresent| module)
       (|noteUnitLoaded| module)
       module)))