* interp/nrunfast.boot (newLookupInTable): Compare domain and

	dollar as objects, not as value.
	(newLookupInCategories): Remove deadcode.
	(newExpandGoGetTypes): Remove as unused.

6 files changed, 46 insertions, 56 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 594729cc..47b69ce4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2011-08-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/nrunfast.boot (newLookupInTable): Compare domain and
+	dollar as objects, not as value.
+	(newLookupInCategories): Remove deadcode.
+	(newExpandGoGetTypes): Remove as unused.
+
 2011-08-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/define.boot (NRTgetLookupFunction): Handle the case where
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index 39340f6a..a7c1efa4 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -401,7 +401,7 @@ dbGatherDataImplementation(htPage,opAlist) ==
   for (x := [.,.,:key]) in u for i in 0.. repeat
     key = domainForm => domexports := [x,:domexports]
     integer? key => unexports := [x,:unexports]
-    isDefaultPackageForm? key => defexports := [x,:defexports]
+    defaultPackageForm? key => defexports := [x,:defexports]
     key is 'nowhere => nowheres := [x,:nowheres]
     key is 'constant =>constants := [x,:constants]
     others := [x,:others]   --add chain domains go here
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index dc663fa7..53926f37 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -877,7 +877,7 @@ isDefaultPackageName x ==
   s := symbolName x
   stringChar(s,maxIndex s) = char "&"
 
-isDefaultPackageForm? x ==
+defaultPackageForm? x ==
   x is [op,:.] and ident? op and isDefaultPackageName op
 
 makeDefaultPackageName x ==
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 5067a3f2..4d4f066e 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -473,7 +473,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
   success := nil
   $isDefaultingPackage: local :=
     -- use special defaulting handler when dollar non-trivial
-    dollar ~= domain and isDefaultPackageForm? devaluate domain
+    dollar ~= domain and defaultPackageForm? devaluate domain
   while finish > start repeat
     PROGN
       i := start
@@ -631,7 +631,7 @@ newHasCategory(domain,catform) ==
   slot4 := domain.4
   auxvec := first slot4
   catvec := second slot4
-  $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain
+  $isDefaultingPackage: local := defaultPackageForm? devaluate domain
   #catvec > 0 and integer? KDR catvec.0 =>              --old style
     predIndex := lazyMatchAssocV1(catform,catvec,domain)
     null predIndex => false
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 3424ecf1..23614946 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -191,16 +191,24 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
   success := nil
   $isDefaultingPackage: local :=
     -- use special defaulting handler when dollar non-trivial
-    dollar ~= domain and isDefaultPackageForm? devaluate domain
+    not sameObject?(dollar,domain) and defaultPackageForm? canonicalForm domain
   while finish > start repeat
     do
+      -- a. Skip if non-matching arity.
       i := start
-      numArgs ~= (numTableArgs := arrayRef(numvec,i)) => nil
-      predIndex := arrayRef(numvec,i := i + 1)
+      numTableArgs := arrayRef(numvec,i)
+      numArgs ~= numTableArgs => nil
+      -- b. Skip if predicate untrue.
+      i := i + 1
+      predIndex := arrayRef(numvec,i)
       predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil
-      loc := newCompareSig(sig,numvec,(i := i + 1),dollar,domain)
+      -- c. Skip if differing signature.
+      i := i + 1
+      loc := newCompareSig(sig,numvec,i,dollar,domain)
       null loc => nil  --signifies no match
-      loc = 1 => (someMatch := true)
+      -- d. Should we consider for inherited operator?
+      loc = 1 => someMatch := true
+      -- e. Operator may be subsumed?
       loc = 0 =>
         start := start + numTableArgs + 4
         i := start + 2
@@ -211,18 +219,11 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
         if $monitorNewWorld then
           sayBrightly [formatOpSignature(op,sig),'"--?-->",
             formatOpSignature(op,subsumptionSig)]
-        nil
       slot := domainRef(domain,loc)
       cons? slot =>
-        slot.op is 'newGoGet => someMatch:=true
+        slot.op is 'newGoGet => someMatch := true
                    --treat as if operation were not there
-        --if sameObject?(QCAR slot,'newGoGet) then
-        --  UNWIND_-PROTECT --break infinite recursion
-        --    ((SETELT(domain,loc,'skip); slot := replaceGoGetSlot rest slot),
-        --      if domain.loc is 'skip then domain.loc := slot)
         return (success := slot)
-      slot is 'skip =>       --recursive call from above 'replaceGoGetSlot
-        return (success := newLookupInAddChain(op,sig,domain,dollar))
       systemError '"unexpected format"
     start := start + numTableArgs + 4
   success isnt 'failed and success =>
@@ -290,35 +291,22 @@ newLookupInCategories(op,sig,dom,dollar) ==
       ident? entry =>
         cat := vectorRef(catVec,i)
         packageForm := nil
-        if not property(entry,'LOADED) then loadLib entry
+        if property(entry,'LOADED) = nil then loadLib entry
         infovec := property(entry,'infovec)
         success :=
-          --vector? infovec =>  ----new world
-          true =>  ----new world
-            opvec := infovec.1
-            max := maxIndex opvec
-            code := getOpCode(op,opvec,max)
-            null code => nil
-            byteVector := CDDDR infovec.3
-            endPos :=
-              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
-            packageForm := [entry,'$,:rest cat]
-            package := evalSlotDomain(packageForm,dom)
-            vectorRef(packageVec,i) := package
-            package
-                           ----old world
-          table := tableValue($Slot1DataBase,entry) or systemError nil
-          (u := LASSQ(op,table))
-            and (v := or/[rest x for x in u | #sig = #x.0]) =>
-              packageForm := [entry,'$,:rest cat]
-              package := evalSlotDomain(packageForm,dom)
-              vectorRef(packageVec,i) := package
-              package
-          nil
+          [.,opvec,:.] := infovec
+          max := maxIndex opvec
+          code := getOpCode(op,opvec,max)
+          null code => nil
+          [.,.,.,[.,.,.,:byteVector],:.] := infovec
+          endPos :=
+            code + 2 > max => # byteVector
+            vectorRef(opvec,code+2)
+          not nrunNumArgCheck(#sig.source,byteVector,opvec.code,endPos) => nil
+          packageForm := [entry,'$,:rest cat]
+          package := evalSlotDomain(packageForm,dom)
+          vectorRef(packageVec,i) := package
+          package
         success = nil =>
           if $monitorNewWorld then
             sayBrightlyNT '"  not in: "
@@ -432,17 +420,16 @@ lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
  
 lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
   if s is '$ then
-    --  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
     s := devaluate dollar -- calls from HasCategory can have $s
   integer? a =>
     not typeFlag => s = domainRef(domain,a)
     a = 6 and $isDefaultingPackage => s = devaluate dollar
-    vector? (d := domainVal(dollar,domain,a)) =>
-      s = d.0 => true
+    d := domainVal(dollar,domain,a)
+    vector? d =>
+      s = canonicalForm d => true
       domainArg := ($isDefaultingPackage => domain.6.0; domain.0)
-      KAR s = first d.0 and
+      KAR s = canonicalForm(d).op and
         lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg)
-    --vector? first d => lazyMatch(s,CDDR d,dollar,domain)      --old style (erase)
     lazyMatch(replaceSharpCalls s,d,dollar,domain)       --new style
   a is '$ => s = devaluate dollar
   a is "$$" => s = devaluate domain
@@ -451,7 +438,7 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
     s is ['QUOTE,y] and PNAME y = a
     ident? s and symbolName s = a
   a isnt [.,:.] =>  a = s
-  op := opOf a
+  op := a.op
   op is 'NRTEVAL => s = nrtEval(second a,domain)
   op is 'QUOTE => s = second a
   lazyMatch(s,a,dollar,domain)
@@ -512,7 +499,7 @@ lookupInDomainByName(op,domain,arg) ==
   max := maxIndex opvec
   k := getOpCode(op,opvec,max) or return nil
   idxmax := maxIndex numvec
-  start := vctorRef(opvec,k)
+  start := vectorRef(opvec,k)
   finish :=
     max > k => vectorRef(opvec,k + 2)
     idxmax
@@ -533,14 +520,10 @@ lookupInDomainByName(op,domain,arg) ==
 --=======================================================
 --        Expand Signature from Encoded Slot Form
 --=======================================================
-newExpandGoGetTypeSlot(slot,dollar,domain) ==
-  newExpandTypeSlot(slot,domain,domain)
- 
 newExpandTypeSlot(slot, dollar, domain) ==
 -- returns domain form for dollar.slot
    newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain)
  
- 
 newExpandLocalType(lazyt,dollar,domain) ==
   vector? lazyt => canonicalForm lazyt
   lazyt isnt [.,:.] => lazyt
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 347a09a1..4829d5e0 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -58,7 +58,7 @@ showImp(dom,:options) ==
   for (x := [.,.,:key]) in u repeat
     key = domainForm => domexports := [x,:domexports]
     integer? key => unexports := [x,:unexports]
-    isDefaultPackageForm? key => defexports := [x,:defexports]
+    defaultPackageForm? key => defexports := [x,:defexports]
     key is 'nowhere => nowheres := [x,:nowheres]
     key is 'constant => constants := [x,:constants]
     others := [x,:others]   --add chain domains go here