1 files changed, 83 insertions, 11 deletions

diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index db4bd860..9dd8bff1 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -290,6 +290,38 @@ NRTassignCapsuleFunctionSlot(op,sig) ==
   $NRTdeltaListComp := [nil,:$NRTdeltaListComp]
   $NRTdeltaLength := $NRTdeltaLength+1
 
+
+++ NRTaddInner should call following function instead of NRTgetLocalIndex
+++ This would prevent putting spurious items in $NRTdeltaList
+NRTinnerGetLocalIndex x ==
+  atom x => x
+  -- following test should skip Unions, Records, Mapping
+  op := first x
+  op in '(Union Record Mapping Enumeration _[_|_|_]) => NRTgetLocalIndex x
+  constructor? op => NRTgetLocalIndex x
+  NRTaddInner x
+
+
+NRTaddInner x ==
+--called by genDeltaEntry and others that affect $NRTdeltaList
+  PROGN
+    atom x => nil
+    x is ['Record,:l] =>
+      for [.,.,y] in l repeat NRTinnerGetLocalIndex y
+    first x in '(Union Mapping _[_|_|_]) =>
+      for y in rest x repeat
+         y is [":",.,z] => NRTinnerGetLocalIndex z
+         NRTinnerGetLocalIndex y
+    x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y
+    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
+
+
 NRTisExported? opSig ==
   or/[u for u in $domainShell.1 | u.0 = opSig]
 
@@ -333,6 +365,27 @@ consDomainForm(x,dc) ==
   get(x,'value,$e) or get(x,'mode,$e) => x
   MKQ x
 
+
+++ Called by buildFunctor fill $template slots with names 
+++ of compiled functions
+NRTdescendCodeTran(u,condList) ==
+  null u => nil
+  u is ['LIST] => nil
+  u is [op,.,i,a] and MEMQ(op,'(setShellEntry SETELT QSETREFV)) =>
+    null condList and a is ['CONS,fn,:.] =>
+      RPLACA(u,'LIST)
+      RPLACD(u,nil)
+      $template.i :=
+        fn = 'IDENTITY => a
+        fn is ['dispatchFunction,fn'] => fn'
+        fn
+    nil   --code for this will be generated by the instantiator
+  u is ['COND,:c] =>
+    for [pred,:y] in c|y repeat NRTdescendCodeTran(first y,[pred,:condList])
+  u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList)
+  nil
+
+
 buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
 --PARAMETERS
 --  $definition: constructor form, e.g. (SquareMatrix 10 (RationalNumber))
@@ -488,9 +541,6 @@ NRTcheckVector domainShell ==
       [[first v,:$SetFunctions.i],:alist]
   alist
 
--- Obsolete once we have moved to JHD's world
-NRTvectorCopy(cacheName,domName,deltaLength) == GETREFV ($NRTbase + deltaLength)
-
 mkDomainCatName id == INTERN STRCONC(id,";CAT")
 
 NRTsetVector4(siglist,formlist,condlist) ==
@@ -579,11 +629,6 @@ NRTsetVector4a(sig,form,cond) ==
   cond = true => $uncondList := [form,:APPEND(evalform.4.0,$uncondList)]
   $condList := [[cond,[form,:evalform.4.0]],:$condList]
 
-NRTmakeSlot1 domainShell ==
-  opDirectName := INTERN STRCONC(PNAME first $definition,'";opDirect")
-  fun := '(function lookupInCompactTable)
-  ["setShellEntry", '$,1, ['LIST,fun,'$,opDirectName]]
-
 NRTmakeSlot1Info() ==
 -- 4 cases:
 -- a:T == b add c  --- slot1 directory has #s for entries defined in c
@@ -657,11 +702,11 @@ changeDirectoryInSlot1() ==  --called by NRTbuildFunctor
             $lastPred := pred
        newfnsel :=
          fnsel is ['Subsumed,op1,sig1] =>
-           ['Subsumed,op1,genSlotSig(sig1,"T",$newEnv)]
+           ['Subsumed,op1,genSlotSig(sig1,$newEnv)]
          fnsel
-       [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel]
+       [[op, genSlotSig(sig,$newEnv)] ,pred,newfnsel]
 
-genSlotSig(sig,pred,$e) ==
+genSlotSig(sig,$e) ==
    [NRTgetLocalIndex t for t in sig]
 
 deepChaseInferences(pred,$e) ==
@@ -693,6 +738,33 @@ NRTsubstDelta(initSig) ==
         MEMQ(CAR t,'(Mapping Union Record _:)) =>
            [CAR t,:[replaceSlotTypes(x) for x in rest t]]
         t
+
+mapConsDB x == 
+  [addConsDB y for y in x]
+
+addConsDB x ==
+  min x where
+    min x ==
+      y:=HGET($consDB,x)
+      y => y
+      PAIRP x =>
+        for z in tails x repeat
+          u:=min CAR z
+          if not EQ(u,CAR z) then RPLACA(z,u)
+        HashCheck x
+      REFVECP x =>
+        for i in 0..MAXINDEX x repeat
+          x.i:=min (x.i)
+        HashCheck x
+      STRINGP x => HashCheck x
+      x
+    HashCheck x ==
+      y:=HGET($consDB,x)
+      y => y
+      HPUT($consDB,x,x)
+      x
+  x
+
 -----------------------------SLOT1 DATABASE------------------------------------
 
 updateSlot1DataBase [name,info] == HPUT($Slot1DataBase,name,info)