aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/functor.boot129
-rw-r--r--src/interp/wi2.boot2
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) ==