diff options
Diffstat (limited to 'src/interp/functor.boot')
| -rw-r--r-- | src/interp/functor.boot | 30 |
1 files changed, 16 insertions, 14 deletions
diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 63a94544..6b283a96 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -318,7 +318,7 @@ setVector0(catNames,definition) == -- (e.g. while testing predicates) will generate new domains => trouble --definition:= addMutableArg mkDomainConstructor definition for u in catNames repeat - definition:= [($QuickCode => 'QSETREFV; 'SETELT),u,0,definition] + definition:= ["setShellEntry",u,0,definition] definition --presence of GENSYM in arg-list differentiates mutable-domains @@ -389,7 +389,7 @@ setVector3(name,instantiator) == --element 3 is data structure representing category --returns a single LISP statement instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body) - [($QuickCode => 'QSETREFV; 'SETELT),name,3,mkDomainConstructor instantiator] + ["setShellEntry",name,3,mkDomainConstructor instantiator] mkDomainFormer x == if x is ['DomainSubstitutionMacro,parms,body] then @@ -477,7 +477,7 @@ setVector4part3(catNames,catvecList) == for [w,:u] in generated repeat code := compCategories w for v in u repeat - code:= [($QuickCode => 'QSETREFV; 'SETELT),rest v,first v,code] + code:= ["setShellEntry",rest v,first v,code] if CONTAINED('$,w) then $epilogue := [code,:$epilogue] else codeList := [code,:codeList] codeList @@ -492,7 +492,7 @@ setVector5(catNames,locals) == else generated:= [[u,uname],:generated] [(w:= mkVectorWithDeferral(first u,first rest u); for v in rest u repeat - w:= [($QuickCode => 'QSETREFV; 'SETELT),v,5,w]; + w:= ["setShellEntry",v,5,w]; w) for u in generated] @@ -503,8 +503,8 @@ mkVectorWithDeferral(objects,tag) == ['VECTOR,: [if CONTAINED('$,u) then -- It's not safe to instantiate this now $ConstantAssignments:=[:$ConstantAssignments, - [($QuickCode=>'QSETREFV;'SETELT), - [($QuickCode=>'QREFELT;'ELT), tag, 5], + ["setShellEntry", + ["getShellEntry", tag, 5], count, u]] [] @@ -555,10 +555,10 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == if update(u,copyvec,[]) then code:=delete(u,code)) where update(code,copyvec,sofar) == ATOM code =>nil - MEMQ(QCAR code,'(ELT QREFELT)) => + MEMQ(QCAR code,'(getShellEntry ELT QREFELT)) => copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar) true - code is [x,name,number,u'] and MEMQ(x,'(SETELT QSETREFV)) => + code is [x,name,number,u'] and MEMQ(x,'(setShellEntry SETELT QSETREFV)) => update(u',copyvec,[[name,:number],:sofar]) for i in 6..n repeat for u in copyvec.i repeat @@ -574,10 +574,10 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == INTERN('"START2",'"KEYWORD"), i, INTERN('"END2",'"KEYWORD"), j+1],:code] copyvec.i => - v:=[($QuickCode => 'QREFELT;'ELT),instantiatedBase,i] + v:=["getShellEntry",instantiatedBase,i] for u in copyvec.i repeat [name,:count]:=u - v:=[($QuickCode => 'QSETREFV;'SETELT),name,count,v] + v:=["setShellEntry",name,count,v] code:=[v,:code] [['LET,instantiatedBase,base],:code] @@ -625,7 +625,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == u:=member(name,$locals) => CONTAINED('$,body) and isDomainForm(body,$e) => --instantiate domains which depend on $ after constants are set - code:=[($QuickCode => 'QSETREFV; 'SETELT),[($QuickCode => 'QREFELT; 'ELT),'$,5],#$locals-#u,code] + code:=["setShellEntry",["getShellEntry",'$,5],#$locals-#u,code] $epilogue:= TruthP flag => [code,:$epilogue] [['COND,[ProcessCond(flag,viewAssoc),code]],:$epilogue] @@ -653,12 +653,13 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == code is ['call,:.] => code code is ['SETELT,:.] => code -- can be generated by doItIf code is ['QSETREFV,:.] => code -- can be generated by doItIf + code is ["setShellEntry",:.] => code -- can be generated by doItIf stackWarning ['"unknown Functor code ",code] code ConstantCreator u == null u => nil - u is [q,.,.,u'] and (q='SETELT or q='QSETREFV) => ConstantCreator u' + u is [q,.,.,u'] and (q in '(setShellEntry SETELT QSETREFV)) => ConstantCreator u' u is ['CONS,:.] => nil true @@ -689,7 +690,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" then if q is 'CONST and body is ['CONS,a,b] then body := ['CONS,'IDENTITY,['FUNCALL,a,b]] - body:= [($QuickCode => 'QSETREFV; 'SETELT),v,index,body] + body:= ["setShellEntry",v,index,body] if REFVECP $SetFunctions and TruthP flag then u.index:= true --used by CheckVector to determine which ops are missing if v='$ then -- i.e. we are looking at the principal view @@ -714,6 +715,7 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" else if not (catImplem is ['PAC,:.]) then keyedSystemError("S2OR0002",[catImplem]) + body is ["setShellEntry",:.] => body body is ['SETELT,:.] => body body is ['QSETREFV,:.] => body nil @@ -755,7 +757,7 @@ CheckVector(vec,name,catvecListMaker) == --must generate code to fill in for x in $catNames for y in catvecListMaker repeat if y=v then code:= - [[($QuickCode => 'QSETREFV; 'SETELT),name,i,x],:code] + [["setShellEntry",name,i,x],:code] if name='$ then assoc(first v,$CheckVectorList) => nil $CheckVectorList:= |