aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/boot-pkg.lisp1
-rw-r--r--src/interp/define.boot34
-rw-r--r--src/interp/lisplib.boot5
-rw-r--r--src/interp/sys-driver.boot1
-rw-r--r--src/interp/sys-globals.boot6
-rw-r--r--src/interp/sys-utility.boot3
-rw-r--r--src/lisp/core.lisp.in6
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)))