diff options
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/define.boot | 35 | ||||
-rw-r--r-- | src/interp/sys-driver.boot | 3 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 5 |
3 files changed, 24 insertions, 19 deletions
diff --git a/src/interp/define.boot b/src/interp/define.boot index 876d57e9..6e60191e 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -914,9 +914,9 @@ mkEvalableCategoryForm c == ++ Return true if we should skip compilation of category package. ++ This situation happens either when there is no default, of we are in -++ bootstrap mode, or we are compiling only for exports. +++ bootstrap mode. skipCategoryPackage? capsule == - null capsule or $bootStrapMode or $compileExportsOnly + null capsule or $bootStrapMode compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) == categoryCapsule := @@ -1339,8 +1339,7 @@ compDefineFunctor(df,m,e,prefix,fal) == $profileCompiler: local := true $profileAlist: local := nil $mutableDomain: local := false - $compileExportsOnly or $LISPLIB = nil => - compDefineFunctor1(df,m,e,prefix,fal) + $LISPLIB = nil => compDefineFunctor1(df,m,e,prefix,fal) lhs := second df ctor := opOf lhs dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil @@ -1386,8 +1385,6 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $implicitParameters: local := inferConstructorImplicitParameters(argl,$e) [ds,.,$e]:= compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) - $compileExportsOnly => - compDefineExports(form, categoryExports ds, signature',$e) $domainShell: local := copyVector ds attributeList := categoryAttributes ds --see below under "loadTimeAlist" $condAlist: local := nil @@ -1485,19 +1482,33 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'%incomplete], true]) [fun,['Mapping,:signature'],originale] + +++ Finish the incomplete compilation of a functor body. +incompleteFunctorBody(form,m,body,e) == + -- The slot numbers from the category shell are bogus at this point. + -- Nullify them so people don't think they bear any meaningful + -- semantics (well, they should not think these are forwarding either). + ops := nil + for [opsig,pred,funsel] in categoryExports $domainShell repeat + if pred isnt 'T then + pred := simpBool pred + if funsel is [op,.,.] and op in '(ELT CONST) then + third(funsel) := nil + ops := [[opsig,pred,funsel],:ops] + $lisplibOperationAlist := listSort(function GGREATERP, ops, function first) + [bootStrapError(form, _/EDITFILE),m,e] + ++ Subroutine of compDefineFunctor1. Called to generate backend code ++ for a functor definition. compFunctorBody(body,m,e,parForm) == - $bootStrapMode => - [bootStrapError($functorForm, _/EDITFILE),m,e] + $bootStrapMode => incompleteFunctorBody($functorForm,m,body,e) clearCapsuleDirectory() -- start collecting capsule functions. T:= compOrCroak(body,m,e) $capsuleFunctionStack := reverse! $capsuleFunctionStack -- ??? Don't resolve default definitions, yet. - if $insideCategoryPackageIfTrue then - backendCompile $capsuleFunctionStack - else - backendCompile foldExportedFunctionReferences $capsuleFunctionStack + backendCompile + $insideCategoryPackageIfTrue => $capsuleFunctionStack + foldExportedFunctionReferences $capsuleFunctionStack clearCapsuleDirectory() -- release storage. body is [op,:.] and op in '(add CAPSULE) => T $NRTaddForm := diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot index a2f3f245..37023295 100644 --- a/src/interp/sys-driver.boot +++ b/src/interp/sys-driver.boot @@ -1,4 +1,4 @@ --- Copyright (C) 2007-2010 Gabriel Dos Reis +-- Copyright (C) 2007-2011 Gabriel Dos Reis -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -189,7 +189,6 @@ initializeGlobalState() == $buildingSystemAlgebra := getOptionValue "system-algebra" $verbose := getOptionValue "verbose" $bootStrapMode := getOptionValue "bootstrap" - $compileExportsOnly := getOptionValue "exports-only" $compileDefaultsOnly := getOptionValue "defaults-only" $reportOptimization := getOptionValue "show-insn" $optimizeRep := getOptionValue "inline-rep" diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 41b078fe..3f1c2ce1 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -453,11 +453,6 @@ $buildingSystemAlgebra := false ++ code generation, etc. $verbose := true -++ 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. |