diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/lisplib.boot | 2 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 6 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 4 | ||||
| -rw-r--r-- | src/interp/template.boot | 12 |
4 files changed, 14 insertions, 10 deletions
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 6347f423..70a35e2b 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -710,7 +710,7 @@ isFunctor x == MEMQ(op,$DomainNames) => true MEMQ(getConstructorKindFromDB op,'(domain package)) u:= get(op,'isFunctor,$CategoryFrame) - or MEMQ(op,'(SubDomain Union Record)) => u + or MEMQ(op,'(SubDomain Union Record Enumeration)) => u constructor? op => prop := get(op,'isFunctor,$CategoryFrame) => prop if getConstructorKindFromDB op = "category" diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 496e66a5..e70f1855 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -122,7 +122,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == for [.,a,b] in rest x for [.,=a,c] in rest compForm]] (x' := isQuasiquote x) => quasiquote encode(x',isQuasiquote compForm,false) - IDENTP op and (constructor? op or MEMQ(op,'(Union Mapping))) => + IDENTP op and (constructor? op or MEMQ(op,'(Union Mapping Enumeration))) => [op,:[encode(y,z,false) for y in rest x for z in rest compForm]] ["NRTEVAL",NRTreplaceAllLocalReferences COPY_-TREE lispize compForm] MEMQ(x,$formalArgList) => @@ -143,9 +143,9 @@ listOfBoundVars form == [form] atom form => [] CAR form = 'QUOTE => [] - EQ(CAR form,":") => listOfBoundVars CADDR form + EQ(CAR form,":") => listOfBoundVars third form -- We don't want to pick up the tag, only the domain - "union"/[listOfBoundVars x for x in CDR form] + "union"/[listOfBoundVars x for x in rest form] optDeltaEntry(op,sig,dc,eltOrConst) == $killOptimizeIfTrue = true => nil diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 44fa5463..876844ab 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -428,7 +428,7 @@ lazyMatch(source,lazyt,dollar,domain) == MEMQ(op,'(Record Union)) and first argl is [":",:.] => and/[stag = atag and lazyMatchArg(s,a,dollar,domain) for [.,stag,s] in sargl for [.,atag,a] in argl] - MEMQ(op,'(Union Mapping _[_|_|_] QUOTE)) => + MEMQ(op,'(Union Mapping _[_|_|_] QUOTE Enumeration)) => and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl] coSig := getDualSignatureFromDB op null coSig => error ["bad Constructor op", op] @@ -510,7 +510,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == MEMQ(functorName, '(Record Union)) and first argl is [":",:.] => [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)] for [.,tag,dom] in argl]] - MEMQ(functorName, '(Union Mapping _[_|_|_])) => + MEMQ(functorName, '(Union Mapping _[_|_|_] Enumeration)) => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] functorName = "QUOTE" => [functorName,:argl] coSig := getDualSignatureFromDB functorName diff --git a/src/interp/template.boot b/src/interp/template.boot index 196a3349..d5c4c816 100644 --- a/src/interp/template.boot +++ b/src/interp/template.boot @@ -100,9 +100,10 @@ evalSlotDomain(u,dollar) == VECP (y := dollar.u) => y y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous? y is [v,:.] => - VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] - IDENTP v and constructor? v or MEMQ(v,'(Record Union Mapping)) => - lazyDomainSet(y,dollar,u) --new style has lazyt + VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] + IDENTP v and constructor? v + or MEMQ(v,'(Record Union Mapping Enumeration)) => + lazyDomainSet(y,dollar,u) --new style has lazyt y y u is ['NRTEVAL,y] => eval y @@ -113,6 +114,7 @@ evalSlotDomain(u,dollar) == u is ['Union,:argl] and first argl is ['_:,.,.] => APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)] for [.,tag,dom] in argl]) + u is ["Enumeration",:.] => eval u u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl]) systemErrorHere '"evalSlotDomain" @@ -286,6 +288,8 @@ NRTaddInner x == getConstructorSignature first x is [.,:ml] => for y in rest x for m in ml | not (y = '$) repeat isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y + x is ["Enumeration",:.] => + for y in rest x repeat NRTinnerGetLocalIndex y keyedSystemError("S2NR0003",[x]) x @@ -295,7 +299,7 @@ NRTinnerGetLocalIndex x == atom x => x -- following test should skip Unions, Records, Mapping op := first x - MEMQ(op,'(Union Record Mapping _[_|_|_])) => NRTgetLocalIndex x + MEMQ(op,'(Union Record Mapping Enumeration _[_|_|_])) => NRTgetLocalIndex x constructor? op => NRTgetLocalIndex x NRTaddInner x |