aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-11-04 09:26:47 +0000
committerdos-reis <gdr@axiomatics.org>2011-11-04 09:26:47 +0000
commitefcc23cd44ee9578ecfc9a1a02e7a403e3565129 (patch)
treebcd45883508d9c91c9433f55738a323c6448ea5e
parent41564143f03fc7ef7fa3a464c2a7df3744e83359 (diff)
downloadopen-axiom-efcc23cd44ee9578ecfc9a1a02e7a403e3565129.tar.gz
* interp/functor.boot (compCategories): Take second parameter as
environment. Adjust callers. (compCategories1): Likewise. (NewbFVectorCopy): Remove as deadcode. (worthlessCode): Tidy. (DescendCode): Take additional environment parameter. Adjust callers. * interp/define.boot (isMacro): Simplify. (wrapDomainSub): Remove. Adjust callers. * algebra/Makefile.in (strap-2/%.$(FASLEXT)): Fix typo.
-rw-r--r--src/ChangeLog12
-rw-r--r--src/algebra/Makefile.in2
-rw-r--r--src/interp/define.boot13
-rw-r--r--src/interp/functor.boot49
-rw-r--r--src/interp/nruncomp.boot4
5 files changed, 40 insertions, 40 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 80a139a1..731e8eab 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2011-11-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/functor.boot (compCategories): Take second parameter as
+ environment. Adjust callers.
+ (compCategories1): Likewise.
+ (NewbFVectorCopy): Remove as deadcode.
+ (worthlessCode): Tidy.
+ (DescendCode): Take additional environment parameter. Adjust callers.
+ * interp/define.boot (isMacro): Simplify.
+ (wrapDomainSub): Remove. Adjust callers.
+ * algebra/Makefile.in (strap-2/%.$(FASLEXT)): Fix typo.
+
2011-11-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/lisplib.boot (findModule): Tidy.
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in
index aad21917..29453fb3 100644
--- a/src/algebra/Makefile.in
+++ b/src/algebra/Makefile.in
@@ -585,7 +585,7 @@ strap-2/%.$(FASLEXT): %.spad | strap-2
if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
strap-2/$*-.$(FASLEXT); else : ; fi && \
if test x@oa_keep_files@ = xyes; then \
- cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi
+ cp $*.NRLIB/code.lsp strap-2/$*.lsp; fi
SPADFILES= \
diff --git a/src/interp/define.boot b/src/interp/define.boot
index d728d512..f7752fc7 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -2298,9 +2298,8 @@ doIt(item,$predl) ==
systemErrorHere ["doIt", item]
isMacro(x,e) ==
- x is ['DEF,[op,:args],signature,body] and
- null get(op,'modemap,e) and null args and null get(op,'mode,e)
- and signature is [nil] => body
+ x is ['DEF,[op],[nil],body] and
+ get(op,'modemap,e) = nil and get(op,'mode,e) = nil => body
nil
++ Compile capsule-level `item' which is a conditional expression.
@@ -2398,7 +2397,7 @@ compJoin(["Join",:argl],m,e) ==
ident? x and getXmode(x,e) = $Category => x
stackSemanticError(["invalid argument to Join: ",x],nil)
x
- T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
+ T := [['DomainSubstitutionMacro,parameters,["Join",:catList']],$Category,e]
convert(T,m)
compForMode: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -2416,10 +2415,6 @@ mustInstantiate D ==
D is [fn,:.] and
not (symbolMember?(fn,$DummyFunctorNames) or property(fn,"makeFunctionList"))
-wrapDomainSub: (%List %Form, %Form) -> %Form
-wrapDomainSub(parameters,x) ==
- ["DomainSubstitutionMacro",parameters,x]
-
mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
body:=
["mkCategory",MKQ domainOrPackage,['%list,:reverse sigList],
@@ -2432,7 +2427,7 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
("append"/
[[x for x in sig | ident? x and x~='_$]
for ['QUOTE,[[.,sig,:.],:.]] in sigList])
- wrapDomainSub(parameters,body)
+ ['DomainSubstitutionMacro,parameters,body]
DomainSubstitutionFunction(parameters,body) ==
if parameters ~= nil then
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index fd887f9a..f60e0cd5 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -211,15 +211,15 @@ CategoriesFromGDC x ==
union([[a']],"union"/[CategoriesFromGDC u for u in b])
x is ['QUOTE,a] and a is [b] => [a]
-compCategories u ==
+compCategories(u,e) ==
u isnt [.,:.] => u
cons? u.op =>
error ['"compCategories: need an atom in operator position", u.op]
u.op in '(Record Union Mapping) =>
-- There is no modemap property for these guys so do it by hand.
- [u.op, :[compCategories1(a,$SetCategory) for a in u.args]]
- u is ['SubDomain,D,.] => compCategories D
- v := get(u.op,'modemap,$e)
+ [u.op, :[compCategories1(a,$SetCategory,e) for a in u.args]]
+ u is ['SubDomain,D,.] => compCategories(D,e)
+ v := get(u.op,'modemap,e)
v isnt [.,:.] =>
error ['"compCategories: could not get proper modemap for operator",u.op]
if rest v then
@@ -232,23 +232,16 @@ compCategories u ==
v := rest v
v := resolvePatternVars(first(v).mmSource, u.args) -- replaces #n forms
-- select the modemap part of the first entry, and skip result etc.
- [u.op,:[compCategories1(a,b) for a in u.args for b in v]]
+ [u.op,:[compCategories1(a,b,e) for a in u.args for b in v]]
-compCategories1(u,v) ==
+compCategories1(u,v,e) ==
-- v is the mode of u
u isnt [.,:.] => u
- u is [":",x,t] => [u.op,x,compCategories1(t,v)]
- isCategoryForm(v,$e) => compCategories u
- [c,:.] := comp(macroExpand(u,$e),v,$e) => c
+ u is [":",x,t] => [u.op,x,compCategories1(t,v,e)]
+ isCategoryForm(v,e) => compCategories(u,e)
+ [c,:.] := comp(macroExpand(u,e),v,e) => c
error 'compCategories1
-NewbFVectorCopy(u,domName) ==
- v := newShell # u
- for i in 0..5 repeat vectorRef(v,i) := vectorRef(u,i)
- for i in 6..maxIndex v | cons? vectorRef(u,i) repeat
- vectorRef(v,i) := [function Undef,[domName,i],:first vectorRef(u,i)]
- v
-
optFunctorBody x ==
atomic? x => x
x is ['DomainSubstitutionMacro,parms,body] =>
@@ -300,10 +293,10 @@ optFunctorPROGN l ==
l
worthlessCode x ==
- x is ['%when,:l] and (and/[x is [.,y] and worthlessCode y for x in l]) => true
- x is ['PROGN,:l] => (null (l':= optFunctorPROGN l) => true; false)
+ x is ['%when,:l] => and/[x is [.,y] and worthlessCode y for x in l]
+ x is ['PROGN,:l] => optFunctorPROGN l = nil
x is ['%list] => true
- null x => true
+ x = nil => true
false
cons5(p,l) ==
@@ -428,24 +421,24 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
code:=[v,:code]
[["%LET",instantiatedBase,base],:code]
-DescendCode(db,code,flag,viewAssoc) ==
+DescendCode(db,code,flag,viewAssoc,e) ==
-- flag = true if we are walking down code always executed;
-- otherwise set to conditions in which
code = nil => nil
code is '%noBranch => nil
- isMacro(code,$e) => nil --RDJ: added 3/16/83
+ isMacro(code,e) => nil --RDJ: added 3/16/83
code is ['add,base,:codelist] =>
codelist:=
- [v for u in codelist | (v:= DescendCode(db,u,flag,viewAssoc))~=nil]
+ [v for u in codelist | v := DescendCode(db,u,flag,viewAssoc,e)]
-- must do this first, to get this overriding Add code
['PROGN,:DescendCodeAdd(base,flag),:codelist]
code is ['PROGN,:codelist] =>
['PROGN,:
--Two REVERSEs leave original order, but ensure last guy wins
reverse! [v for u in reverse codelist |
- (v:= DescendCode(db,u,flag,viewAssoc))~=nil]]
+ v := DescendCode(db,u,flag,viewAssoc,e)]]
code is ['%when,:condlist] =>
- c:= [[u2:= ProcessCond(db,first u,$e),:q] for u in condlist] where q() ==
+ c:= [[u2:= ProcessCond(db,first u,e),:q] for u in condlist] where q() ==
null u2 => nil
f:=
TruthP u2 => flag;
@@ -457,7 +450,7 @@ DescendCode(db,code,flag,viewAssoc) ==
[DescendCode(db,v, f,
if first u is ['HasCategory,dom,cat]
then [[dom,:cat],:viewAssoc]
- else viewAssoc) for v in rest u]
+ else viewAssoc,e) for v in rest u]
TruthP CAAR c => ['PROGN,:CDAR c]
while (c and (last c is [c1] or last c is [c1,[]]) and
(c1 = '%true or c1 is ['HasAttribute,:.])) repeat
@@ -468,12 +461,12 @@ DescendCode(db,code,flag,viewAssoc) ==
code is ["%LET",name,body,:.] =>
--only keep the names that are useful
u := member(name,$locals) =>
- CONTAINED('$,body) and isDomainForm(body,$e) =>
+ CONTAINED('$,body) and isDomainForm(body,e) =>
--instantiate domains which depend on $ after constants are set
code:=['%store,['%tref,['%tref,'$,5],#$locals-#u],code]
$epilogue:=
TruthP flag => [code,:$epilogue]
- [['%when,[ProcessCond(db,flag,$e),code]],:$epilogue]
+ [['%when,[ProcessCond(db,flag,e),code]],:$epilogue]
nil
code
code -- doItIf deletes entries from $locals so can't optimize this
@@ -488,7 +481,7 @@ DescendCode(db,code,flag,viewAssoc) ==
if not $insideCategoryPackageIfTrue then
updateCapsuleDirectory([second(u).args,third u],flag)
ConstantCreator u =>
- if flag ~= true then u:= ['%when,[ProcessCond(db,flag,$e),u]]
+ if flag ~= true then u:= ['%when,[ProcessCond(db,flag,e),u]]
$ConstantAssignments:= [u,:$ConstantAssignments]
nil
u
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 39fd59f9..2375b8d7 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -489,7 +489,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
[$catsig,:argsig] := sig
catvecListMaker := removeDuplicates
[comp($catsig,$EmptyMode,$e).expr,
- :[compCategories u for [u,:.] in categoryAncestors $domainShell]]
+ :[compCategories(u,$e) for [u,:.] in categoryAncestors $domainShell]]
condCats := InvestigateConditions([$catsig,:rest catvecListMaker],$e)
-- a list, one %for each element of catvecListMaker
-- indicating under what conditions this
@@ -515,7 +515,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
[$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
makePredicateBitVector(db,[:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList],$e)
- storeOperationCode := DescendCode(db,code,true,nil)
+ storeOperationCode := DescendCode(db,code,true,nil,$e)
NRTaddDeltaCode db
storeOperationCode := NRTputInLocalReferences storeOperationCode
NRTdescendCodeTran(db,storeOperationCode,nil) --side effects storeOperationCode