* interp/hashcode.boot: Remove.

	*interp/interop.boot: Move OpenAxiom relevant code to define.boot
	and nrunfast.boot.  Remove.

8 files changed, 73 insertions, 826 deletions

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index fab50106..1731f897 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -65,7 +65,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	astr.$(FASLEXT)		bits.$(FASLEXT)		\
 	ht-util.$(FASLEXT)	bc-util.$(FASLEXT)	\
 	br-search.$(FASLEXT)	alql.$(FASLEXT)		\
-	buildom.$(FASLEXT)	hashcode.$(FASLEXT)	\
+	buildom.$(FASLEXT)	                    	\
 	simpbool.$(FASLEXT)	g-timer.$(FASLEXT)	\
 	cattable.$(FASLEXT)	posit.$(FASLEXT)	\
 	cformat.$(FASLEXT)	clam.$(FASLEXT)		\
@@ -109,7 +109,7 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 
 # Last minite patches.
 # FIXMEL: should be folded into the main object list.
-INOBJS=	setvart.$(FASLEXT) interop.$(FASLEXT) patches.$(FASLEXT)
+INOBJS=	setvart.$(FASLEXT) patches.$(FASLEXT)
 
 # Main compiler files.
 OCOBJS=	\
@@ -299,12 +299,11 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
 compiler.$(FASLEXT): msgdb.$(FASLEXT) pathname.$(FASLEXT) define.$(FASLEXT) 
 nrunfast.$(FASLEXT): c-util.$(FASLEXT)
 nruncomp.$(FASLEXT): profile.$(FASLEXT) simpbool.$(FASLEXT) functor.$(FASLEXT)
-nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
 define.$(FASLEXT): g-error.$(FASLEXT) nruncomp.$(FASLEXT) database.$(FASLEXT)
 database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) daase.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT) \
 		c-util.$(FASLEXT)
-functor.$(FASLEXT): category.$(FASLEXT) interop.$(FASLEXT) lisplib.$(FASLEXT)
+functor.$(FASLEXT): category.$(FASLEXT) lisplib.$(FASLEXT) nrunfast.$(FASLEXT)
 category.$(FASLEXT): c-util.$(FASLEXT) g-cndata.$(FASLEXT)
 cattable.$(FASLEXT): simpbool.$(FASLEXT) c-util.$(FASLEXT)
 compat.$(FASLEXT): pathname.$(FASLEXT)
@@ -312,7 +311,6 @@ simpbool.$(FASLEXT): macros.$(FASLEXT)
 newfort.$(FASLEXT): macros.$(FASLEXT)
 lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT) \
 	daase.$(FASLEXT)
-interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
 c-doc.$(FASLEXT): c-util.$(FASLEXT) daase.$(FASLEXT)
 server.$(FASLEXT): macros.$(FASLEXT)
 
@@ -382,7 +380,6 @@ msgdb.$(FASLEXT): g-util.$(FASLEXT)
 g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
 c-util.$(FASLEXT): g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
-hashcode.$(FASLEXT): g-util.$(FASLEXT)
 g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) sys-utility.$(FASLEXT)
 g-cndata.$(FASLEXT): sys-macros.$(FASLEXT) c-util.$(FASLEXT)
 msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 048efb2f..f4675b08 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -466,6 +466,20 @@ makeCompactSigCode sig == [fn for x in sig] where
 --=======================================================================
 --               Generate Slot 4 Constructor Vectors
 --=======================================================================
+depthAssocList u == 
+  u := removeSymbol(u,'DomainSubstitutionMacro)  --hack by RDJ 8/90
+  removeDuplicates ("append"/[depthAssoc(y) for y in u])
+ 
+depthAssoc x ==
+  y := tableValue($depthAssocCache,x) => y
+  x is ['Join,:u] or (u := getCatAncestors x) =>
+    v := depthAssocList u
+    tableValue($depthAssocCache,x) := [[x,:n],:v]
+      where n() == 1 + "MAX"/[rest y for y in v]
+  tableValue($depthAssocCache,x) := [[x,:0]]
+ 
+getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
+ 
 NRTmakeCategoryAlist() ==
   $depthAssocCache: local := hashTable 'EQ
   $catAncestorAlist: local := nil
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index f8a2ff11..20ed8c36 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -33,7 +33,7 @@
 
 
 import lisplib
-import interop
+import nrunfast
 import category
 namespace BOOT
 
@@ -60,11 +60,6 @@ CategoryPrint(D,$e) ==
     PRETTYPRINT u
 
 --%  Domain printing
-keyItem a ==
-  isDomain a => CDAR domainRef(a,4)
-  a
-  --The item that domain checks on
- 
 --Global strategy here is to maintain a list of substitutions
 --  ( in $Sublis), of vectors and the names that they have,
 --  which may be either local names ('View1') or global names ('Where1')
@@ -78,7 +73,7 @@ DomainPrint(D,brief) ==
   $WhereCounter: local := 1
   env:= $e or $EmptyEnvironment --in case we are called from top level
   categoryObject? D => CategoryPrint(D,env)
-  $Sublis:= [[keyItem D,:'original]]
+  $Sublis:= [[D,:'original]]
   SAY '"-----------------------------------------------------------------------"
   DomainPrint1(D,nil,env)
   while ($WhereList) repeat
@@ -91,7 +86,6 @@ DomainPrint(D,brief) ==
   SAY '"-----------------------------------------------------------------------"
  
 DomainPrint1(D,brief,$e) ==
-  vector? D and not isDomain D => PacPrint D
   if vector? D then
     D := D.4 --if we were passed a vector, go to the domain
   Sublis:=
@@ -110,12 +104,12 @@ DomainPrint1(D,brief,$e) ==
       uu.5 := vv
       for j in 0..maxIndex vv repeat
         if vector? vv.j then
-          l := ASSQ(keyItem vv.j,Sublis)
+          l := ASSQ(vv.j,Sublis)
           if l
              then name:= rest l
              else
               name := DPname()
-              Sublis := [[keyItem vv.j,:name],:Sublis]
+              Sublis := [[vv.j,:name],:Sublis]
               $Sublis := [first Sublis,:$Sublis]
               $WhereList := [[name,:vv.j],:$WhereList]
           vv.j := name
@@ -125,13 +119,13 @@ DomainPrint1(D,brief,$e) ==
       uu.i := DomainPrintSubst(uu.i,Sublis)
       if vector? uu.i then
         name := DPname()
-        Sublis := [[keyItem uu.i,:name],:Sublis]
+        Sublis := [[uu.i,:name],:Sublis]
         $Sublis := [first Sublis,:$Sublis]
         $WhereList := [[name,:uu.i],:$WhereList]
         uu.i := name
       if uu.i is [.,:v] and vector? v then
         name := DPname()
-        Sublis := [[keyItem v,:name],:Sublis]
+        Sublis := [[v,:name],:Sublis]
         $Sublis := [first Sublis,:$Sublis]
         $WhereList := [[name,:v],:$WhereList]
         uu.i := [first uu.i,:name]
@@ -147,22 +141,22 @@ PacPrint v ==
   vv := copyVector v
   for j in 0..maxIndex vv repeat
     if vector? vv.j then
-      l := ASSQ(keyItem vv.j,Sublis)
+      l := ASSQ(vv.j,Sublis)
       if l
          then name := rest l
          else
           name := DPname()
-          Sublis := [[keyItem vv.j,:name],:Sublis]
+          Sublis := [[vv.j,:name],:Sublis]
           $Sublis := [first Sublis,:$Sublis]
           $WhereList := [[name,:vv.j],:$WhereList]
       vv.j := name
     if cons? vv.j and vector?(u:=rest vv.j) then
-      l := ASSQ(keyItem u,Sublis)
+      l := ASSQ(u,Sublis)
       if l
          then name := rest l
          else
           name := DPname()
-          Sublis := [[keyItem u,:name],:Sublis]
+          Sublis := [[u,:name],:Sublis]
           $Sublis := [first Sublis,:$Sublis]
           $WhereList := [[name,:u],:$WhereList]
       vv.j.rest := name
@@ -176,7 +170,7 @@ DomainPrintSubst(item,Sublis) ==
     [c1,:c2]
   l := ASSQ(item,Sublis)
   l => rest l
-  l := ASSQ(keyItem item,Sublis)
+  l := ASSQ(item,Sublis)
   l => rest l
   item
  
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 2efeff70..321f8b9d 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -797,10 +797,6 @@ intern x ==
     makeSymbol x
   x
 
-isDomain a ==
-  cons? a and vector? first a and
-    member(first a.0, $domainTypeTokens)
-
 -- variables used by browser
 
 $htHash      := MAKE_-HASH_-TABLE()
diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot
deleted file mode 100644
index c88c326f..00000000
--- a/src/interp/hashcode.boot
+++ /dev/null
@@ -1,115 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-import g_-util
-namespace BOOT
-
-$DomainsWithoutLisplibs ==
-  '(CAPSULE Union Record SubDomain Mapping Enumeration Mode)
-
-
--- Type hasher for old compiler style type names which produces a hash code
--- compatible with the asharp compiler.  Takes a hard error if the type
--- is parameterized, but has no constructor modemap.
-getDomainHash dom == SPADCALL(rest dom, (first dom).4)
-
-hashType(type, percentHash) ==
-        symbol? type  =>
-           type = '$ => percentHash
-           type = "%" => percentHash
-           hashString symbolName type
-        string? type  => hashCombine(hashString type, 
-                                        hashString('"Enumeration"))
-        type is ['QUOTE, val] => hashType(val, percentHash)
-        type is [dom] => hashString symbolName dom
-        type is ['_:, ., type2] => hashType(type2, percentHash)
-        isDomain type => getDomainHash type
-        [op, :args] := type
-        hash := hashString symbolName op
-        op is 'Mapping =>
-                hash := hashString '"->"
-                [retType, :mapArgs] := args
-                for arg in mapArgs repeat
-                        hash := hashCombine(hashType(arg, percentHash), hash)
-                retCode := hashType(retType, percentHash)
-                scalarEq?(retCode, $VoidHash) => hash
-                hashCombine(retCode, hash)
-        op is 'Enumeration =>
-                for arg in args repeat
-                  hash := hashCombine(hashString(symbolName arg), hash)
-                hash
-        symbolMember?(op,$DomainsWithoutLisplibs) =>
-                for arg in args repeat
-                        hash := hashCombine(hashType(arg, percentHash), hash)
-                hash
-
-        cmm := getConstructorModemap(op).mmSource
-        cosig := rest getDualSignatureFromDB op
-        for arg in args for c in cosig for ct in cmm repeat
-                if c then
-                        hash := hashCombine(hashType(arg, percentHash), hash)
-                else
-                        hash := hashCombine(7, hash)
---           !!!   If/when asharp hashes values using their type, use instead
---                      ctt := applySubst(pairList($FormalMapVariableList,args),ct)
---                      hash := hashCombine(hashType(ctt, percentHash), hash)
-
-
-        hash
-
-$hashModulus := 1073741789                      -- largest 30-bit prime
-
--- Produce a 30-bit hash code.  This function must produce the same codes
--- as the asharp string hasher in src/strops.c
-hashString str ==
-        h := 0
-        for i in 0..#str-1 repeat
-                j := codePoint char str.i
-                h := LOGXOR(h, ASH(h, 8))
-                h := h + j + 200041
-                h := LOGAND(h, 1073741823)      -- 0x3FFFFFFF
-        REM(h, $hashModulus)
-
--- Combine two hash codes to make a new one.  Must be the same as in
--- the hashCombine function in aslib/runtime.as in asharp.
-hashCombine(hash1, hash2) ==
-         MOD(ASH(LOGAND(hash2, 16777215), 6) + hash1, $hashModulus)
-
-
-$VoidHash := hashString '"Void"
-
-
--- following two lines correct bad coSig properties due to SubsetCategory
---putConstructorProperty('LocalAlgebra,'coSig,'(NIL T T T))
---putConstructorProperty('Localize,'coSig,'(NIL T T T))
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
deleted file mode 100644
index c9c0f67d..00000000
--- a/src/interp/interop.boot
+++ /dev/null
@@ -1,669 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical Algorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-import c_-util
-import hashcode
-namespace BOOT
-
--- note domainObjects are now (dispatchVector hashCode . domainVector)
--- lazy oldAxiomDomainObjects are (dispatchVector hashCode  (Call form) . backptr), 
--- pre oldAxiomCategory is (dispatchVector . (cat form))
--- oldAxiomCategory objects are (dispatchVector . ( (cat form)  hash defaultpack parentlist))
-
-hashCode? x == integer? x
-
-$domainTypeTokens == ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory,
-           'oldAxiomCategory, 0]
-
--- The name game.
--- The compiler produces names that are of the form:
--- a) cons(0, <string>)
--- b) cons(1, type-name, arg-names...)
--- c) cons(2, arg-names...)
--- d) cons(3, value)
--- NB: (c) is for tuple-ish constructors, 
---     and (d) is for dependent types.
-
-DNameStringID == 0
-DNameApplyID  == 1
-DNameTupleID  == 2
-DNameOtherID  == 3
-
-DNameToSExpr1 dname ==
-  null dname => error "unexpected domain name"
-  first dname = DNameStringID => 
-    makeSymbol(CompStrToString rest dname)
-  name0 := DNameToSExpr1 second dname
-  args  := rest rest dname
-  name0 is '_-_> => 
-    froms := first args
-    froms := [DNameToSExpr x for x in rest froms]
-    ret   := second args -- a tuple
-    ret   := DNameToSExpr second ret -- contents
-    ['Mapping,:[ret,:froms]]
-  name0 is 'Union or name0 is 'Record =>
-    sxs := [DNameToSExpr x for x in rest first args]
-    [name0,:sxs]
-  name0 is 'Enumeration =>
-    [name0,:[DNameFixEnum x for x in rest first args]]
-  [name0,:[DNameToSExpr x for x in args]]
-
-DNameToSExpr dname ==
-  first dname = DNameOtherID  =>
-        rest dname
-  sx := DNameToSExpr1 dname
-  cons? sx => sx
-  [sx]
-
-DNameFixEnum arg == CompStrToString rest arg
-  
-SExprToDName(sexpr, cosigVal) == 
-  -- is it a non-type valued object?
-  not cosigVal => [DNameOtherID, :sexpr]
-  if first sexpr is '_: then sexpr := third sexpr
-  first sexpr is 'Mapping =>
-    args := [ SExprToDName(sx,true) for sx in rest sexpr]
-    [DNameApplyID,
-         [DNameStringID,: StringToCompStr '"->"],
-              [DNameTupleID, : rest args],
-                 [DNameTupleID, first args]]
-  name0 :=   [DNameStringID, : StringToCompStr symbolName first sexpr]
-  first sexpr is 'Union or first sexpr is 'Record =>
-    [DNameApplyID, name0, 
-        [DNameTupleID,: [ SExprToDName(sx,true) for sx in rest sexpr]]]
-  newCosig := rest getDualSignatureFromDB first sexpr
-  [DNameApplyID, name0,
-   :[SExprToDName(x,f) for x in rest sexpr for f in newCosig]]
-
--- local garbage because Compiler strings are null terminated
-StringToCompStr(str) == 
-   strconc(str, charString abstractChar 0)
-
-CompStrToString(str) == 
-   subString(str, 0, #str - 1)
--- local garbage ends
-
-runOldAxiomFunctor(:allArgs) ==
-  [:args,env] := allArgs
-  getConstructorKindFromDB env is "category" =>
-      [$oldAxiomPreCategoryDispatch,: [env, :args]]
-  dom:=apply(env, args)
-  makeOldAxiomDispatchDomain dom
-
-makeLazyOldAxiomDispatchDomain domform ==
-  attribute? domform =>
-      [$attributeDispatch, domform, hashString(symbolName domform)]
-  getConstructorKindFromDB opOf domform is "category" =>
-      [$oldAxiomPreCategoryDispatch,: domform]
-  dd := [$lazyOldAxiomDomainDispatch, hashTypeForm(domform,0), domform]
-  append!(dd,dd) -- installs back pointer to head of domain.
-  dd
-
-makeOldAxiomDispatchDomain dom ==
-  cons? dom => dom
-  [$oldAxiomDomainDispatch,hashTypeForm(dom.0,0),:dom]
-
-closeOldAxiomFunctor(name) ==
-   [function runOldAxiomFunctor,:symbolFunction name]
-
-lazyOldAxiomDomainLookupExport(domenv, self, op, sig, box, skipdefaults, env) ==
-  dom := instantiate domenv
-  SPADCALL(rest dom, self, op, sig, box, skipdefaults, first dom.3)
-
-lazyOldAxiomDomainHashCode(domenv, env) == first domenv
-
-lazyOldAxiomDomainDevaluate(domenv, env) ==
-  dom := instantiate domenv
-  SPADCALL(rest dom, first dom.1)
-
-lazyOldAxiomAddChild(domenv, kid, env) ==
-  [$lazyOldAxiomDomainDispatch,:domenv]
-
-$lazyOldAxiomDomainDispatch :=
-   VECTOR('lazyOldAxiomDomain,
-          [function lazyOldAxiomDomainDevaluate],
-          [nil],
-          [function lazyOldAxiomDomainLookupExport],
-          [function lazyOldAxiomDomainHashCode],
-          [function lazyOldAxiomAddChild])
-
--- old Axiom pre category objects are just (dispatch . catform)
--- where catform is ('categoryname,: evaluated args)
--- old Axiom category objects are  (dispatch . [catform, hashcode, defaulting package, parent vector, dom])
-oldAxiomPreCategoryBuild(catform, dom, env) ==
-   pack := oldAxiomCategoryDefaultPackage(catform, dom)
-   [$oldAxiomCategoryDispatch,
-       :[catform, hashTypeForm(catform,0), pack, oldAxiomPreCategoryParents(catform,dom), dom]]
-oldAxiomPreCategoryHashCode(catform, env) == hashTypeForm(catform,0)
-oldAxiomCategoryDefaultPackage(catform, dom) ==
-    hasDefaultPackage opOf catform 
-
-oldAxiomPreCategoryDevaluate([op,:args], env) ==
-   SExprToDName([op,:devaluateList args], true)
-
-$oldAxiomPreCategoryDispatch :=
-   VECTOR('oldAxiomPreCategory,
-          [function oldAxiomPreCategoryDevaluate],
-          [nil],
-          [nil],
-          [function oldAxiomPreCategoryHashCode],
-          [function oldAxiomPreCategoryBuild],
-          [nil])
-
-oldAxiomCategoryDevaluate([[op,:args],:.], env) ==
-   SExprToDName([op,:devaluateList args], true)
-
-oldAxiomPreCategoryParents(catform,dom) ==
-  vars := ["$",:rest getConstructorFormFromDB opOf catform]
-  vals := [dom,:rest catform]
-  -- parents :=  getConstructorParentsFromDB opOf catform
-  parents := parentsOf opOf catform
-  PROGV(vars, vals,
-    vector
-      [eval quoteCatOp cat for [cat,:pred] in parents | eval pred])
-
-quoteCatOp cat == 
-   cat isnt [.,:.] => MKQ cat
-   ['LIST, MKQ first cat,: rest cat]
-
-
-oldAxiomCategoryLookupExport(catenv, self, op, sig, box, env) ==
-   [catform,hash, pack,:.] := catenv
-   opIsHasCat op => if scalarEq?(sig, hash) then [self] else nil
-   null(pack) => nil
-   if not vector? pack then
-       pack:=apply(pack, [self, :rest catform])
-       catenv.rest.rest.first := pack
-   fun := basicLookup(op, sig, pack, self) => [fun]
-   nil
-
-oldAxiomCategoryParentCount([.,.,.,parents,.], env) == # parents
-oldAxiomCategoryNthParent([.,.,.,parvec,dom], n, env) ==
-  catform := parvec.(n-1)
-  VECTORP KAR catform => catform
-  newcat := oldAxiomPreCategoryBuild(catform,dom,nil)
-  parvec.(n-1) := newcat
-  newcat
-
-oldAxiomCategoryBuild([catform,:.], dom, env) ==
-  oldAxiomPreCategoryBuild(catform,dom, env)
-oldAxiomCategoryHashCode([.,hash,:.], env) == hash
-
-$oldAxiomCategoryDispatch :=
-   VECTOR('oldAxiomCategory,
-          [function oldAxiomCategoryDevaluate],
-          [nil],
-          [function oldAxiomCategoryLookupExport],
-          [function oldAxiomCategoryHashCode],
-          [function oldAxiomCategoryBuild], -- builder ??
-          [function oldAxiomCategoryParentCount],
-          [function oldAxiomCategoryNthParent]) -- 1 indexed
-
-attributeDevaluate(attrObj, env) ==
-   [name, hash] := attrObj
-   StringToCompStr symbolName name
-
-attributeLookupExport(attrObj, self, op, sig, box, env) ==
-   [name, hash] := attrObj
-   opIsHasCat op => if scalarEq?(hash, sig) then [self] else nil
-
-attributeHashCode(attrObj, env) ==
-   [name, hash] := attrObj
-   hash
-
-attributeCategoryBuild(attrObj, dom, env) ==
-   [name, hash] := attrObj
-   [$attributeDispatch, name, hash] 
-
-attributeCategoryParentCount(attrObj, env) == 0
-
-attributeNthParent(attrObj, env) == nil
-
-$attributeDispatch :=
-   VECTOR('attribute,
-          [function attributeDevaluate],
-          [nil],
-          [function attributeLookupExport],
-          [function attributeHashCode],
-          [function attributeCategoryBuild], -- builder ??
-          [function attributeCategoryParentCount],
-          [function attributeNthParent]) -- 1 indexed
-
-
---=======================================================================
---             Generate Category Level Alist
---=======================================================================
-orderCatAnc x ==
-  reverse! ASSOCLEFT SORTBY(function rest,rest depthAssoc x)
- 
-depthAssocList u == 
-  u := removeSymbol(u,'DomainSubstitutionMacro)  --hack by RDJ 8/90
-  removeDuplicates ("append"/[depthAssoc(y) for y in u])
- 
-depthAssoc x ==
-  y := tableValue($depthAssocCache,x) => y
-  x is ['Join,:u] or (u := getCatAncestors x) =>
-    v := depthAssocList u
-    tableValue($depthAssocCache,x) := [[x,:n],:v]
-      where n() == 1 + "MAX"/[rest y for y in v]
-  tableValue($depthAssocCache,x) := [[x,:0]]
- 
-getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
- 
-listOfEntries form ==
-  form isnt [.,:.] => form
-  form is [op,:l] =>
-    op is 'Join => "append"/[listOfEntries x for x in l]
-    op is 'CATEGORY => listOfCategoryEntries rest l
-    op is 'PROGN => listOfCategoryEntries l
-    op is 'ATTRIBUTE and first l is [f,:.] and constructor? f => [first l]
-    op in '(ATTRIBUTE SIGNATURE) => nil
-    [form]
-  categoryFormatError()
- 
-listOfCategoryEntries l ==
-  null l => nil
-  l is [[op,:u],:v] =>
-    firstItemList:=
-      op is 'ATTRIBUTE and first u is [f,:.] and constructor? f =>
-        [first u]
-      op in '(ATTRIBUTE SIGNATURE) => nil
-      op is 'IF and u is [pred,conseq,alternate] =>
-          listOfCategoryEntriesIf(pred,conseq,alternate)
-      categoryFormatError()
-    [:firstItemList,:listOfCategoryEntries v]
-  l is ['PROGN,:l] => listOfCategoryEntries l
-  l is '(NIL) => nil
-  sayBrightly '"unexpected category format encountered:"
-  pp l
- 
-listOfCategoryEntriesIf(pred,conseq,alternate) ==
-  alternate in '(%noBranch NIL) =>
-    conseq is ['IF,p,c,a] => listOfCategoryEntriesIf(makePrefixForm([pred,p],'AND),c,a)
-    [fn for x in listOfEntries conseq] where fn() ==
-      x is ['IF,a,b] => ['IF,makePrefixForm([pred,a],'AND),b]
-      ['IF,pred,x]
-  notPred := makePrefixForm(pred,'NOT)
-  conseq is ['IF,p,c,a] =>
-    listOfCategoryEntriesIf(makePrefixForm([notPred,p],'AND),c,a)
-  [gn for x in listOfEntries conseq] where gn() ==
-    x is ['IF,a,b] => ['IF,makePrefixForm([notPred,a],'AND),b]
-    ['IF,notPred,x]
- 
-orderedDefaults(conform,domform) ==
-  $depthAssocCache : local := hashTable 'EQ
-  conList := [x for x in orderCatAnc (op := opOf conform) | hasDefaultPackage op]
-  acc := nil
-  ancestors := ancestorsOf(conform,domform)
-  for x in conList repeat
-    for y in ancestors | x = CAAR y repeat acc := [y,:acc]
-  reverse! acc
-
-instantiate domenv ==
-   -- following is a patch for a bug in runtime.as
-   -- has a lazy dispatch vector with an instantiated domenv
-  VECTORP rest domenv => [$oldAxiomDomainDispatch ,: domenv]
-  callForm := second domenv
-  oldDom := CDDR domenv
-  [functor,:args] := callForm
---  if null(fn := property(functor,'instantiate)) then
---     ofn := symbolFunction functor
---     loadFunctor functor
---     fn := symbolFunction functor
---     symbolFunction(functor) := ofn
---     proprty(functor, 'instantiate) := fn
---  domvec := apply(fn, args)
-  domvec := apply(functor, args)
-  oldDom.first := $oldAxiomDomainDispatch
-  oldDom.rest := [second oldDom,: domvec]
-  oldDom
-
-hashTypeForm([fn,: args], percentHash) == 
-   hashType([fn,:devaluateList args], percentHash)
-
-$hashOp1 == hashString '"1"
-$hashOp0 == hashString '"0"
-$hashOpApply == hashString '"apply"
-$hashOpSet == hashString '"set!"
-$hashSeg == hashString '".."
-$hashPercent == hashString '"%"
-
-oldAxiomDomainLookupExport _
-  (domenv, self, op, sig, box, skipdefaults, env) ==
-     domainVec := rest domenv
-     if hashCode? op then
-         scalarEq?(op, $hashOp1) => op := 'One
-         scalarEq?(op, $hashOp0) => op := 'Zero
-         scalarEq?(op, $hashOpApply) => op := 'elt
-         scalarEq?(op, $hashOpSet) => op := 'setelt
-         scalarEq?(op, $hashSeg) => op := 'SEGMENT
-     constant := nil
-     if hashCode? sig and self and scalarEq?(sig, getDomainHash self) then
-       sig := '($)
-       constant := true
-     val :=
-       skipdefaults => 
-          oldCompLookupNoDefaults(op, sig, domainVec, self)
-       oldCompLookup(op, sig, domainVec, self)
-     null val => val
-     if constant then val := SPADCALL val
-     box.first := val
-     box
-     
-oldAxiomDomainHashCode(domenv, env) == first domenv
-
-oldAxiomDomainHasCategory(domenv, cat, env) ==
-  HasAttribute(domvec := rest domenv, cat) or
-    HasCategory(domvec, devaluate cat)
-
-oldAxiomDomainDevaluate(domenv, env) == 
-   SExprToDName(rest domenv.0, 'T)
-
-oldAxiomAddChild(domenv, child, env) == [$oldAxiomDomainDispatch,:domenv]
-
-$oldAxiomDomainDispatch :=
-   VECTOR('oldAxiomDomain,
-          [function oldAxiomDomainDevaluate],
-          [nil],
-          [function oldAxiomDomainLookupExport],
-          [function oldAxiomDomainHashCode],
-          [function oldAxiomAddChild])
-
-basicLookupCheckDefaults(op,sig,domain,dollar) ==
-  box := [nil]
-  not vector?(dispatch := first dollar) => error "bad domain format"
-  lookupFun := dispatch.3
-  dispatch.0 = 0  =>  -- new compiler domain object
-       hashPercent :=
-          vector? dollar => hashType(dollar.0,0)
-          hashType(dollar,0)
-
-       hashSig :=
-         hashCode? sig => sig
-         hashType( ['Mapping,:sig], hashPercent)
-
-       if symbol? op then op := hashString symbolName op
-       first SPADCALL(rest dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun)
-  first SPADCALL(rest dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun)
-
-$hasCatOpHash == hashString '"%%"
-opIsHasCat op ==
-  hashCode? op => scalarEq?(op, $hasCatOpHash)
-  op = "%%"
-
--- has cat questions lookup up twice if false
--- replace with following ?
---  not(opIsHasCat op) and
---     (u := lookupInDomainVector(op,sig,domvec,domvec)) => u
-
-oldCompLookup(op, sig, domvec, dollar) ==
-  $lookupDefaults: local := false
-  u := lookupInDomainVector(op,sig,domvec,dollar) => u
-  $lookupDefaults := true
-  lookupInDomainVector(op,sig,domvec,dollar)
-
-oldCompLookupNoDefaults(op, sig, domvec, dollar) ==
-  $lookupDefaults: local := false
-  lookupInDomainVector(op,sig,domvec,dollar)
-
-hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
-  opIsHasCat op =>
-      HasCategory(domain, sig)
-  if hashCode? op and scalarEq?(op, $hashOp1) then op := 'One
-  if hashCode? op and scalarEq?(op, $hashOp0) then op := 'Zero
-  hashPercent :=
-    vector? dollar => hashType(dollar.0,0)
-    hashType(dollar,0)
-  if hashCode? sig and scalarEq?(sig, hashPercent) then 
-         sig := hashType('(Mapping $), hashPercent)
-  dollar = nil => systemError()
-  $lookupDefaults =>
-    hashNewLookupInCategories(op,sig,domain,dollar)      --lookup first in my cats
-      or newLookupInAddChain(op,sig,domain,dollar)
-  --fast path when called from newGoGet
-  success := false
-  if $monitorNewWorld then
-    sayLooking(concat('"---->",form2String devaluate domain,
-      '"----> searching op table for:","%l","  "),op,sig,dollar)
-  someMatch := false
-  numvec := getDomainByteVector domain
-  predvec := domainPredicates domain
-  max := maxIndex opvec
-  k := getOpCode(op,opvec,max) or return
-    flag => newLookupInAddChain(op,sig,domain,dollar)
-    nil
-  idxmax := maxIndex numvec
-  start := vectorRef(opvec,k)
-  finish :=
-    max > k => vectorRef(opvec,k + 2)
-    idxmax
-  if finish > idxmax then systemError '"limit too large"
-  numArgs := if hashCode? sig then -1 else (#sig)-1
-  success := nil
-  $isDefaultingPackage: local :=
-    -- use special defaulting handler when dollar non-trivial
-    dollar ~= domain and defaultPackageForm? devaluate domain
-  while finish > start repeat
-    PROGN
-      i := start
-      numTableArgs := arrayRef(numvec,i)
-      predIndex := arrayRef(numvec,i := i + 1)
-      (predIndex ~= 0) and null testBitVector(predvec,predIndex) => nil
-      exportSig :=
-          [newExpandTypeSlot(numvec.(i + j + 1),
-            dollar,domain) for j in 0..numTableArgs]
-      sig ~= hashType(['Mapping,: exportSig],hashPercent) => nil --signifies no match
-      loc := arrayRef(numvec,i + numTableArgs + 2)
-      loc = 1 => (someMatch := true)
-      loc = 0 =>
-        start := start + numTableArgs + 4
-        i := start + 2
-        someMatch := true --mark so that if subsumption fails, look for original
-        subsumptionSig :=
-          [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)
-      cons? slot =>
-        slot.op = '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 = '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 ~= '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)
-  nil
-
-hashNewLookupInCategories(op,sig,dom,dollar) ==
-  slot4 := domainData dom
-  catVec := second slot4
-  # catVec = 0 => nil                      --early exit if no categories
-  integer? KDR catVec.0 =>
-    newLookupInCategories1(op,sig,dom,dollar) --old style
-  $lookupDefaults : local := false
-  if $monitorNewWorld then sayBrightly concat('"----->",
-    form2String devaluate dom,'"-----> searching default packages for ",op)
-  predvec := domainPredicates dom
-  packageVec := first slot4
---the next three lines can go away with new category world
-  varList := ['$,:$FormalMapVariableList]
-  valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]]
-  valueList := [MKQ val for val in valueList]
-  nsig := MSUBST(dom.0,dollar.0,sig)
-  for i in 0..maxIndex packageVec |
-       (entry := packageVec.i) and entry ~= true repeat
-    package :=
-      vector? entry =>
-         if $monitorNewWorld then
-           sayLooking1('"already instantiated cat package",entry)
-         entry
-      ident? entry =>
-        cat := catVec.i
-        packageForm := nil
-        if not property(entry,'LOADED) 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)
-            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]) =>
-              packageForm := [entry,'$,:rest cat]
-              package := evalSlotDomain(packageForm,dom)
-              packageVec.i := package
-              package
-          nil
-        null success =>
-          if $monitorNewWorld then
-            sayBrightlyNT '"  not in: "
-            pp (packageForm and devaluate package or entry)
-          nil
-        if $monitorNewWorld then
-          sayLooking1('"candidate default package instantiated: ",success)
-        success
-      entry
-    null package => nil
-    if $monitorNewWorld then
-      sayLooking1('"Looking at instantiated package ",package)
-    res := basicLookup(op,sig,package,dollar) =>
-      if $monitorNewWorld then
-        sayBrightly '"candidate default package succeeds"
-      return res
-    if $monitorNewWorld then
-      sayBrightly '"candidate fails -- continuing to search categories"
-    nil
-
-HasAttribute(domain,attrib) ==
-  hashPercent :=
-       vector? domain => hashType(domain.0,0)
-       hashType(domain,0)
-  isDomain domain =>
-     integer?((first domain).0) => 
-        -- following call to hashType was missing 2nd arg. 
-        -- getDomainHash domain added on 4/01/94 by RSS
-        basicLookup("%%",hashType(attrib, hashPercent),domain,domain)
-     HasAttribute(CDDR domain, attrib)
-  integer? domainRef(domain,3) => newHasAttribute(domain,attrib)
-  (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
- 
-newHasAttribute(domain,attrib) ==
-  hashPercent :=
-       vector? domain => hashType(domain.0,0)
-       hashType(domain,0)
-  predIndex :=
-     hashCode? attrib =>
-        -- following call to hashType was missing 2nd arg. 
-        -- hashPercent added by PAB 15/4/94
-        or/[x for x in domain.2 | attrib = hashType(first x, hashPercent)]
-     LASSOC(attrib,domain.2)
-  predIndex =>
-    predIndex = 0 => true
-    predvec := domainPredicates domain
-    testBitVector(predvec,predIndex)
-  false
-
-newHasCategory(domain,catform) ==
-  catform = $Type or catform = $Category => true  
-  catform is ["Join",:cats] => 
-    and/[newHasCategory(domain,cat) for cat in cats]
-  slot4 := domain.4
-  auxvec := first slot4
-  catvec := second slot4
-  $isDefaultingPackage: local := defaultPackageForm? devaluate domain
-  #catvec > 0 and integer? KDR catvec.0 =>              --old style
-    predIndex := lazyMatchAssocV1(catform,catvec,domain)
-    null predIndex => false
-    predIndex = 0 => true
-    predvec := domainPredicates domain
-    testBitVector(predvec,predIndex)
-  lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
-
-getCatForm(catvec, index, domain) ==
-   integer?(form := vectorRef(catvec,index)) => domain.form
-   form
-
-HasSignature(domain,[op,sig]) ==
-  compiledLookup(op,sig,domain)
- 
-HasCategory(domain,catform') ==
-  catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
-  catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
-  isDomain domain =>
-     integer?((first domain).0) =>
-        catform' := devaluate catform'
-        basicLookup("%%",catform',domain,domain)
-     HasCategory(CDDR domain, catform')
-  catform:= devaluate catform'
-  integer? domainRef(domain,3) => newHasCategory(domain,catform)
-  domain0 := canonicalForm domain -- handles old style domains, Record, Union etc.
-  slot4 := domainData domain
-  catlist := slot4.1
-  member(catform,catlist) or
-   opOf(catform) in '(Object Type) or  --temporary hack
-    or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
-
-domainEqual(a,b) == 
-  vector? a and vector? b and a.0 = b.0
- 
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 1a881336..eba02971 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -602,6 +602,51 @@ resolveNiladicConstructors form ==
 --=======================================================
 --                   HasCategory/Attribute
 --=======================================================
+domainEqual(a,b) == 
+  vector? a and vector? b and a.0 = b.0
+ 
+HasAttribute(domain,attrib) ==
+  integer? domainRef(domain,3) => newHasAttribute(domain,attrib)
+  (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
+ 
+newHasAttribute(domain,attrib) ==
+  predIndex := LASSOC(attrib,domain.2) =>
+    predIndex = 0 => true
+    predvec := domainPredicates domain
+    testBitVector(predvec,predIndex)
+  false
+
+newHasCategory(domain,catform) ==
+  catform = $Type or catform = $Category => true  
+  catform is ["Join",:cats] => 
+    and/[newHasCategory(domain,cat) for cat in cats]
+  slot4 := domain.4
+  auxvec := first slot4
+  catvec := second slot4
+  $isDefaultingPackage: local := defaultPackageForm? devaluate domain
+  #catvec > 0 and integer? KDR catvec.0 =>              --old style
+    predIndex := lazyMatchAssocV1(catform,catvec,domain)
+    null predIndex => false
+    predIndex = 0 => true
+    predvec := domainPredicates domain
+    testBitVector(predvec,predIndex)
+  lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
+
+HasSignature(domain,[op,sig]) ==
+  compiledLookup(op,sig,domain)
+ 
+HasCategory(domain,catform') ==
+  catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
+  catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
+  catform:= devaluate catform'
+  integer? domainRef(domain,3) => newHasCategory(domain,catform)
+  domain0 := canonicalForm domain -- handles old style domains, Record, Union etc.
+  slot4 := domainData domain
+  catlist := slot4.1
+  member(catform,catlist) or
+   opOf(catform) in '(Object Type) or  --temporary hack
+    or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
+
 -- PLEASE NOTE: This function has the rather charming side-effect that
 -- e.g. it works if domform is an Aldor Category.  This is being used
 -- by extendscategoryForm in c-util to allow Aldor domains to be used
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 1d503bcf..ab1890b5 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -762,24 +762,9 @@ traceReply() ==
     sayBrightly flowSegmentedMsg(displayList,$LINELENGTH,6)
 
 addTraceItem d ==
-  isDomain d => $domains:= [devaluate d,:$domains]
   isDomainOrPackage d => $packages:= [devaluate d,:$packages]
   constructor? d => $constructors:=[d,:$constructors]
 
-_?t() ==
-  null _/TRACENAMES => sayMSG bright '"nothing is traced"
-  for x in _/TRACENAMES | x isnt [.,:.] and not IS__GENVAR x repeat
-    if llm:= get(x,'localModemap,$InteractiveFrame) then
-      x:= ([CADAR llm])
-    sayMSG ['"Function",:bright rassocSub(x,$mapSubNameAlist),'"traced"]
-  for x in _/TRACENAMES | x is [d,:l] and isDomainOrPackage d repeat
-    suffix:=
-      isDomain d => '"domain"
-      '"package"
-    sayBrightly ['"   Functions traced in ",suffix,'"%b",devaluate d,'"%d",":"]
-    for x in orderBySlotNumber l repeat reportSpadTrace("   ",take(4,x))
-    TERPRI()
-
 tracelet(fn,vars) ==
   if GENSYMP fn and stupidIsSpadFunction eval fn then
     fn := eval fn