aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/interp/c-util.boot26
-rw-r--r--src/interp/compiler.boot1
-rw-r--r--src/interp/debug.lisp2
-rw-r--r--src/interp/define.boot26
-rw-r--r--src/interp/nruncomp.boot17
-rw-r--r--src/interp/sys-globals.boot3
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
++