aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-10-29 19:57:39 +0000
committerdos-reis <gdr@axiomatics.org>2011-10-29 19:57:39 +0000
commit8325a1bb16ac1a277c302a6aee7d6d584a1f7684 (patch)
treeee9025944e513694382858635deca5cb66c37a1c
parentd36e49b1da407f6cced17a9a0af2bdad8d08fd0f (diff)
downloadopen-axiom-8325a1bb16ac1a277c302a6aee7d6d584a1f7684.tar.gz
* 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.
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/define.boot40
-rw-r--r--src/interp/nruncomp.boot28
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