more cleanup

2 files changed, 77 insertions, 83 deletions

diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index a7765057..c5881ee7 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -101,8 +101,8 @@ substDollarArgs(dollar,domain,object) ==
                 object)
 
 compareSig(sig,tableSig,dollar,domain) ==
-  not (#sig = #tableSig) => false
-  null (target := first sig)
+  #sig ~= #tableSig => false
+  null(target := first sig)
    or lazyCompareSigEqual(target,first tableSig,dollar,domain) =>
      and/[lazyCompareSigEqual(s,t,dollar,domain)
               for s in rest sig for t in rest tableSig]
@@ -121,7 +121,7 @@ compareSigEqual(s,t,dollar,domain) ==
   s = t => true
   atom t =>
     u :=
-      t='$ => dollar
+      t is '$ => dollar
       isSharpVar t =>
         vector? domain =>
           instantiationArgs(domain).(POSN1(t,$FormalMapVariableList))
@@ -131,7 +131,7 @@ compareSigEqual(s,t,dollar,domain) ==
     s is '$ => compareSigEqual(dollar,u,dollar,domain)
     u => compareSigEqual(s,u,dollar,domain)
     s = u
-  s='$ => compareSigEqual(dollar,t,dollar,domain)
+  s is '$ => compareSigEqual(dollar,t,dollar,domain)
   atom s => nil
   #s ~= #t => nil
   match := true
@@ -143,7 +143,6 @@ compareSigEqual(s,t,dollar,domain) ==
 --             Lookup From Interpreter
 --=======================================================
 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
 compiledLookup(op,sig,dollar) ==
 --called by coerceByFunction, evalForm, findEqualFun, findUniqueOpInDomain,
 --  getFunctionFromDomain, optDeltaEntry, retractByFunction
@@ -155,7 +154,28 @@ compiledLookup(op,sig,dollar) ==
   if op = "^" then op := "**"
   basicLookup(op,sig,dollar,dollar)
 
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
+lookupInDomainVector(op,sig,domain,dollar) ==
+  SPADCALL(op,sig,dollar,domainRef(domain,1))
+
+lookupInDomain(op,sig,addFormDomain,dollar,index) ==
+  addFormCell := vectorRef(addFormDomain,index) =>
+    integer? KAR addFormCell =>
+      or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
+    if not vector? addFormCell then
+      addFormCell := eval addFormCell
+    lookupInDomainVector(op,sig,addFormCell,dollar)
+  nil
+
+++ 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
+
 basicLookup(op,sig,domain,dollar) ==
   item := domain.1
   cons? item and first item in '(lookupInDomain lookupInTable) => 
@@ -194,7 +214,7 @@ goGet(:l) ==
   sig := substDomainArgs(thisDomain,sig)
   lookupDomain :=
      domainSlot = 0 => thisDomain
-     thisDomain.domainSlot -- where we look for the operation
+     domainRef(thisDomain,domainSlot) -- where we look for the operation
   if cons? lookupDomain then lookupDomain := evalDomain lookupDomain
   dollar :=                             -- what matches $ in signatures
     explicitLookupDomainIfTrue => lookupDomain
@@ -203,14 +223,14 @@ goGet(:l) ==
   fn:= basicLookup(op,sig,lookupDomain,dollar)
   fn = nil => keyedSystemError("S2NR0001",[op,sig,lookupDomain.0])
   val:= apply(first fn,[:arglist,rest fn])
-  vectorRef(thisDomain,index) := fn
+  domainRef(thisDomain,index) := fn
   val
 
 NRTreplaceLocalTypes(t,dom) ==
    atom t =>
      not integer? t => t
-     t:= dom.t
-     if cons? t then t:= evalDomain t
+     t:= domainRef(dom,t)
+     if cons? t then t := evalDomain t
      canonicalForm t
    first t in '(Mapping Union Record _:) =>
       [first t,:[NRTreplaceLocalTypes(x,dom) for x in rest t]]
@@ -224,7 +244,7 @@ substDomainArgs(domain,object) ==
 --       Category Default Lookup (from goGet or lookupInAddChain)
 --=======================================================
 lookupInCategories(op,sig,dom,dollar) ==
-  catformList := dom.4.0
+  catformList := domainRef(dom,4).0
   varList := ["$",:$FormalMapVariableList]
   nsig := MSUBST(canonicalForm dom,canonicalForm dollar,sig)
   -- the following lines don't need to check for predicates because
@@ -232,9 +252,9 @@ lookupInCategories(op,sig,dom,dollar) ==
   -- builtin constructors -- their predicates are always true.
   r := or/[lookupInDomainVector(op,nsig,
               eval applySubst(pairList(varList,valueList),catform),dollar)
-        for catform in catformList | not null catform] where
+        for catform in catformList | catform ~= nil ] where
            valueList() ==
-              [MKQ dom,:[MKQ dom.(5+i) for i in 1..(#rest catform)]]
+              [MKQ dom,:[MKQ domainRef(dom,5+i) for i in 1..(#rest catform)]]
   r or lookupDisplay(op,sig,'"category defaults",'"-- not found")
 
 --=======================================================
@@ -249,7 +269,7 @@ defaultingFunction op ==
   isDefaultPackageName packageName
 
 lookupInAddChain(op,sig,addFormDomain,dollar) ==
-  addFunction:=lookupInDomain(op,sig,addFormDomain,dollar,5)
+  addFunction := lookupInDomain(op,sig,addFormDomain,dollar,5)
   defaultingFunction addFunction =>
      lookupInCategories(op,sig,addFormDomain,dollar) or addFunction
   addFunction or lookupInCategories(op,sig,addFormDomain,dollar)
@@ -258,35 +278,36 @@ lookupInAddChain(op,sig,addFormDomain,dollar) ==
 --       Lookup Function in Slot 1 (via SPADCALL)
 --=======================================================
 lookupInTable(op,sig,dollar,[domain,table]) ==
-  table = "derived" => lookupInAddChain(op,sig,domain,dollar)
-  success := false
+  table is "derived" => lookupInAddChain(op,sig,domain,dollar)
+  success := nil             -- lookup result
   someMatch := false
   while not success for [sig1,:code] in LASSQ(op,table) repeat
     success :=
       not compareSig(sig,sig1,canonicalForm dollar,domain) => false
-      code is ['subsumed,a] =>
-            subsumptionSig :=
-              applySubst(pairList($FormalMapVariableList,canonicalForm(domain).args),a)
-            someMatch := true
-            false
+      code is ['Subsumed,a] =>
+        subsumptionSig :=
+          applySubst(pairList($FormalMapVariableList,canonicalForm(domain).args),a)
+        someMatch := true
+        nil
       predIndex := code quo 8192
       predIndex ~= 0 and not lookupPred($predVector.predIndex,dollar,domain)
-        => false
+        => nil
       loc := (code rem 8192) quo 2
       loc = 0 =>
         someMatch := true
         nil
-      slot := domain.loc
+      slot := domainRef(domain,loc)
       slot is ["goGet",:.] =>
         lookupDisplay(op,sig,domain,'" !! goGet found, will ignore")
         lookupInAddChain(op,sig,domain,dollar) or 'failed
-      null slot =>
+      slot = nil =>
         lookupDisplay(op,sig,domain,'" !! null slot entry, continuing")
         lookupInAddChain(op,sig,domain,dollar) or 'failed
       lookupDisplay(op,sig,domain,'" !! found in NEW table!!")
       slot
-  success isnt 'failed and success => success
-  subsumptionSig and (u:= SPADCALL(op,subsumptionSig,dollar,domain.1)) => u
+  success isnt 'failed and success ~= nil => success
+  subsumptionSig ~= nil and
+    (u := SPADCALL(op,subsumptionSig,dollar,domainRef(domain,1))) => u
   someMatch => lookupInAddChain(op,sig,domain,dollar)
   nil
 
@@ -514,7 +535,7 @@ Enumeration(:"args") ==
   dom
 
 EnumEqual(e1,e2,dom) == 
-  e1=e2
+  scalarEq?(e1,e2)
 
 EnumPrint(enum, dom) == 
   instantiationArgs(dom).enum
@@ -524,7 +545,7 @@ createEnum(sym, dom) ==
   val := -1
   for v in args for i in 0.. repeat
      sym=v => return(val:=i)
-  val<0 => userError ['"Cannot coerce",sym,'"to",["Enumeration",:args]]
+  val < 0 => userError ['"Cannot coerce",sym,'"to",["Enumeration",:args]]
   val
 
 --% INSTANTIATORS
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 8962ebf9..9b0eaab7 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -166,7 +166,7 @@ replaceGoGetSlot env ==
 --=======================================================
 
 lookupComplete(op,sig,dollar,env) == 
-  newLookupInTable(op,sig,dollar,env,nil)
+  newLookupInTable(op,sig,dollar,env,false)
  
 lookupIncomplete(op,sig,dollar,env) == 
   newLookupInTable(op,sig,dollar,env,true)
@@ -189,18 +189,19 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
     flag => newLookupInAddChain(op,sig,domain,dollar)
     nil
   idxmax := maxIndex numvec
-  start := opvec.k
+  start := vectorRef(opvec,k)
   finish :=
-    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    max > k => vectorRef(opvec,k + 2)
     idxmax
-  if QSGREATERP(finish,idxmax) then systemError '"limit too large"
-  numArgs := QSDIFFERENCE(#sig,1)
+  if finish > idxmax then
+    systemError '"limit too large"
+  numArgs := #sig - 1
   success := nil
   $isDefaultingPackage: local :=
     -- use special defaulting handler when dollar non-trivial
     dollar ~= domain and isDefaultPackageForm? devaluate domain
   while finish > start repeat
-    PROGN
+    do
       i := start
       numArgs ~= (numTableArgs := arrayRef(numvec,i)) => nil
       predIndex := arrayRef(numvec,i := i + 1)
@@ -209,17 +210,17 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
       null loc => nil  --signifies no match
       loc = 1 => (someMatch := true)
       loc = 0 =>
-        start := QSPLUS(start,QSPLUS(numTableArgs,4))
+        start := start + numTableArgs + 4
         i := start + 2
         someMatch := true --mark so that if subsumption fails, look for original
         subsumptionSig :=
-          [newExpandTypeSlot(arrayRef(numvec,QSPLUS(i,j)),
+          [newExpandTypeSlot(arrayRef(numvec,i + j),
             dollar,domain) for j in 0..numTableArgs]
         if $monitorNewWorld then
           sayBrightly [formatOpSignature(op,sig),'"--?-->",
             formatOpSignature(op,subsumptionSig)]
         nil
-      slot := vectorRef(domain,loc)
+      slot := domainRef(domain,loc)
       cons? slot =>
         slot.op is 'newGoGet => someMatch:=true
                    --treat as if operation were not there
@@ -231,46 +232,18 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
       slot is 'skip =>       --recursive call from above 'replaceGoGetSlot
         return (success := newLookupInAddChain(op,sig,domain,dollar))
       systemError '"unexpected format"
-    start := QSPLUS(start,QSPLUS(numTableArgs,4))
+    start := start + numTableArgs + 4
   success isnt 'failed and success =>
     if $monitorNewWorld then
       sayLooking1('"<----",uu) where uu() ==
         cons? success => [first success,:devaluate rest success]
         success
     success
-  subsumptionSig and (u:= basicLookup(op,subsumptionSig,domain,dollar)) => u
-  flag or someMatch => newLookupInAddChain(op,sig,domain,dollar)
+  subsumptionSig ~= nil
+    and (u := basicLookup(op,subsumptionSig,domain,dollar)) => u
+  flag or someMatch ~= nil => newLookupInAddChain(op,sig,domain,dollar)
   nil
  
- 
---=======================================================
---   Lookup In Domain (from lookupInAddChain)
---=======================================================
-lookupInDomain(op,sig,addFormDomain,dollar,index) ==
-  addFormCell := vectorRef(addFormDomain,index) =>
-    integer? KAR addFormCell =>
-      or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell]
-    if not vector? addFormCell then
-      addFormCell := eval addFormCell
-    lookupInDomainVector(op,sig,addFormCell,dollar)
-  nil
-
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-lookupInDomainVector(op,sig,domain,dollar) ==
-  slot1 := vectorRef(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
-
 --=======================================================
 --       Lookup Addlist (from lookupInDomainTable or lookupInDomain)
 --=======================================================
@@ -300,7 +273,7 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) ==
 --       Category Default Lookup (from goGet or lookupInAddChain)
 --=======================================================
 newLookupInCategories(op,sig,dom,dollar) ==
-  slot4 := vectorRef(dom,4)
+  slot4 := domainRef(dom,4)
   catVec := second slot4
   # catVec = 0 => nil                      --early exit if no categories
   integer? KDR canonicalForm catVec =>
@@ -336,8 +309,8 @@ newLookupInCategories(op,sig,dom,dollar) ==
             null code => nil
             byteVector := CDDDR infovec.3
             endPos :=
-              code+2 > max => # byteVector
-              opvec.(code+2)
+              code + 2 > max => # byteVector
+              vectorRef(opvec,code+2)
             not nrunNumArgCheck(#sig.source,byteVector,opvec.code,endPos) => nil
             --numOfArgs := byteVector.(opvec.code)
             --numOfArgs ~= #sig.source => nil
@@ -354,7 +327,7 @@ newLookupInCategories(op,sig,dom,dollar) ==
               vectorRef(packageVec,i) := package
               package
           nil
-        not success =>
+        success = nil =>
           if $monitorNewWorld = true then
             sayBrightlyNT '"  not in: "
             pp (packageForm and devaluate package or entry)
@@ -385,12 +358,12 @@ newLookupInCategories1(op,sig,dom,dollar) ==
   if $monitorNewWorld = true then sayBrightly concat('"----->",
     form2String devaluate dom,'"-----> searching default packages for ",op)
   predvec := domainPredicates dom
-  slot4 := vectorRef(dom,4)
+  slot4 := domainRef(dom,4)
   packageVec := first slot4
   catVec := second slot4
   --the next three lines can go away with new category world
   varList := ['$,:$FormalMapVariableList]
-  valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(#instantiationArgs dom)]]
+  valueList := [dom,:[domainRef(dom,5+i) for i in 1..(#instantiationArgs dom)]]
   valueList := [MKQ val for val in valueList]
   nsig := MSUBST(canonicalForm dom,canonicalForm dollar,sig)
   for i in 0..maxIndex packageVec | (entry := vectorRef(packageVec,i))
@@ -541,17 +514,17 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) ==
 
 lookupInDomainByName(op,domain,arg) ==
   atom arg => nil
-  opvec := domain . 1 . 2
+  opvec := domainRef(domain,1) . 2
   numvec := getDomainByteVector domain
   predvec := domainPredicates domain
   max := maxIndex opvec
   k := getOpCode(op,opvec,max) or return nil
   idxmax := maxIndex numvec
-  start := opvec.k
+  start := vctorRef(opvec,k)
   finish :=
-    QSGREATERP(max,k) => opvec.(QSPLUS(k,2))
+    max > k => vectorRef(opvec,k + 2)
     idxmax
-  if QSGREATERP(finish,idxmax) then systemError '"limit too large"
+  if finish > idxmax then systemError '"limit too large"
   success := false
   while finish > start repeat
     i := start
@@ -560,9 +533,9 @@ lookupInDomainByName(op,domain,arg) ==
     predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
     slotIndex := arrayRef(numvec,i + 2 + numberOfArgs)
     newStart := QSPLUS(start,QSPLUS(numberOfArgs,4))
-    slot := vectorRef(domain,slotIndex)
+    slot := domainRef(domain,slotIndex)
     cons? slot and sameObject?(first slot,first arg) and sameObject?(rest slot,rest arg) => return (success := true)
-    start := QSPLUS(start,QSPLUS(numberOfArgs,4))
+    start := start + numberOfArgs + 4
   success
  
 --=======================================================
@@ -621,7 +594,7 @@ sigDomainVal(dollar,domain,index) ==
 --returns a domain or a lazy slot
   index = 0 => "$"
   index = 2 => domain
-  vectorRef(domain,index)
+  domainRef(domain,index)
 
 --=======================================================
 --          Convert Lazy Domain to Domain Form
@@ -636,7 +609,7 @@ lazyDomainSet(lazyForm,thisDomain,slot) ==
     sayLooking1(concat(form2String devaluate thisDomain,
       '" activating lazy slot ",slot,'": "),slotDomain)
   name := first form
-  vectorRef(thisDomain,slot) := slotDomain
+  domainRef(thisDomain,slot) := slotDomain
  
 
 ++ Return a type form where all niladic constructors are