diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -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 | ||||
| -rw-r--r-- | src/share/doc/msgs/s2-us.msgs | 2 |
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 |