diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/boot-pkg.lisp | 1 | ||||
| -rw-r--r-- | src/interp/define.boot | 34 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 5 | ||||
| -rw-r--r-- | src/interp/sys-driver.boot | 1 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 6 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 3 | ||||
| -rw-r--r-- | src/lisp/core.lisp.in | 6 |
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))) |