aboutsummaryrefslogtreecommitdiff
path: root/src/interp/define.boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/define.boot')
-rw-r--r--src/interp/define.boot56
1 files changed, 7 insertions, 49 deletions
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e8b23955..c3173e82 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -49,7 +49,6 @@ module define where
--%
-NRTPARSE := false
$newCompCompare := false
++ List of mutable domains.
@@ -440,15 +439,10 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
atom x => oplist
x is ['DEF,y,:.] => [y,:oplist]
fn(rest x,fn(first x,oplist))
- explicitCatPart := gn cat where gn cat ==
- cat is ['CATEGORY,:.] => rest rest cat
- cat is ['Join,:u] => gn last u
- nil
catvec := eval mkEvalableCategoryForm form
fullCatOpList:=(JoinInner([catvec],$e)).1
catOpList :=
[['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList
- --above line calls the category constructor just compiled
| assoc(op1,capsuleDefAlist)]
null catOpList => nil
packageCategory := ['CATEGORY,'domain,
@@ -590,10 +584,8 @@ compDefineFunctor(df,m,e,prefix,fal) ==
compDefineFunctor1(df,m,e,prefix,fal)
compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
-compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
+compDefineFunctor1(df is ['DEF,form,signature,nils,body],
m,$e,$prefix,$formalArgList) ==
- if NRTPARSE = true then
- [lineNumber,:$functorSpecialCases] := $functorSpecialCases
-- 1. bind global variables
$addForm: local := nil
$subdomain: local := false
@@ -962,9 +954,9 @@ orderByDependency(vl,dl) ==
REMDUP NREVERSE orderedVarList --ordered so ith is indep. of jth if i < j
compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
- m,oldE,$prefix,$formalArgList) ==
+ m,$e,$prefix,$formalArgList) ==
[lineNumber,:specialCases] := specialCases
- e := oldE
+ e := $e
--1. bind global variables
$form: local := nil
$op: local := nil
@@ -996,7 +988,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
argModeList:= stripOffSubdomainConditions(argModeList,argl)
signature':= [first signature,:argModeList]
if null identSig then --make $op a local function
- oldE := put($op,'mode,['Mapping,:signature'],oldE)
+ $e := put($op,'mode,['Mapping,:signature'],$e)
--obtain target type if not given
if null first signature' then signature':=
@@ -1031,7 +1023,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
$compileOnlyCertainItems and _
not member($op, $compileOnlyCertainItems) =>
sayBrightly ['" skipping ", localOrExported,:bright $op]
- [nil,['Mapping,:signature'],oldE]
+ [nil,['Mapping,:signature'],$e]
sayBrightly ['" compiling ",localOrExported,
:bright $op,'": ",:formattedSig]
@@ -1049,13 +1041,12 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
body':= addArgumentConditions(body',$op)
finalBody:= ["CATCH",catchTag,body']
- compileCases([$op,["LAM",[:argl,'_$],finalBody]],oldE)
+ compile [$op,["LAM",[:argl,'_$],finalBody]]
$functorStats:= addStats($functorStats,$functionStats)
-
-- 7. give operator a 'value property
val:= [fun,signature',e]
- [fun,['Mapping,:signature'],oldE] -- oldE:= put($op,'value,removeEnv val,e)
+ [fun,['Mapping,:signature'],$e]
getSignatureFromMode(form,e) ==
getmode(opOf form,e) is ['Mapping,:signature] =>
@@ -1210,39 +1201,6 @@ canCacheLocalDomain(dom,elt)==
and/[domargsglobal(arg) for arg in rest dom]
-compileCases(x,$e) == -- $e is referenced in compile
- $specialCaseKeyList: local := nil
- not ($insideFunctorIfTrue=true) => compile x
- specialCaseAssoc:=
- [y for y in getSpecialCaseAssoc() | not get(first y,"specialCase",$e) and
- ([R,R']:= y) and isEltArgumentIn(FindNamesFor(R,R'),x)] where
- FindNamesFor(R,R') ==
- [R,:
- [v
- for ["%LET",v,u,:.] in $getDomainCode | CADR u=R and
- eval substitute(R',R,u)]]
- isEltArgumentIn(Rlist,x) ==
- atom x => nil
- x is [op,R,.] and op in '(getShellEntry ELT QREFELT) =>
- MEMQ(R,Rlist) or isEltArgumentIn(Rlist,rest x)
- isEltArgumentIn(Rlist,first x) or isEltArgumentIn(Rlist,rest x)
- null specialCaseAssoc => compile x
- listOfDomains:= ASSOCLEFT specialCaseAssoc
- listOfAllCases:= outerProduct ASSOCRIGHT specialCaseAssoc
- cl:=
- [u for l in listOfAllCases] where
- u() ==
- $specialCaseKeyList:= [[D,:C] for D in listOfDomains for C in l]
- [MKPF([["EQUAL",D,C] for D in listOfDomains for C in l],"AND"),
- compile COPY x]
- $specialCaseKeyList:= nil
- ["COND",:cl,[$true,compile x]]
-
-getSpecialCaseAssoc() ==
- [[R,:l] for R in rest $functorForm
- for l in rest $functorSpecialCases | l]
-
-
$savableItems := nil
compile u ==