aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog11
-rw-r--r--src/doc/msgs/s2-us.msgs2
-rw-r--r--src/interp/define.boot5
-rw-r--r--src/interp/nruncomp.boot48
4 files changed, 29 insertions, 37 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 78f1adc3..93e454fe 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2011-11-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/define.boot (assignCapsuleFunctionSlot): Slot original
+ signature too.
+ * interp/nruncomp.boot (genDeltaEntry): Likewise.
+ (getLocalIndex): Tidy.
+ (changeDirectoryInSlot1): Tidy.
+ (vectorLocation): Add a kind of operation as fourth argument.
+ Adjust caller. Do not reconstruct the signature.
+ (NRTsubstDelta): Remove as no longer used.
+
2011-11-26 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/nruncomp.boot (assocIndex): Rename from NRTassocIndex.
diff --git a/src/doc/msgs/s2-us.msgs b/src/doc/msgs/s2-us.msgs
index 036836a2..4411bb4b 100644
--- a/src/doc/msgs/s2-us.msgs
+++ b/src/doc/msgs/s2-us.msgs
@@ -1202,7 +1202,7 @@ S2NR0002
S2NR0003
Error while instantiating type %1b
S2NR0004
- Cannot find domain in template: %1s
+ Cannot find domain in template: %1p
S2OO0001
Irregular slot entry: %1s
S2OO0002
diff --git a/src/interp/define.boot b/src/interp/define.boot
index b416aa76..3207d072 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1702,11 +1702,10 @@ assignCapsuleFunctionSlot(db,op,sig) ==
kind = nil => nil -- op is local and need not be assigned
if $insideCategoryPackageIfTrue then
sig := substitute('$,second dbConstructorForm db,sig)
- sig := [getLocalIndex(db,x) for x in sig]
- desc := [op,'$,:sig,kind]
+ desc := [op,'$,:[getLocalIndex(db,x) for x in sig],kind]
n := dbEntitySlot(db,desc) => n --already there
n := dbEntityCount db + $NRTbase
- dbUsedEntities(db) := [[desc],:dbUsedEntities db]
+ dbUsedEntities(db) := [[desc,op,'$,:sig,kind],:dbUsedEntities db]
dbEntityCount(db) := dbEntityCount db + 1
n
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 107dfaa4..5fb775dc 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -219,7 +219,7 @@ genDeltaEntry(op,mm,e) ==
desc := [op,dc,:[getLocalIndex(db,x) for x in nsig],kind]
n := dbEntitySlot(db,desc) => n
n := dbEntityCount db + $NRTbase
- dbUsedEntities(db) := [[desc],:dbUsedEntities db]
+ dbUsedEntities(db) := [[desc,op,dc,:nsig,kind],:dbUsedEntities db]
dbEntityCount(db) := dbEntityCount db + 1
n
impl := optDeltaEntry(op,nsig,odc,kind) => impl
@@ -246,18 +246,17 @@ getLocalIndex(db,item) ==
index := $NRTbase + dbEntityCount db -- slot number to return
dbEntityCount(db) := dbEntityCount db + 1
index
- -- when assigning slot to flag values, we don't really want to
- -- compile them. Rather, we want to record them as if they were atoms.
- flag := isQuasiquote item
entry := [["%domain",NRTaddInner(db,item)]]
dbUsedEntities(db) := [entry,:dbUsedEntities db]
saveIndex := $NRTbase + dbEntityCount db
dbEntityCount(db) := dbEntityCount db + 1
entry.rest :=
+ -- when assigning slot to flag values, we don't really want to
+ -- compile them. Rather, we want to record them as if they were atoms.
-- we don't need to compile the flag again.
-- ??? In fact we should not be compiling again at this phase.
-- ??? That we do is likely a bug.
- flag => item
+ isQuasiquote item => item
compOrCroak(item,$EmptyMode,$e).expr
saveIndex
@@ -606,14 +605,14 @@ changeDirectoryInSlot1 db == --called by buildFunctor
-- dbUsedEntities = nil ===> all slot numbers become nil
$lisplibOperationAlist := [sigloc(db,entry) for entry in categoryExports $domainShell] where
sigloc(db,[opsig,pred,fnsel]) ==
- if pred isnt 'T then
- pred := simpBool pred
- $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
- fnsel is [op,a,:.] and op in '(ELT CONST) =>
- if $insideCategoryPackageIfTrue then
- opsig := substitute('$,first dbParameters db,opsig)
- [opsig,pred,[op,a,vectorLocation(db,first opsig,second opsig)]]
- [opsig,pred,fnsel]
+ if pred isnt true then
+ pred := simpBool pred
+ $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+ fnsel is [kind,a,:.] and kind in '(ELT CONST) =>
+ if $insideCategoryPackageIfTrue then
+ opsig := substitute('$,first dbParameters db,opsig)
+ [opsig,pred,[kind,a,vectorLocation(db,first opsig,second opsig,kind)]]
+ [opsig,pred,fnsel]
sortedOplist := listSort(function GLESSEQP,
copyList $lisplibOperationAlist,function second)
$lastPred: local := false
@@ -641,29 +640,12 @@ deepChaseInferences(pred,$e) ==
pred is 'T or pred is [op,:.] and op in '(NOT not %not) => $e
chaseInferences(pred,$e)
-vectorLocation(db,op,sig) ==
- u := or/[i for i in 1.. for [u,:.] in dbUsedEntities db
- | u is [=op,'$,:xsig,.] and sig = NRTsubstDelta(db,xsig) ]
+vectorLocation(db,op,sig,kind) ==
+ u := or/[i for i in 1.. for [.,:u] in dbUsedEntities db
+ | u is [=op,'$,:xsig,=kind] and sig = xsig]
u => dbEntityCount db - u + $NRTbase
nil -- this signals that calls should be forwarded
-NRTsubstDelta(db,sig) ==
- [replaceSlotTypes(db,t) for t in sig] where
- replaceSlotTypes(db,t) ==
- t isnt [.,:.] =>
- not integer? t => t
- t = 0 => "$"
- t = 2 => "$$"
- t = 5 => $NRTaddForm
- [u,:.] := dbUsedEntities(db).(dbEntityCount db + 5 - t)
- first u = "%domain" => second u
- error "bad dbUsedEntities entry"
- t is [":",x,t'] => [t.op,x,replaceSlotTypes(db,t')]
- first t in '(Enumeration EnumerationCategory) => t
- ident? first t and builtinConstructor? first t =>
- [t.op,:[replaceSlotTypes(db,x) for x in t.args]]
- t
-
-----------------------------SLOT1 DATABASE------------------------------------
NRTputInLocalReferences(db,bod) ==