diff options
| -rw-r--r-- | src/interp/c-util.boot | 26 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 1 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 2 | ||||
| -rw-r--r-- | src/interp/define.boot | 26 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 17 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 |
6 files changed, 37 insertions, 38 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 3f7dd18a..cc77d040 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -141,19 +141,21 @@ macro domainData d == structure %CompilationData == Record(subst: %Substitution,idata: %Substitution,bytes: List %Fixnum, shell: %Vector %Thing, items: %Buffer %Pair(%SourceEntity,%Code), - capsule: %List %Thing, lib: %Libstream,outpath: %Pathname) with - cdSubstitution == (.subst) - cdImplicits == (.idata) - cdBytes == (.bytes) - cdShell == (.shell) - cdItems == (.items) - cdCapsule == (.capsule) - cdLib == (.lib) - cdOutput == (.outpath) + capsule: %List %Thing, base: %Thing, + lib: %Libstream,outpath: %Pathname) with + cdSubstitution == (.subst) + cdImplicits == (.idata) + cdBytes == (.bytes) + cdShell == (.shell) + cdItems == (.items) + cdCapsule == (.capsule) + cdBase == (.base) + cdLib == (.lib) + cdOutput == (.outpath) ++ Make a fresh compilation data structure. makeCompilationData() == - mk%CompilationData(nil,nil,nil,nil,[nil,:0],nil,nil,nil) + mk%CompilationData(nil,nil,nil,nil,[nil,:0],nil,nil,nil,nil) ++ Subsitution that replaces parameters with formals. macro dbFormalSubst db == @@ -232,6 +234,10 @@ macro dbSubstituteQueries(db,x) == dbSubstituteAllQuantified(db,x) == applySubst([:dbQuerySubst db,:dbFormalSubst db],x) +++ During compilation, return the base domain form of a domain defition. +macro dbBaseDomainForm db == + cdBase dbCompilerData db + --% $SetCategory == '(SetCategory) diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 3ddfb253..d14a7247 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -83,7 +83,6 @@ $IOFormDomains == compTopLevel: (%Form,%Mode,%Env) -> %Maybe %Triple compTopLevel(x,m,e) == - $currentFunction: local := nil $forceAdd: local:= false -- start with a base list of domains we may want to inline. $optimizableConstructorNames: local := $SystemInlinableConstructorNames diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index 823c5452..e091b57f 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -512,7 +512,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (STRINGIMAGE FN)))) (COND (|$fromSpadTrace| (if MATHTRACE (push (INTERN TRACENAME) |$mathTraceList|)) - (SETQ LETFUNCODE `(SETQ |$currentFunction| ,(MKQ FN))) + (SETQ LETFUNCODE (MKQ FN)) (SETQ BEFORE (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'BEFORE)) `(progn ,(CADR U) ,LETFUNCODE) diff --git a/src/interp/define.boot b/src/interp/define.boot index ed1a565c..c093762c 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -515,7 +515,8 @@ getXmode(x,e) == --======================================================================= -- Compute the lookup function (complete or incomplete) --======================================================================= -NRTgetLookupFunction(db,addForm,tbl,env) == +NRTgetLookupFunction(db,tbl,env) == + addForm := dbBaseDomainForm db $why: local := nil domform := dbSubstituteFormals(db,dbConstructorForm db) cat := dbCategory db @@ -1501,9 +1502,7 @@ compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) == $uncondAlist: local := nil $NRTslot1PredicateList: local := predicatesFromAttributes attributeList $NRTattributeAlist: local := genInitialAttributeAlist(db,attributeList) - $NRTaddForm: local := nil -- see compAdd - -- Generate slots for arguments first, then implicit parameters, - -- then for $NRTaddForm (if any) in compAdd + -- Generate slots for arguments first, then implicit parameters for x in form.args repeat getLocalIndex(db,x) for x in dbImplicitParameters db repeat getLocalIndex(db,x) [.,.,$e] := compMakeDeclaration("$",target,$e) @@ -1553,7 +1552,7 @@ compDefineFunctor1(db,df is ['DEF,form,signature,body],m,$e,$formalArgList) == dbAncestors(db) := computeAncestorsOf(db,nil) $insideFunctorIfTrue:= false if not $bootStrapMode then - dbLookupFunction(db) := NRTgetLookupFunction(db,$NRTaddForm,tbl,$e) + dbLookupFunction(db) := NRTgetLookupFunction(db,tbl,$e) --either lookupComplete (for forgetful guys) or lookupIncomplete $NRTslot1PredicateList := [simpBool x for x in $NRTslot1PredicateList] @@ -2235,17 +2234,17 @@ compAdd(['add,$addForm,capsule],m,e) == $addFormLhs: local:= $addForm db := currentDB e if $addForm is ["SubDomain",domainForm,predicate] then - $NRTaddForm := domainForm + dbBaseDomainForm(db) := domainForm getLocalIndex(db,domainForm) registerInlinableDomain domainForm --need to generate slot for add form since all $ go-get -- slots will need to access it - [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e) + [$addForm,.,e]:= compSubDomain1(db,domainForm,predicate,m,e) else - $NRTaddForm := $addForm + dbBaseDomainForm(db) := $addForm [$addForm,.,e]:= $addForm is ["%Comma",:.] => - $NRTaddForm := ["%Comma",:[getLocalIndex(db,x) for x in $addForm.args]] + dbBaseDomainForm(db) := ["%Comma",:[getLocalIndex(db,x) for x in $addForm.args]] for x in $addForm.args repeat registerInlinableDomain x compOrCroak(compTuple2Record $addForm,$EmptyMode,e) @@ -2268,13 +2267,14 @@ compCapsule(['CAPSULE,:itemList],m,e) == compSubDomain(["SubDomain",domainForm,predicate],m,e) == $addFormLhs: local:= domainForm $addForm: local := nil - $NRTaddForm := domainForm - [$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e) + db := currentDB e + dbBaseDomainForm(db) := domainForm + [$addForm,.,e]:= compSubDomain1(db,domainForm,predicate,m,e) compCapsule(['CAPSULE],m,e) -compSubDomain1(domainForm,predicate,m,e) == +compSubDomain1(db,domainForm,predicate,m,e) == [.,.,e]:= - compMakeDeclaration("#1",domainForm,addDomain(currentDB e,domainForm,e)) + compMakeDeclaration("#1",domainForm,addDomain(db,domainForm,e)) u:= compCompilerPredicate(predicate,e) or stackSemanticError(["predicate: ",predicate, diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 7a09ff4f..cbbabadc 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -55,9 +55,6 @@ $insideCategoryPackageIfTrue := false ++ By default, don't generate info files $profileCompiler := false -++ -$NRTaddForm := nil - addDeltaCode db == --NOTES: This function is called from buildFunctor to initially -- fill slots in dbTemplate. The dbTemplate so created is stored in the @@ -78,9 +75,9 @@ addDeltaCode db == for [item,:compItem] in reverse dbUsedEntities db repeat domainRef(dbTemplate db,i) := deltaTran(db,item,compItem) domainRef(dbTemplate db,$AddChainIndex) := - $NRTaddForm => - $NRTaddForm is ["%Comma",:y] => reverse! y - NRTencode(db,$NRTaddForm,$addForm) + base := dbBaseDomainForm db => + base is ["%Comma",:y] => reverse! y + NRTencode(db,base,$addForm) nil deltaTran(db,item,compItem) == @@ -238,7 +235,7 @@ assocIndex: (%Thing,%Form) -> %Maybe %Short assocIndex(db,x) == x = nil => x x is '$ => 0 - x = $NRTaddForm => $AddChainIndex + x = dbBaseDomainForm db => $AddChainIndex dbEntitySlot(db,['%domain,x]) getLocalIndex: (%Thing,%Form) -> %Short @@ -487,8 +484,8 @@ buildFunctor(db,sig,code,$locals,$e) == argStuffCode := [['%store,['%tref,'$,i],v] for i in $NRTbase.. for v in $FormalMapVariableList for arg in args] - if symbolMember?($NRTaddForm,$locals) then - addargname := $FormalMapVariableList.(symbolPosition($NRTaddForm,$locals)) + if symbolMember?(dbBaseDomainForm db,$locals) then + addargname := $FormalMapVariableList.(symbolPosition(dbBaseDomainForm db,$locals)) argStuffCode := [['%store,['%tref,'$,$AddChainIndex],addargname],:argStuffCode] [['stuffDomainSlots,'$],:argStuffCode, :predBitVectorCode2,storeOperationCode] @@ -574,7 +571,7 @@ makeSlot1Info db == opList := $insideCategoryPackageIfTrue => slot1Filter exports exports - addList := applySubst(pairlis,$NRTaddForm) + addList := applySubst(pairlis,dbBaseDomainForm db) [dbConstructor db,[addList,:opList]] slot1Filter opList == diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 0d515fa5..54dc0d24 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -64,9 +64,6 @@ $cacheCount := 0 $createUpdateFiles := false ++ -$currentFunction := nil - -++ $currentLine := nil ++ |