diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/define.boot | 2 | ||||
| -rw-r--r-- | src/interp/functor.boot | 129 | ||||
| -rw-r--r-- | src/interp/wi2.boot | 2 |
3 files changed, 2 insertions, 131 deletions
diff --git a/src/interp/define.boot b/src/interp/define.boot index e8f9e9e9..5da7a327 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1456,7 +1456,7 @@ compCapsuleInner(itemList,m,e) == if $addForm then data:= ['add,$addForm,data] code:= $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data - processFunctorOrPackage($form,$signature,data,localParList,m,e) + processFunctor($form,$signature,data,localParList,e) [MKPF([:$getDomainCode,code],"PROGN"),m,e] --% PROCESS FUNCTOR CODE diff --git a/src/interp/functor.boot b/src/interp/functor.boot index e77b50fa..e7858752 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -997,135 +997,6 @@ isCategoryPackageName nam == p := PNAME opOf nam p.(MAXINDEX p) = char '_& -processFunctorOrPackage(form,signature,data,localParList,m,e) == - processFunctor(form,signature,data,localParList,e) - -processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) == - $GENNO: local:= 0 --for GENVAR() - $catsig: local := nil - --used in ProcessCond - $ResetItems: local := nil - --stores those items that get SETQed, and may need re-processing - $catvecList: local:= [$domainShell] - $catNames: local:= ["$"] - catvec:= $domainShell --from compDefineFunctor - $getDomainCode:= optFunctorBody $getDomainCode - --the purpose of this is so ProcessCond recognises such items - code:= PackageDescendCode(code,true,nil) - if delete(nil,locals) then code:=[:code,:(setPackageCode locals)] where - setPackageCode locals == - locals':=[[u,:i] for u in locals for i in 0.. | u] - locals'' :=[] - while locals' repeat - for v in locals' repeat - [u,:i]:=v - if and/[EQ(v,v') or not subTree(u,CAR v') for v' in locals'] - then - locals'':=[v,:locals''] - locals':=delete(v,locals') - precomp:=code:=[] - for elem in locals'' repeat - [u,:i]:=elem - if ATOM u then u':=u - else - u':=opt(u,precomp) where - opt(u,alist) == - ATOM u => u - for v in u repeat - if (a:=assoc(v,alist)) then - [.,:i]:=a - u:=replace(v,["getShellEntry","$",i],u) where - replace(old,new,l) == - l isnt [h,:t] => l - h = old => [new,:t] - [h,:replace(old,new,t)] - v':=opt(v,alist) - EQ(v,v') => nil - u:=replace(v,v',u) - u - precomp:=[elem,:precomp] - code:=[["setShellEntry","$",i,u'],:code] - nreverse code - code:= - ["PROGN",:$getDomainCode,["%LET","$",["newShell",#locals]], - --It is important to place this code here, - --after $ is set up - --slam functor with shell - --the order of steps in this PROGN are critical - addToSlam($definition,"$"),code,[ - "SETELT","$",0, mkDomainConstructor $definition],: --- If we call addMutableArg this early, then recurise calls to this domain --- (e.g. while testing predicates) will generate new domains => trouble --- "SETELT","$",0,addMutableArg mkDomainConstructor $definition],: - [["SETELT","$",position(name,locals),name] - for name in $ResetItems | MEMQ(name,locals)], - :[($mutableDomain => '(RPLACD (LASTNODE (ELT $ 0)) - (LIST (GENSYM)));[]) ], - "$"] - for u in $getDomainCode repeat - u is ["%LET",.,u'] and u' is ['getDomainView,.,u''] => - $packagesUsed:=union(CategoriesFromGDC u'',$packagesUsed) - $packagesUsed:=union($functorLocalParameters,$packagesUsed) - $getDomainCode:= nil - --if we didn't kill this, DEFINE would insert it in the wrong place - optFunctorBody code - -subTree(u,v) == - v=u => true - ATOM v => nil - or/[subTree(u,v') for v' in v] - -setPackageLocals(pac,locs) == - for var in locs for i in 0.. | var^=nil repeat pac.i:= var - -PackageDescendCode(code,flag,viewAssoc) == - --flag is true if we are walking down code always executed - --nil if we are in conditional code - code=nil => nil - code="%noBranch" => nil - code is ["add",base,:codelist] => - systemError '"packages may not have add clauses" - code is ["PROGN",:codelist] => - ["PROGN",: - [v for u in codelist | (v:= PackageDescendCode(u,flag,viewAssoc))^=nil]] - code is ["COND",:condlist] => - c:= - ["COND",: - [[u2:= ProcessCond(first u,viewAssoc),: - (if null u2 - then nil - else - [PackageDescendCode(v,flag and TruthP u2, - if first u is ["HasCategory",dom,cat] - then [[dom,:cat],:viewAssoc] - else viewAssoc) for v in rest u])] for u in condlist]] - TruthP CAADR c => ["PROGN",:CDADR c] - c - code is ["%LET",name,body,:.] => - if not MEMQ(name,$ResetItems) then $ResetItems:= [name,:$ResetItems] - if body is [a,:.] and isFunctor a - then $packagesUsed:=[body,:$packagesUsed] - code - code is ["CodeDefine",sig,implem] => - --Generated by doIt in COMPILER BOOT - dom:= "$" - dom:= - u:= LASSOC(dom,viewAssoc) => ["getDomainView",dom,u] - dom - body:= ["CONS",implem,dom] - SetFunctionSlots(sig,body,flag,"original") - code is [":",:.] => (RPLACA(code,"LIST"); RPLACD(code,NIL)) - --Yes, I know that's a hack, but how else do you kill a line? - code is ["LIST",:.] => nil - code is ["MDEF",:.] => nil - code is ["devaluate",:.] => nil - code is ["call",:.] => code - code is ["SETELT",:.] => code - code is ["QSETREFV",:.] => code - code is ["setShellEntry",:.] => code - stackWarning('"unknown Package code: %1 ",[code]) - code - mkOperatorEntry(domainOrPackage,opSig is [op,sig,:flag],pred,count) == domainOrPackage^="domain" => [opSig,pred,["PAC","$",name]] where diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 6540c99f..3537836c 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -372,7 +372,7 @@ compCapsuleInner(itemList,m,e) == if $addForm then data:= ['add,$addForm,data] code:= $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data - processFunctorOrPackage($form,$signature,data,localParList,m,e) + processFunctor($form,$signature,data,localParList,e) [MKPF([:$getDomainCode,code],"PROGN"),m,e] compSingleCapsuleItem(item,$predl,$e) == |