diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/doc/msgs/s2-us.msgs | 2 | ||||
| -rw-r--r-- | src/interp/define.boot | 5 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 48 |
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) == |