From 29c64f74f12bbeebb82045b08db420d2d2b60cf7 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 18 Nov 2008 20:33:50 +0000
Subject: 	* 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.

---
 src/interp/define.boot | 34 +++++++++++++++++++++-------------
 1 file changed, 21 insertions(+), 13 deletions(-)

(limited to 'src/interp/define.boot')

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
-- 
cgit v1.2.3