diff options
| -rw-r--r-- | src/ChangeLog | 17 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 18 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 7 | ||||
| -rw-r--r-- | src/interp/define.boot | 43 | ||||
| -rw-r--r-- | src/interp/functor.boot | 2 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 12 |
6 files changed, 67 insertions, 32 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4e883459..506e5b5a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,22 @@ 2011-10-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/daase.lisp (dbCompilerData): New accessor macro. + (dbBeingDefined?): Adjust. + * interp/c-util.boot (makeCompilationData): New. + (dbFormalSubst): New accessor macro. + (dbSubstituteFormals): New. + * interp/define.boot ($pairlis): Remove. + (NRTmakeCategoryAlist): Use dbSubstituteFormals. + (NRTgetLookupFunction): Likewise. + (compDefineCategory2): Likewise. Set dbCompilerData and dbFormalSubst. + (compDefineFunctor1): Likewise. + * interp/functor.boot (ProcessCond): Use dbSubstituteFormals. + * interp/lisplib.boot (NRTgenInitialAttributeAlist): Likewise. + (makePredicateBitVector): Likewise. + (finalizeLisplib): Do not set $pairlis. + +2011-10-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/nruncomp.boot (NRTaddDeltaCode): Take a DB parameter. Adjust callers. (NRTdescendCodeTran): Likewise. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index bd1566da..20230eb9 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -131,6 +131,24 @@ macro domainPredicates d == macro domainData d == domainRef(d,4) +--% +--% Constructor Compilation Data. +--% Operational Semantics: +--% structure CompilationData == +--% Record(formalSubst: Substitution) +--% + +++ Make a fresh compilation data structure. +makeCompilationData() == + [nil] + +macro dbFormalSubst db == + first dbCompilerData db + +++ Apply the formal substitution or `db'to th form `x'. +dbSubstituteFormals(db,x) == + applySubst(dbFormalSubst db,x) + --% $SetCategory == '(SetCategory) diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index fce8ca41..d848d8be 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -226,7 +226,7 @@ dependents ; browse. superdomain ; interp. instantiations ; nil if mutable constructor - being-defined ; T is definition of constructor is being processed + compiler-data ; holds compiler data when processing constructor load-path ; full object path name, when loaded. capsule-definitions ; capsule-level definitions template ; for a category, this is the generic instance. @@ -291,8 +291,11 @@ (defmacro |dbInstanceCache| (db) `(database-instantiations ,db)) +(defmacro |dbCompilerData| (db) + `(database-compiler-data ,db)) + (defmacro |dbBeingDefined?| (db) - `(database-being-defined ,db)) + `(|dbCompilerData| ,db)) (defmacro |dbLoadPath| (db) `(database-load-path ,db)) diff --git a/src/interp/define.boot b/src/interp/define.boot index 16282ee6..3a6ce68b 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -67,7 +67,6 @@ $functionStats := nil $functorStats := nil $CheckVectorList := [] -$pairlis := [] $functorTarget := nil $condAlist := [] $uncondAlist := [] @@ -479,12 +478,12 @@ NRTmakeCategoryAlist(db,e) == pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist] $levelAlist: local := depthAssocList [CAAR x for x in pcAlist] opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist) - newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..] - slot1 := [[a,:k] for [a,:b] in applySubst($pairlis,opcAlist) + newPairlis := [[5 + i,:b] for [.,:b] in dbFormalSubst db for i in 1..] + slot1 := [[a,:k] for [a,:b] in dbSubstituteFormals(db,opcAlist) | (k := predicateBitIndex(b,e)) ~= -1] slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1] - sixEtc := [5 + i for i in 1..#$pairlis] - formals := ASSOCRIGHT $pairlis + sixEtc := [5 + i for i in 1..dbArity db] + formals := ASSOCRIGHT dbFormalSubst db for x in slot1 repeat x.first := applySubst(pairList(['$,:formals],["$$",:sixEtc]),first x) -----------code to make a new style slot4 ----------------- @@ -522,14 +521,14 @@ getXmode(x,e) == --======================================================================= NRTgetLookupFunction(db,domform,exCategory,addForm,env) == $why: local := nil - domform := applySubst($pairlis,domform) + domform := dbSubstituteFormals(db,domform) addForm isnt [.,:.] => - ident? addForm and (m := getmode(addForm,env)) ~= nil - and isCategoryForm(m,env) - and extendsCategory(db,domform,exCategory,applySubst($pairlis,m),env) => + ident? addForm and (m := getmode(addForm,env)) ~= nil and + isCategoryForm(m,env) and + extendsCategory(db,domform,exCategory,dbSubstituteFormals(db,m),env) => 'lookupIncomplete 'lookupComplete - addForm := applySubst($pairlis,addForm) + addForm := dbSubstituteFormals(db,addForm) NRTextendsCategory1(db,domform,exCategory,getExportCategory addForm,env) => 'lookupIncomplete [u,msg,:v] := $why @@ -1011,7 +1010,8 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) == -- 1.1 augment e to add declaration $: <form> [$op,:argl] := $definition db := constructorDB $op - dbBeingDefined?(db) := true + dbCompilerData(db) := makeCompilationData() + dbFormalSubst(db) := pairList(form.args,$TriangleVariableList) dbInstanceCache(db) := true e:= addBinding("$",[['mode,:$definition]],e) @@ -1026,9 +1026,8 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) == sargl:= TAKE(# argl, $TriangleVariableList) $functorForm:= $form:= [$op,:sargl] $formalArgList:= [:sargl,:$formalArgList] - aList := pairList(argl,sargl) - formalBody:= applySubst(aList,body) - signature' := applySubst(aList,signature') + formalBody := dbSubstituteFormals(db,body) + signature' := dbSubstituteFormals(db,signature') --Begin lines for category default definitions $functionStats: local:= [0,0] $functorStats: local:= [0,0] @@ -1073,7 +1072,7 @@ compDefineCategory2(form,signature,body,m,e,$prefix,$formalArgList) == dbPrincipals(db) := getParentsFor(db,$FormalMapVariableList) dbAncestors(db) := computeAncestorsOf($form,nil) dbModemaps(db) := modemapsFromCategory([op',:sargl],formalBody,signature') - dbBeingDefined?(db) := false + dbCompilerData(db) := nil [fun,$Category,e] mkConstructor: %Form -> %Form @@ -1355,10 +1354,10 @@ compDefineFunctor1(df is ['DEF,form,signature,body], originale:= $e [$op,:argl]:= form db := constructorDB $op - dbBeingDefined?(db) := true dbConstructorForm(db) := form + dbCompilerData(db) := makeCompilationData() + dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList) $formalArgList:= [:argl,:$formalArgList] - $pairlis: local := pairList(argl,$FormalMapVariableList) -- all defaulting packages should have caching turned off dbInstanceCache(db) := not isCategoryPackageName $op signature':= @@ -1393,8 +1392,8 @@ compDefineFunctor1(df is ['DEF,form,signature,body], $e := augModemapsFromCategory('_$,'_$,target,$e) $e := put('$,'%form,form,$e) $signature:= signature' - parSignature:= applySubst($pairlis,signature') - parForm:= applySubst($pairlis,form) + parSignature := dbSubstituteFormals(db,signature') + parForm := dbSubstituteFormals(db,form) -- 3. give operator a 'modemap property modemap := [[parForm,:parSignature],[true,$op]] @@ -1431,9 +1430,9 @@ compDefineFunctor1(df is ['DEF,form,signature,body], lamOrSlam := dbInstanceCache db = nil => 'LAM 'SPADSLAM - fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']]) + fun := compile dbSubstituteFormals(db,[op',[lamOrSlam,argl,body']]) --The above statement stops substitutions gettting in one another's way - operationAlist := applySubst($pairlis,$lisplibOperationAlist) + operationAlist := dbSubstituteFormals(db,$lisplibOperationAlist) dbModemaps(db) := modemapsFromFunctor(parForm,operationAlist,parSignature) reportOnFunctorCompilation() @@ -1458,7 +1457,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body], if $bootStrapMode then evalAndRwriteLispForm('%incomplete, ['MAKEPROP,quote op',quote '%incomplete,true]) - dbBeingDefined?(db) := false + dbBeingDefined?(db) := nil [fun,['Mapping,:signature'],originale] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index f91491b0..fd887f9a 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -509,7 +509,7 @@ ConstantCreator u == true ProcessCond(db,cond,e) == - ncond := applySubst($pairlis,cond) + ncond := dbSubstituteFormals(db,cond) valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e) cond diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 8b76009d..9f7de79c 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -35,7 +35,6 @@ import nlib import c_-util import debug -import daase namespace BOOT module lisplib @@ -52,7 +51,7 @@ NRTgenInitialAttributeAlist(db,attributeList) == alist := [x for x in attributeList | -- throw out constructors not symbolMember?(opOf first x,allConstructors())] dbAttributes(db) := simplifyAttributeAlist(db, - [[a,:b] for [a,b] in applySubst($pairlis,alist) | a isnt 'nothing]) + [[a,:b] for [a,b] in dbSubstituteFormals(db,alist) | a isnt 'nothing]) simplifyAttributeAlist(db,al) == al is [[a,:b],:r] => @@ -109,13 +108,13 @@ makePredicateBitVector(db,pl,e) == --called by buildFunctor for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts) else firsts := insert(pred,firsts) - firstPl := applySubst($pairlis,reverse! orderByContainment firsts) - lastPl := applySubst($pairlis,reverse! orderByContainment lasts) + firstPl := dbSubstituteFormals(db,reverse! orderByContainment firsts) + lastPl := dbSubstituteFormals(db,reverse! orderByContainment lasts) firstCode:= ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)] lastCode := augmentPredCode(# firstPl,lastPl) - dbPredicates(db) := [:firstPl,:lastPl] --what is stored under 'predicates - [dbPredicates db,firstCode,:lastCode] --$pairlis set by compDefineFunctor1 + dbPredicates(db) := [:firstPl,:lastPl] + [dbPredicates db,firstCode,:lastCode] augmentPredCode(n,lastPl) == ['%list,:pl] := mungeAddGensyms(lastPl,$predGensymAlist) @@ -533,7 +532,6 @@ finalizeLisplib(ctor,libName) == opsAndAtts := getConstructorOpsAndAtts(form,kind,mm) writeOperations(ctor,first opsAndAtts,$libFile) if kind='category then - $pairlis : local := pairList(form,$FormalMapVariableList) $NRTslot1PredicateList : local := [] NRTgenInitialAttributeAlist(db,rest opsAndAtts) writeSuperDomain(ctor,dbSuperDomain db,$libFile) |