diff options
Diffstat (limited to 'src/interp')
| -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 |
6 files changed, 33 insertions, 17 deletions
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) |