aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/nruncomp.boot6
-rw-r--r--src/interp/nrunfast.boot4
-rw-r--r--src/interp/template.boot12
-rw-r--r--src/share/doc/msgs/s2-us.msgs2
6 files changed, 24 insertions, 11 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 91eab7a6..fb7283a6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2008-07-08 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/template.boot (evalSlotDomain): Likewise.
+ (NRTaddInner): Likewise.
+ * interp/nrunfast.boot (lazyMatch): Handle Enumeration.
+ (newExpandLocalTypeForm): Likewise.
+ * interp/lisplib.boot (isFunctor): Enumeration is a functor too.
+ * interp/nruncomp.boot (NRTencode): Encode Enumeration too.
+
2008-07-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/spad.lisp (S-PROCESS): Remove Old Boot specific codes.
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
diff --git a/src/share/doc/msgs/s2-us.msgs b/src/share/doc/msgs/s2-us.msgs
index 955ffbd9..d13ced80 100644
--- a/src/share/doc/msgs/s2-us.msgs
+++ b/src/share/doc/msgs/s2-us.msgs
@@ -1164,7 +1164,7 @@ S2NR0001
S2NR0002
Cannot process predicate: %1s
S2NR0003
- Error while instantiating type %1b
+ Error while instantiating type %1pb
S2NR0004
Cannot find domain in template: %1s
S2OO0001