diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/interp/define.boot | 31 | ||||
| -rw-r--r-- | src/interp/functor.boot | 81 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 2 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 2 |
5 files changed, 27 insertions, 95 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 05218fe2..9f01d7e0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-08-15 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/functor.boot (setVector0, setVector12, setVector3, + mkDomainFomer, setVector5, mkVectorWithDeferral): Remove as dead + codes. + 2011-08-14 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/g-opt.boot (optCollectVector): Generate VM forms. diff --git a/src/interp/define.boot b/src/interp/define.boot index e0b0aae1..d78c5770 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -778,12 +778,13 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- following line causes cats with no with or Join to be fresh copies if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then formalBody := ['Join, formalBody] - body:= optFunctorBody compOrCroak(formalBody,signature'.target,e).expr - if $extraParms then - formals:=actuals:=nil - for u in $extraParms repeat - formals:=[first u,:formals] - actuals:=[MKQ rest u,:actuals] + body := optFunctorBody compOrCroak(formalBody,signature'.target,e).expr + if $extraParms ~= nil then + formals := nil + actuals := nil + for [u,:v] in $extraParms repeat + formals := [u,:formals] + actuals := [MKQ v,:actuals] body := ['sublisV,['pairList,['QUOTE,formals],['%list,:actuals]],body] if argl then body:= -- always subst for args after extraparms ['sublisV,['pairList,['QUOTE,sargl],['%list,: @@ -1946,30 +1947,26 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) == wrapDomainSub(parameters,body) DomainSubstitutionFunction(parameters,body) == - --see definition of DomainSubstitutionMacro in SPAD LISP - if parameters then + if parameters ~= nil then (body := Subst(parameters,body)) where Subst(parameters,body) == body isnt [.,:.] => - symbolMember?(body,parameters) => MKQ body + objectMember?(body,parameters) => MKQ body body listMember?(body,parameters) => g := gensym() - $extraParms := PUSH([g,:body],$extraParms) + $extraParms := [[g,:body],:$extraParms] --Used in SetVector12 to generate a substitution list --bound in buildFunctor --For categories, bound and used in compDefineCategory MKQ g - body.op = "QUOTE" => body - cons? $definition and - isFunctor body.op and - body.op ~= $definition.op - => ['QUOTE,simplifyVMForm body] + first body is "QUOTE" => body + cons? $definition and isFunctor body.op and + body.op ~= $definition.op => quoteForm simplifyVMForm body [Subst(parameters,u) for u in body] body isnt ["Join",:.] => body $definition isnt [.,:.] => body - null $definition.args => body - --should not bother if it will only be called once + $definition.args = nil => body name := makeSymbol strconc(KAR $definition,";CAT") SETANDFILE(name,nil) body := ['%when,[name],['%otherwise,['%store,name,body]]] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index be229149..70085b74 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -318,42 +318,13 @@ cons5(p,l) == QCDDDDR(l).rest := nil [p,:l] -setVector0(catNames,definition) == - --returns code to set element 0 of the vector - --to the definition of the category - definition:= mkTypeForm definition - for u in catNames repeat - definition:= ['%store,['%tref,u,0],definition] - definition - -setVector12 args == - --The purpose of this function is to replace place holders - --e.g. argument names or gensyms, by real values - null args => nil - args1:=args2:=args - for u in $extraParms repeat - --A typical element of $extraParms, which is set in - --DomainSubstitutionFunction, would be (gensym) cons - --(category parameter), e.g. DirectProduct(length vl,NNI) - --as in DistributedMultivariatePolynomial - args1:=[u.op,:args1] - args2:=[u.args,:args2] - freeof(categoryExports $domainShell,args1) and - freeof($domainShell.2,args1) and - freeof($domainShell.4,args1) => nil - [['SetDomainSlots124,'$,['QUOTE,args1],['%list,:args2]]] - where freeof(a,b) == - a isnt [.,:.] => null symbolMember?(a,b) - freeof(first a,b) => freeof(rest a,b) - false - -SetDomainSlots124(vec,names,vals) == +SetDomainSlots124(dom,names,vals) == l := pairList(names,vals) - vectorRef(vec,1) := sublisProp(l,vectorRef(vec,1)) - vectorRef(vec,2) := sublisProp(l,vectorRef(vec,2)) + domainDirectory(dom) := sublisProp(l,domainDirectory dom) + domainAttributes(dom) := sublisProp(l,domainAttributes dom) l := [[a,:devaluate b] for a in names for b in vals] - vectorRef(vec,4) := applySubst(l,vectorRef(vec,4)) - vectorRef(vec,1) := applySubst(l,vectorRef(vec,1)) + domainData(dom) := applySubst(l,domainData dom) + domainDirectory(dom) := sublisProp(l,domainDirectory dom) sublisProp(subst,props) == null props => nil @@ -365,7 +336,7 @@ sublisProp(subst,props) == cond is ['or,:x] => (or/[inspect(u,subst) for u in x] => [a,true,:l]; nil) cond is ["has",nam,b] and (val:= ASSQ(nam,subst)) => - ev:= + ev := b is ['ATTRIBUTE,c] => HasAttribute(rest val,c) b is ['SIGNATURE,c] => HasSignature(rest val,c) isDomainForm(b,$CategoryFrame) => b=rest val @@ -378,22 +349,6 @@ sublisProp(subst,props) == sameObject?(a',cp) and sameObject?(props',rest props) => props [a',:props'] -setVector3(name,instantiator) == - --generates code to set element 3 of 'name' from 'instantiator' - --element 3 is data structure representing category - --returns a single LISP statement - instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body) - ['%store,['%tref,name,3],mkTypeForm instantiator] - -mkDomainFormer x == - if x is ['DomainSubstitutionMacro,parms,body] then - x := DomainSubstitutionFunction(parms,body) - x := applySubst($extraParms,x) - --The next line ensures that only one copy of this structure will - --appear in the BPI being generated, thus saving (some) space - x is ['Join,:.] => ['eval,['QUOTE,x]] - x - mkTypeForm x == x isnt [.,:.] => mkDevaluate x x.op in '(CATEGORY mkCategory) => MKQ x @@ -407,30 +362,6 @@ mkTypeForm x == MKQ x ['%list,MKQ x.op,:[mkTypeForm a for a in x.args]] -setVector5(catNames,locals) == - generated:= nil - for u in locals for uname in catNames repeat - if w:= assoc(u,generated) - then w.rest := [uname,:rest w] - else generated:= [[u,uname],:generated] - [(w:= mkVectorWithDeferral(first u,second u); - for v in rest u repeat - w:= ['%store,['%tref,v,5],w]; - w) - for u in generated] - -mkVectorWithDeferral(objects,tag) == --- Construct a %vector form, but spots things that aren't safe to instantiate --- and places them at the end of $ConstantAssignments, so that they get --- called AFTER the constants of $ have been set up. JHD 26.July.89 - ['%vector,: - [if CONTAINED('$,u) then -- It's not safe to instantiate this now - $ConstantAssignments:=[:$ConstantAssignments, - ['%store,['%tref,['%tref,tag,5],count],u]] - [] - else u - for u in objects for count in 0..]] - DescendCodeAdd(base,flag) == base isnt [.,:.] => DescendCodeVarAdd(base,flag) not (modemap:=get(opOf base,'modemap,$CategoryFrame)) => diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 527b5bf5..ff071ab4 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -479,7 +479,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $ConstantAssignments: local := nil --code for creation of constants $epilogue: local := nil --code to set slot 5, things to be done last $HackSlot4: local := nil --Invention of JHD 13/July/86-set in InvestigateConditions - $extraParms:local := nil --Set in DomainSubstitutionFunction, used in setVector12 + $extraParms:local := nil --Set in DomainSubstitutionFunction $devaluateList: local := nil --Bound to ((#1 . dv$1)..) where &1 := devaluate #1 later $devaluateList:= [[arg,:b] for arg in args for b in $ModeVariableList] $supplementaries: local := nil diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index c46ff38b..41b078fe 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -424,8 +424,6 @@ $m := nil _/SOURCEFILES := [] _/SPACELIST := [] -$extraParms := [] - $categoryPredicateList := [] $getDomainCode := nil |