diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/compiler.boot | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 54 | ||||
| -rw-r--r-- | src/interp/i-syscmd.boot | 23 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 12 |
4 files changed, 15 insertions, 78 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 88ef6691..5ab502a0 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -86,10 +86,6 @@ $coreDiagnosticFunctions == $IOFormDomains == [$InputForm,$OutputForm,$Syntax] -++ list of functions to compile -$compileOnlyCertainItems := [] - - --% compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple diff --git a/src/interp/define.boot b/src/interp/define.boot index f7752fc7..d8cf7fef 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -72,7 +72,6 @@ $condAlist := [] $uncondAlist := [] $NRTslot1PredicateList := [] $NRTattributeAlist := [] -$NRTslot1Info := nil $NRTdeltaListComp := [] $signature := nil $lookupFunction := nil @@ -344,13 +343,13 @@ chaseInferences(pred,$e) == --======================================================================= -- Generate Code to Create Infovec --======================================================================= -getInfovecCode db == +getInfovecCode(db,e) == --Function called by compDefineFunctor1 to create infovec at compile time ['LIST, MKQ makeDomainTemplate db, - MKQ makeCompactDirect(db,$NRTslot1Info), - MKQ NRTgenFinalAttributeAlist(db,$e), - NRTmakeCategoryAlist(db,$e), + MKQ makeCompactDirect(db,NRTmakeSlot1Info db), + MKQ NRTgenFinalAttributeAlist(db,e), + NRTmakeCategoryAlist(db,e), MKQ $lookupFunction] --======================================================================= @@ -516,9 +515,10 @@ getXmode(x,e) == --======================================================================= -- Compute the lookup function (complete or incomplete) --======================================================================= -NRTgetLookupFunction(db,domform,exCategory,addForm,env) == +NRTgetLookupFunction(db,addForm,env) == $why: local := nil - domform := dbSubstituteFormals(db,domform) + domform := dbSubstituteFormals(db,dbConstructorForm db) + exCategory := dbCategory db addForm isnt [.,:.] => ident? addForm and (m := getmode(addForm,env)) ~= nil and isCategoryForm(m,env) and @@ -1401,7 +1401,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body], $uncondAlist: local := nil $NRTslot1PredicateList: local := predicatesFromAttributes attributeList $NRTattributeAlist: local := NRTgenInitialAttributeAlist(db,attributeList) - $NRTslot1Info: local := nil --set in NRTmakeSlot1Info $NRTaddForm: local := nil -- see compAdd $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts $NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList @@ -1443,11 +1442,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body], u := sublisFormal(rhsArgs,u,$AtVariables) emitSubdomainInfo($form,first u, second u) T:= compFunctorBody(body,rettype,$e,parForm) - -- If only compiling certain items, then ignore the body shell. - $compileOnlyCertainItems => - reportOnFunctorCompilation() - [nil, ['Mapping, :signature'], originale] - body':= T.expr lamOrSlam := dbInstanceCache db = nil => 'LAM @@ -1463,17 +1457,15 @@ compDefineFunctor1(df is ['DEF,form,signature,body], dbAncestors(db) := computeAncestorsOf($form,nil) $insideFunctorIfTrue:= false if not $bootStrapMode then - $NRTslot1Info := NRTmakeSlot1Info() libFn := dbAbbreviation db - $lookupFunction: local := - NRTgetLookupFunction(db,$functorForm,modemap.mmTarget,$NRTaddForm,$e) + $lookupFunction: local := NRTgetLookupFunction(db,$NRTaddForm,$e) --either lookupComplete (for forgetful guys) or lookupIncomplete $byteAddress :local := 0 $byteVec :local := nil $NRTslot1PredicateList := [simpBool x for x in $NRTslot1PredicateList] LAM_,FILEACTQ('loadTimeStuff, - ['MAKEPROP,MKQ $op,''infovec,getInfovecCode db]) + ['MAKEPROP,MKQ $op,''infovec,getInfovecCode(db,$e)]) $lisplibOperationAlist:= operationAlist -- Functors are incomplete during bootstrap if $bootStrapMode then @@ -1777,14 +1769,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,body], not symbolMember?($op,$formalArgList) and getXmode($op,e) is ['Mapping,:.] => 'local 'exported - - --6a skip if compiling only certain items but not this one - -- could be moved closer to the top - formattedSig := formatUnabbreviated ['Mapping,:signature'] - $compileOnlyCertainItems and _ - not symbolMember?($op, $compileOnlyCertainItems) => - sayBrightly ['" skipping ", localOrExported,:bright $op] - [nil,['Mapping,:signature'],$e] + formattedSig := formatUnabbreviatedSig ['Mapping,:signature'] sayBrightly ['" compiling ",localOrExported, :bright $op,'": ",:formattedSig] @@ -1974,8 +1959,6 @@ putInLocalDomainReferences (def := [opName,[lam,varl,body]]) == def -$savableItems := nil - compile u == [op,lamExpr] := u if $suffix then @@ -1996,23 +1979,6 @@ compile u == null symbolMember?(op,$formalArgList) and getXmode(op,$e) is ['Mapping,:.] u:= [op',lamExpr] - -- If just updating certain functions, check for previous existence. - -- Deduce old sequence number and use it (items have been skipped). - if $compileOnlyCertainItems then - parts := splitEncodedFunctionName(u.op, ";") - -- Next line JHD/SMWATT 7/17/86 to deal with inner functions - parts='inner => $savableItems:=[u.op,:$savableItems] - unew := nil - for [s,t] in $splitUpItemsAlreadyThere repeat - if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t - null unew => - sayBrightly ['" Error: Item did not previously exist"] - sayBrightly ['" Item not saved: ", :bright u.op] - sayBrightly ['" What's there is: ", $lisplibItemsAlreadyThere] - nil - sayBrightly ['" Renaming ", u.op, '" as ", unew] - u := [unew, :rest u] - $savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE optimizedBody:= optimizeFunctionDef u stuffToCompile:= if not $insideCapsuleFunctionIfTrue diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index a6483122..ec20fd06 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -527,7 +527,6 @@ compileSpad2Cmd args == optList := '( _ break _ constructor _ - functions _ library _ lisp _ new _ @@ -543,7 +542,6 @@ compileSpad2Cmd args == ) $scanIfTrue : local := false - $compileOnlyCertainItems : local := nil $f : local := nil -- compiler $m : local := nil -- variables @@ -571,10 +569,6 @@ compileSpad2Cmd args == fullopt is 'break => $scanIfTrue := nil fullopt is 'vartrace => $QuickLet := false fullopt is 'lisp => throwKeyedMsg("S2IZ0036",['")lisp"]) - fullopt is 'functions => - null optargs => - throwKeyedMsg("S2IZ0037",['")functions"]) - $compileOnlyCertainItems := optargs fullopt is 'constructor => null optargs => throwKeyedMsg("S2IZ0037",['")constructor"]) @@ -590,11 +584,7 @@ compileSpad2Cmd args == $InteractiveMode : local := nil -- avoid Boolean semantics transformations based on syntax only $normalizeTree: local := false - if $compileOnlyCertainItems then - null constructor => sayKeyedMsg("S2IZ0040",nil) - compilerDoitWithScreenedLisplib(constructor, fun) - else - compilerDoit(constructor, fun) + compilerDoit(constructor, fun) if not $buildingSystemAlgebra then extendLocalLibdb $newConlist terminateSystemCommand() @@ -615,17 +605,6 @@ compilerDoit(constructor, fun) == null member(ii,$constructorsSeen) => sayBrightly ['">>> Warning ",'"%b",ii,'"%d",'" was not found"] -compilerDoitWithScreenedLisplib(constructor, fun) == - EMBED('RWRITE, - '(LAMBDA (KEY VALUE STREAM) - (COND ((AND (EQ STREAM $libFile) - (NOT (MEMBER KEY $saveableItems))) - VALUE) - ((NOT NIL) - (RWRITE KEY VALUE STREAM)))) ) - (try compilerDoit(constructor,fun); finally SEQ(UNEMBED 'RWRITE)) - - --% )copyright -- display copyright notice summary l == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 2375b8d7..2ccdbd25 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -614,7 +614,7 @@ NRTsetVector4a(sig,form,cond) == $uncondList := [form,:append(categoryPrincipals evalform,$uncondList)] $condList := [[cond,[form,:categoryPrincipals evalform]],:$condList] -NRTmakeSlot1Info() == +NRTmakeSlot1Info db == -- 4 cases: -- a:T == b add c --- slot1 directory has #s for entries defined in c -- a:T == b --- slot1 has all slot #s = nil (see compFunctorBody) @@ -622,9 +622,8 @@ NRTmakeSlot1Info() == -- a == b --- $NRTderivedTargetIfTrue = true; set directory to nil pairlis := $insideCategoryPackageIfTrue => - [:argl,dollarName] := rest $form - [[dollarName,:'_$],:mkSlot1sublis argl] - mkSlot1sublis rest $form + [[first dbParameters db,:'_$],:dbFormalSubst db] + dbFormalSubst db exports := transformOperationAlist applySubst(pairlis,categoryExports $domainShell) opList := @@ -632,10 +631,7 @@ NRTmakeSlot1Info() == $insideCategoryPackageIfTrue => slot1Filter exports exports addList := applySubst(pairlis,$NRTaddForm) - [$form.op,[addList,:opList]] - -mkSlot1sublis argl == - pairList(argl,$FormalMapVariableList) + [dbConstructor db,[addList,:opList]] slot1Filter opList == --include only those ops which are defined within the capsule |