From 5f43d3d90da0109a83feca96b96399f5eaa72d7c Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 16 Dec 2007 17:14:47 +0000
Subject: * nruncomp.boot (NOTES): Encode quasiquoted values too.
($lookupDefaults): Define. (newLookupInDomain): Look up in the add-chain
first. (newLookupInCategories): Likewise. (lazyMatch):
Quasiquote is now like a Mapping. (newExpandLocalTypeForm): Quasiquote
is no longer like QUOTE. * nrungo.boot (lookupInDomainAndDefaults):
New. (compiledLookup): Use it.
---
src/interp/ChangeLog | 11 +++++++++++
src/interp/nruncomp.boot | 3 ++-
src/interp/nrunfast.boot | 12 +++++++-----
src/interp/nrungo.boot | 17 +++++++++++++----
4 files changed, 33 insertions(+), 10 deletions(-)
(limited to 'src')
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index 212bd868..97546f58 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,3 +1,14 @@
+2007-12-16 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * nruncomp.boot (NOTES): Encode quasiquoted values too.
+ ($lookupDefaults): Define.
+ (newLookupInDomain): Look up in the add-chain first.
+ (newLookupInCategories): Likewise.
+ (lazyMatch): Quasiquote is now like a Mapping.
+ (newExpandLocalTypeForm): Quasiquote is no longer like QUOTE.
+ * nrungo.boot (lookupInDomainAndDefaults): New.
+ (compiledLookup): Use it.
+
2007-12-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
* nruncomp.boot (buildFunctor): Use $NRTbase instead of hardcoded
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index d986a708..b7d91c33 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -113,7 +113,8 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
QCAR x='Record or x is ['Union,['_:,a,b],:.] =>
[QCAR x,:[['_:,a,encode(b,c,false)]
for [.,a,b] in QCDR x for [.,=a,c] in CDR compForm]]
- isQuasiquote x => x
+ (x' := isQuasiquote x) =>
+ quasiquote encode(x',isQuasiquote compForm,false)
constructor? QCAR x or MEMQ(QCAR x,'(Union Mapping)) =>
[QCAR x,:[encode(y,z,false) for y in QCDR x for z in CDR compForm]]
['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm]
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index d791335a..6a6c3ed4 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -38,6 +38,9 @@ import '"c-util"
++
$doNotCompressHashTableIfTrue := false
+++
+$lookupDefaults := false
+
--=======================================================================
-- Basic Functions
--=======================================================================
@@ -222,7 +225,7 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
INTEGERP KAR addFormCell =>
or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
if null VECP addFormCell then lazyDomainSet(addFormCell,addFormDomain,index)
- lookupInDomainVector(op,sig,addFormDomain.index,dollar)
+ lookupInDomainAndDefaults(op,sig,addFormDomain.index,dollar,false)
nil
--=======================================================
@@ -368,7 +371,7 @@ newLookupInCategories1(op,sig,dom,dollar) ==
null package => nil
if $monitorNewWorld then
sayLooking1('"Looking at instantiated package ",package)
- res := lookupInDomainVector(op,sig,package,dollar) =>
+ res := lookupInDomainAndDefaults(op,sig,package,dollar,false) =>
if $monitorNewWorld = true then
sayBrightly '"candidate default package succeeds"
return res
@@ -428,9 +431,8 @@ 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)) =>
and/[lazyMatchArg(s,a,dollar,domain) for s in sargl for a in argl]
- op="[||]" => source = lazyt
coSig := GETDATABASE(op,'COSIG)
NULL coSig => error ["bad Constructor op", op]
and/[lazyMatchArg2(s,a,dollar,domain,flag)
@@ -513,7 +515,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
for [.,tag,dom] in argl]]
MEMQ(functorName, '(Union Mapping)) =>
[functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
- functorName in '(QUOTE _[_|_|_]) => [functorName,:argl]
+ functorName = "QUOTE" => [functorName,:argl]
coSig := GETDATABASE(functorName,'COSIG)
NULL coSig => error ["bad functorName", functorName]
[functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 968f4c09..f9b1f17f 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -57,10 +57,8 @@ compiledLookup(op,sig,dollar) ==
basicLookup(op,sig,domain,dollar) ==
domain.1 is ['lookupInDomain,:.] => lookupInDomainVector(op,sig,domain,dollar)
----------new world code follows------------
- $lookupDefaults : local := nil -- new world
- u := lookupInDomainVector(op,sig,domain,dollar) => u
- $lookupDefaults := true
- lookupInDomainVector(op,sig,domain,dollar)
+ u := lookupInDomainAndDefaults(op,sig,domain,dollar,false) => u
+ lookupInDomainAndDefaults(op,sig,domain,dollar,true)
compiledLookupCheck(op,sig,dollar) ==
fn := compiledLookup(op,sig,dollar)
@@ -194,6 +192,17 @@ lookupInDomainVector(op,sig,domain,dollar) ==
slot1 := domain.1
SPADCALL(op,sig,dollar,slot1)
+
+++ same as lookupInDomainVector except that the use of defaults
+++ (either in category packages or add-chains) is controlled
+++ by `useDefaults'.
+lookupInDomainAndDefaults(op,sig,domain,dollar,useDefaults) ==
+ savedLookupDefaults := $lookupDefaults
+ $lookupDefaults := useDefaults
+ fun := lookupInDomainVector(op,sig,domain,dollar)
+ $lookupDefaults := savedLookupDefaults
+ fun
+
--=======================================================
-- Category Default Lookup (from goGet or lookupInAddChain)
--=======================================================
--
cgit v1.2.3