diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/define.boot | 40 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 28 |
3 files changed, 45 insertions, 35 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index bd4d6233..4e883459 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,17 @@ 2011-10-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/nruncomp.boot (NRTaddDeltaCode): Take a DB parameter. + Adjust callers. + (NRTdescendCodeTran): Likewise. + * interp/define.boot (makeDomainTemplate): Lose second argument. + Adjust callers. + (NRTgetLookupFunction): Take a DB as first argument. Adjust callers. + (NRTextendsCategory1): Likewise. + (extendsCategory): Likewise. + (compDefineFunctor1): Do not find $template. Set dbTemplate. + +2011-10-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/define.boot ($atList, $sigList): Remove. (compSignature): Take a fourth parameter. (compCategoryItem): Take two more parameters. diff --git a/src/interp/define.boot b/src/interp/define.boot index fd2b3f9e..16282ee6 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -75,7 +75,6 @@ $NRTslot1PredicateList := [] $NRTattributeAlist := [] $NRTslot1Info := nil $NRTdeltaListComp := [] -$template := nil $signature := nil $lookupFunction := nil $byteAddress := nil @@ -352,7 +351,7 @@ chaseInferences(pred,$e) == getInfovecCode db == --Function called by compDefineFunctor1 to create infovec at compile time ['LIST, - MKQ makeDomainTemplate(db,$template), + MKQ makeDomainTemplate db, MKQ makeCompactDirect(db,$NRTslot1Info), MKQ NRTgenFinalAttributeAlist(db,$e), NRTmakeCategoryAlist(db,$e), @@ -361,19 +360,19 @@ getInfovecCode db == --======================================================================= -- Generation of Domain Vector Template (Compile Time) --======================================================================= -makeDomainTemplate(db,vec) == +makeDomainTemplate db == --NOTES: This function is called at compile time to create the template -- (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1 - newVec := newShell # vec + vec := dbTemplate db for index in 0..maxIndex vec repeat - item := vectorRef(vec,index) - null item => nil - vectorRef(newVec,index) := + item := domainRef(vec,index) + item = nil => nil + domainRef(vec,index) := item isnt [.,:.] => item cons? first item => makeGoGetSlot(item,index) item $byteVec := "append"/reverse! $byteVec - newVec + vec makeGoGetSlot(item,index) == --NOTES: creates byte vec strings for LATCH slots @@ -521,17 +520,17 @@ getXmode(x,e) == --======================================================================= -- Compute the lookup function (complete or incomplete) --======================================================================= -NRTgetLookupFunction(domform,exCategory,addForm,env) == +NRTgetLookupFunction(db,domform,exCategory,addForm,env) == $why: local := nil domform := applySubst($pairlis,domform) addForm isnt [.,:.] => ident? addForm and (m := getmode(addForm,env)) ~= nil and isCategoryForm(m,env) - and extendsCategory(domform,exCategory,applySubst($pairlis,m),env) => + and extendsCategory(db,domform,exCategory,applySubst($pairlis,m),env) => 'lookupIncomplete 'lookupComplete addForm := applySubst($pairlis,addForm) - NRTextendsCategory1(domform,exCategory,getExportCategory addForm,env) => + NRTextendsCategory1(db,domform,exCategory,getExportCategory addForm,env) => 'lookupIncomplete [u,msg,:v] := $why SAY '"--------------non extending category----------------------" @@ -552,23 +551,23 @@ getExportCategory form == [[.,target,:tl],:.] := getConstructorModemap op applySubst(pairList($FormalMapVariableList,argl),target) -NRTextendsCategory1(domform,exCategory,addForm,env) == +NRTextendsCategory1(db,domform,exCategory,addForm,env) == addForm is ["%Comma",:r] => - and/[extendsCategory(domform,exCategory,x,env) for x in r] - extendsCategory(domform,exCategory,addForm,env) + and/[extendsCategory(db,domform,exCategory,x,env) for x in r] + extendsCategory(db,domform,exCategory,addForm,env) --======================================================================= -- Compute if a domain constructor is forgetful functor --======================================================================= -extendsCategory(dom,u,v,env) == +extendsCategory(db,dom,u,v,env) == --does category u extend category v (yes iff u contains everything in v) --is dom of category u also of category v? u=v => true - v is ["Join",:l] => and/[extendsCategory(dom,u,x,env) for x in l] - v is ["CATEGORY",.,:l] => and/[extendsCategory(dom,u,x,env) for x in l] + v is ["Join",:l] => and/[extendsCategory(db,dom,u,x,env) for x in l] + v is ["CATEGORY",.,:l] => and/[extendsCategory(db,dom,u,x,env) for x in l] v is ["SubsetCategory",cat,d] => - extendsCategory(dom,u,cat,env) and isSubset(dom,d,env) - v := substSlotNumbers(v,$template,$functorForm) + extendsCategory(db,dom,u,cat,env) and isSubset(dom,d,env) + v := substSlotNumbers(v,dbTemplate db,$functorForm) extendsCategoryBasic(dom,u,v,env) => true $why := v is ['SIGNATURE,op,sig,:.] => @@ -1386,7 +1385,6 @@ compDefineFunctor1(df is ['DEF,form,signature,body], $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts $NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector - $template: local:= nil --stored in the lisplib $functionLocations: local := nil --locations of defined functions in source -- generate slots for arguments first, then for $NRTaddForm in compAdd for x in argl repeat NRTgetLocalIndex x @@ -1447,7 +1445,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body], $NRTslot1Info := NRTmakeSlot1Info() libFn := dbAbbreviation db $lookupFunction: local := - NRTgetLookupFunction($functorForm,modemap.mmTarget,$NRTaddForm,$e) + NRTgetLookupFunction(db,$functorForm,modemap.mmTarget,$NRTaddForm,$e) --either lookupComplete (for forgetful guys) or lookupIncomplete $byteAddress :local := 0 $byteVec :local := nil diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 7bd5e7de..39fd59f9 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -63,10 +63,10 @@ $NRTaddForm := nil $NRTderivedTargetIfTrue := false $killOptimizeIfTrue := false -NRTaddDeltaCode() == +NRTaddDeltaCode db == --NOTES: This function is called from buildFunctor to initially --- fill slots in $template. The $template so created is stored in the --- NRLIB. On load, makeDomainTemplate is called on this $template to +-- fill slots in dbTemplate. The dbTemplate so created is stored in the +-- NRLIB. On load, makeDomainTemplate is called on this dbTemplate to -- create a template which becomes slot 0 of the infovec for the constructor. --The template has 6 kinds of entries: -- (1) formal arguments and local variables, represented by (QUOTE <entry>) @@ -83,8 +83,8 @@ NRTaddDeltaCode() == for i in $NRTbase.. for item in reverse $NRTdeltaList for compItem in reverse $NRTdeltaListComp | null vectorRef(kvec,i) repeat - vectorRef($template,i) := deltaTran(item,compItem) - vectorRef($template,5) := + domainRef(dbTemplate db,i) := deltaTran(item,compItem) + domainRef(dbTemplate db,5) := $NRTaddForm => $NRTaddForm is ["%Comma",:y] => reverse! y NRTencode($NRTaddForm,$addForm) @@ -354,23 +354,23 @@ consDomainForm(x,dc) == MKQ x -++ Called by buildFunctor fill $template slots with names +++ Called by buildFunctor fill dbTemplate slots with names ++ of compiled functions -NRTdescendCodeTran(u,condList) == +NRTdescendCodeTran(db,u,condList) == null u => nil u is ['%list] => nil u is ['%store,['%tref,.,i],a] => null condList and a is ['CONS,fn,:.] => u.first := '%list u.rest := nil - $template.i := + domainRef(dbTemplate db,i) := fn is 'IDENTITY => a fn is ['dispatchFunction,fn'] => fn' fn nil --code for this will be generated by the instantiator u is ['%when,:c] => - for [pred,:y] in c|y repeat NRTdescendCodeTran(first y,[pred,:condList]) - u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList) + for [pred,:y] in c|y repeat NRTdescendCodeTran(db,first y,[pred,:condList]) + u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(db,x,condList) nil ++ Remove useless statements from the elaboration `form' of @@ -500,7 +500,7 @@ buildFunctor(db,sig,code,$locals,$e) == for i in 0..4 repeat vectorRef(domainShell,i) := vectorRef($domainShell,i) --we will clobber elements; copy since $domainShell may be a cached vector - $template := newShell($NRTbase + $NRTdeltaLength) + dbTemplate(db) := newShell($NRTbase + $NRTdeltaLength) $SetFunctions := newShell # domainShell $catvecList := [domainShell,:[emptyVector for u in categoryAncestors domainShell]] @@ -516,9 +516,9 @@ buildFunctor(db,sig,code,$locals,$e) == makePredicateBitVector(db,[:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList],$e) storeOperationCode := DescendCode(db,code,true,nil) - NRTaddDeltaCode() - storeOperationCode:= NRTputInLocalReferences storeOperationCode - NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode + NRTaddDeltaCode db + storeOperationCode := NRTputInLocalReferences storeOperationCode + NRTdescendCodeTran(db,storeOperationCode,nil) --side effects storeOperationCode codePart2:= argStuffCode := [['%store,['%tref,'$,i],v] for i in $NRTbase.. for v in $FormalMapVariableList |