diff options
author | dos-reis <gdr@axiomatics.org> | 2011-11-04 09:26:47 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-11-04 09:26:47 +0000 |
commit | efcc23cd44ee9578ecfc9a1a02e7a403e3565129 (patch) | |
tree | bcd45883508d9c91c9433f55738a323c6448ea5e | |
parent | 41564143f03fc7ef7fa3a464c2a7df3744e83359 (diff) | |
download | open-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/ChangeLog | 12 | ||||
-rw-r--r-- | src/algebra/Makefile.in | 2 | ||||
-rw-r--r-- | src/interp/define.boot | 13 | ||||
-rw-r--r-- | src/interp/functor.boot | 49 | ||||
-rw-r--r-- | src/interp/nruncomp.boot | 4 |
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 |