* interp/nrunopt.boot: Move content to define.boot, interop.boot,

	lisplib.boot, nruncomp.boot, showimp.boot.  Delete.

8 files changed, 891 insertions, 923 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index f18f74f7..c7e8d399 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/nrunopt.boot: Move content to define.boot, interop.boot,
+	lisplib.boot, nruncomp.boot, showimp.boot.  Delete.
+
 2011-03-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/nrungo.boot: Move content to buildom.boot, i-map.boot,
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index a4b5f730..8934bad6 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -105,7 +105,6 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	msgdb.$(FASLEXT)	\
 	newaux.$(FASLEXT)	newfort.$(FASLEXT)	\
 	nrunfast.$(FASLEXT)	\
-	                  	nrunopt.$(FASLEXT)	\
 	osyscmd.$(FASLEXT)	\
 	packtran.$(FASLEXT)	\
 	pf2sex.$(FASLEXT)	\
@@ -348,10 +347,8 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
 wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
 wi1.$(FASLEXT): macros.$(FASLEXT)
 compiler.$(FASLEXT): msgdb.$(FASLEXT) pathname.$(FASLEXT) define.$(FASLEXT) 
-nrunopt.$(FASLEXT): c-util.$(FASLEXT)
 nrunfast.$(FASLEXT): c-util.$(FASLEXT)
-nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) \
-	simpbool.$(FASLEXT) functor.$(FASLEXT)
+nruncomp.$(FASLEXT): profile.$(FASLEXT) simpbool.$(FASLEXT) functor.$(FASLEXT)
 nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
 define.$(FASLEXT): g-error.$(FASLEXT) modemap.$(FASLEXT) \
 	nruncomp.$(FASLEXT) database.$(FASLEXT)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 695a1ac8..66608c6b 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -113,6 +113,281 @@ compDefineAddSignature: (%Form,%Signature,%Env) -> %Env
 DomainSubstitutionFunction: (%List,%Form) -> %Form 
 
 
+--%
+
+--=======================================================================
+--            Generate Code to Create Infovec
+--=======================================================================
+getInfovecCode() == 
+--Function called by compDefineFunctor1 to create infovec at compile time
+  ['LIST,
+    MKQ makeDomainTemplate $template,
+      MKQ makeCompactDirect $NRTslot1Info,
+        MKQ NRTgenFinalAttributeAlist(),
+          NRTmakeCategoryAlist(),
+            MKQ $lookupFunction]
+
+--=======================================================================
+--         Generation of Domain Vector Template (Compile Time)
+--=======================================================================
+makeDomainTemplate vec ==   
+--NOTES: This function is called at compile time to create the template
+--  (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1
+  newVec := newShell # vec
+  for index in 0..MAXINDEX vec repeat
+    item := vec.index
+    null item => nil
+    newVec.index :=
+      atom item => item
+      cons? first item => makeGoGetSlot(item,index)
+      item   
+  $byteVec := "append"/nreverse $byteVec
+  newVec
+ 
+makeGoGetSlot(item,index) ==
+--NOTES: creates byte vec strings for LATCH slots
+--these parts of the $byteVec are created first; see also makeCompactDirect
+  [sig,whereToGo,op,:flag] := item
+  n := #sig - 1
+  newcode := [n,whereToGo,:makeCompactSigCode sig,index]
+  $byteVec := [newcode,:$byteVec]
+  curAddress := $byteAddress
+  $byteAddress := $byteAddress + n + 4
+  [curAddress,:op]
+ 
+--=======================================================================
+--                Generate OpTable at Compile Time
+--=======================================================================
+--> called by getInfovecCode (see top of this file) from compDefineFunctor1
+makeCompactDirect u ==
+  $predListLength :local := # $NRTslot1PredicateList
+  $byteVecAcc: local := nil
+  [nam,[addForm,:opList]] := u
+  --pp opList 
+  d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(op,items)]
+  $byteVec := [:$byteVec,:"append"/nreverse $byteVecAcc]
+  LIST2VEC ("append"/d)
+ 
+makeCompactDirect1(op,items) ==
+--NOTES: creates byte codes for ops implemented by the domain
+    curAddress := $byteAddress
+    $op: local := op  --temp hack by RDJ 8/90 (see orderBySubsumption)
+    newcodes :=
+      "append"/[u for y in orderBySubsumption items | u := fn y] or return nil
+    $byteVecAcc := [newcodes,:$byteVecAcc]
+    curAddress
+ where fn y ==
+  [sig,:r] := y
+  r = ['Subsumed] =>
+    n := #sig - 1
+    $byteAddress := $byteAddress + n + 4
+    [n,0,:makeCompactSigCode sig,0]  --always followed by subsuming signature
+    --identified by a 0 in slot position
+  if r is [n,:s] then
+    slot :=
+      n is [p,:.] => p  --the rest is linenumber of function definition
+      n
+    predCode :=
+      s is [pred,:.] => predicateBitIndex pred
+      0
+  --> drop items which are not present (predCode = -1)
+  predCode = -1 => return nil
+  --> drop items with NIL slots if lookup function is incomplete
+  if null slot then
+     $lookupFunction = 'lookupIncomplete => return nil
+     slot := 1   --signals that operation is not present
+  n := #sig - 1
+  $byteAddress := $byteAddress + n + 4
+  res := [n,predCode,:makeCompactSigCode sig,slot]
+  res
+ 
+orderBySubsumption items ==
+  acc := subacc := nil
+  for x in items repeat
+    not $op in '(Zero One) and x is [.,.,.,'Subsumed] => subacc := [x,:subacc]
+    acc := [x,:acc]
+  y := z := nil
+  for [a,b,:.] in subacc | b repeat   
+  --NOTE: b = nil means that the signature a will appear in acc, that this
+  --  entry is be ignored (e.g. init: -> $ in ULS)
+    while (u := assoc(b,subacc)) repeat b := second u
+    u := assoc(b,acc) or systemError nil
+    if null second u then u := [first u,1] --mark as missing operation
+    y := [[a,'Subsumed],u,:y] --makes subsuming signature follow one subsumed
+    z := insert(b,z)  --mark a signature as already present
+  [:y,:[w for (w := [c,:.]) in acc | not member(c,z)]] --add those not subsuming
+ 
+makeCompactSigCode sig == [fn for x in sig] where 
+  fn() == 
+    x = "$$" => 2
+    x = "$" => 0
+    not integer? x => 
+      systemError ['"code vector slot is ",x,'"; must be number"]
+    x
+  
+--=======================================================================
+--               Generate Slot 4 Constructor Vectors
+--=======================================================================
+NRTmakeCategoryAlist() ==
+  $depthAssocCache: local := hashTable 'EQ
+  $catAncestorAlist: local := NIL
+  pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
+  $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
+  opcAlist := nreverse SORTBY(function NRTcatCompare,pcAlist)
+  newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
+  slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist)
+                   | (k := predicateBitIndex b) ~= -1]
+  slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
+  sixEtc := [5 + i for i in 1..#$pairlis]
+  formals := ASSOCRIGHT $pairlis
+  for x in slot1 repeat
+       x.first := EQSUBSTLIST(["$$",:sixEtc],['$,:formals],first x)
+  -----------code to make a new style slot4 -----------------
+  predList := ASSOCRIGHT slot1  --is list of predicate indices
+  maxPredList := "MAX"/predList
+  catformvec := ASSOCLEFT slot1
+  maxElement := "MAX"/$byteVec
+  ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList],
+    ['CONS, MKQ LIST2VEC slot0,
+      ['CONS, MKQ LIST2VEC [encodeCatform x for x in catformvec],
+        ['makeByteWordVec2,maxElement,MKQ $byteVec]]]]
+  --NOTE: this is new form: old form satisfies vector? CDDR form
+
+encodeCatform x ==
+  k := NRTassocIndex x => k
+  atom x or atom rest x => x
+  [first x,:[encodeCatform y for y in rest x]]
+ 
+NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist)
+ 
+hasDefaultPackage catname ==
+  defname := makeSymbol strconc(catname,'"&")
+  constructor? defname => defname
+  nil
+ 
+ 
+--=======================================================================
+--              Compute the lookup function (complete or incomplete)
+--=======================================================================
+NRTgetLookupFunction(domform,exCategory,addForm) ==
+  domform := SUBLIS($pairlis,domform)
+  addForm := SUBLIS($pairlis,addForm)
+  $why: local := nil
+  atom addForm => 'lookupComplete
+  extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm)
+  if null extends then 
+    [u,msg,:v] := $why
+    SAY '"--------------non extending category----------------------"
+    sayPatternMsg('"%1p of category %2p", [domform,u])
+    if v ~= nil then
+      sayPatternMsg('"%1b %2p",[msg,first v])
+    else
+      sayPatternMsg('"%1b",[msg])
+    SAY '"----------------------------------------------------------"
+  extends => 'lookupIncomplete
+  'lookupComplete
+
+getExportCategory form ==
+  [op,:argl] := form
+  op = 'Record => ['RecordCategory,:argl]
+  op = 'Union => ['UnionCategory,:argl]
+  functorModemap := getConstructorModemapFromDB op
+  [[.,target,:tl],:.] := functorModemap
+  EQSUBSTLIST(argl,$FormalMapVariableList,target)
+ 
+NRTextendsCategory1(domform,exCategory,addForm) ==
+  addForm is ["%Comma",:r] => 
+    and/[extendsCategory(domform,exCategory,x) for x in r]
+  extendsCategory(domform,exCategory,addForm)
+
+--=======================================================================
+--         Compute if a domain constructor is forgetful functor
+--=======================================================================
+extendsCategory(dom,u,v) ==
+  --does category u extend category v (yes iff u contains everything in v)
+  --is dom of category u also of category v?
+  u=v => true
+  v is ["Join",:l] => and/[extendsCategory(dom,u,x) for x in l]
+  v is ["CATEGORY",.,:l] => and/[extendsCategory(dom,u,x) for x in l]
+  v is ["SubsetCategory",cat,d] => extendsCategory(dom,u,cat) and isSubset(dom,d,$e)
+  v := substSlotNumbers(v,$template,$functorForm)
+  extendsCategoryBasic0(dom,u,v) => true
+  $why :=
+    v is ['SIGNATURE,op,sig] => [u,['"  has no ",:formatOpSignature(op,sig)]]
+    [u,'" has no",v]
+  nil
+ 
+extendsCategoryBasic0(dom,u,v) ==
+  v is ['IF,p,['ATTRIBUTE,c],.] =>
+    uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
+    cons? c and isCategoryForm(c,nil) =>
+      slot4 := uVec.4
+      LASSOC(c,second slot4) is [=p,:.]
+    slot2 := uVec.2
+    LASSOC(c,slot2) is [=p,:.]
+  extendsCategoryBasic(dom,u,v)
+ 
+extendsCategoryBasic(dom,u,v) ==
+  u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v) for x in l]
+  u = v => true
+  uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
+  isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec)
+  v is ['SIGNATURE,op,sig] =>
+    or/[uVec.i is [[=op,=sig],:.] for i in 6..MAXINDEX uVec]
+  u is ['CATEGORY,.,:l] =>
+    v is ['IF,:.] => member(v,l)
+    nil
+  nil
+ 
+catExtendsCat?(u,v,uvec) ==
+  u = v => true
+  uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr
+  slot4 := uvec.4
+  prinAncestorList := first slot4
+  member(v,prinAncestorList) => true
+  vOp := KAR v
+  if similarForm := assoc(vOp,prinAncestorList) then
+    PRINT u
+    sayBrightlyNT '"   extends "
+    PRINT similarForm
+    sayBrightlyNT '"   but not "
+    PRINT v
+  or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT second slot4]
+ 
+substSlotNumbers(form,template,domain) ==
+  form is [op,:.] and
+    MEMQ(op,allConstructors()) => expandType(form,template,domain)
+  form is ['SIGNATURE,op,sig] =>
+    ['SIGNATURE,op,[substSlotNumbers(x,template,domain) for x in sig]]
+  form is ['CATEGORY,k,:u] =>
+    ['CATEGORY,k,:[substSlotNumbers(x,template,domain) for x in u]]
+  expandType(form,template,domain)
+ 
+expandType(lazyt,template,domform) ==
+  atom lazyt => expandTypeArgs(lazyt,template,domform)
+  [functorName,:argl] := lazyt
+  functorName in '(Record Union) and first argl is [":",:.] =>
+     [functorName,:[['_:,tag,expandTypeArgs(dom,template,domform)]
+                                 for [.,tag,dom] in argl]]
+  lazyt is ['local,x] =>
+    n := POSN1(x,$FormalMapVariableList)
+    domform.(1 + n)
+  [functorName,:[expandTypeArgs(a,template,domform) for a in argl]]
+ 
+expandTypeArgs(u,template,domform) ==
+  u = '$ => u --template.0      -------eliminate this as $ is rep by 0
+  integer? u => expandType(templateVal(template, domform, u), template,domform)
+  u is ['NRTEVAL,y] => y  --eval  y
+  u is ['QUOTE,y] => y
+  atom u => u
+  expandType(u,template,domform)
+ 
+templateVal(template,domform,index) ==
+--returns a domform or a lazy slot
+  index = 0 => BREAK() --template
+  template.index
+
+
 --% Subdomains
 
 ++ We are defining a functor with head given by `form', as a subdomain
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 0d076bfa..90049e8e 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -261,6 +261,66 @@ $attributeDispatch :=
           [function attributeNthParent]) -- 1 indexed
 
 
+--=======================================================================
+--             Generate Category Level Alist
+--=======================================================================
+orderCatAnc x ==
+  nreverse ASSOCLEFT SORTBY(function rest,rest depthAssoc x)
+ 
+depthAssocList u == 
+  u := delete('DomainSubstitutionMacro,u)  --hack by RDJ 8/90
+  removeDuplicates ("append"/[depthAssoc(y) for y in u])
+ 
+depthAssoc x ==
+  y := HGET($depthAssocCache,x) => y
+  x is ['Join,:u] or (u := getCatAncestors x) =>
+    v := depthAssocList u
+    HPUT($depthAssocCache,x,[[x,:n],:v])
+      where n() == 1 + "MAX"/[rest y for y in v]
+  HPUT($depthAssocCache,x,[[x,:0]])
+ 
+getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
+ 
+listOfEntries form ==
+  atom form => form
+  form is [op,:l] =>
+    op = 'Join => "append"/[listOfEntries x for x in l]
+    op = 'CATEGORY => listOfCategoryEntries rest l
+    op = 'PROGN => listOfCategoryEntries l
+    op = '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 = 'ATTRIBUTE and first u is [f,:.] and constructor? f =>
+        [first u]
+      op in '(ATTRIBUTE SIGNATURE) => nil
+      op = '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]
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 7b9c556a..4d754bbe 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -43,6 +43,160 @@ module lisplib
 ++
 $functionLocations := []
 
+--=======================================================================
+--                Generate Slot 2 Attribute Alist
+--=======================================================================
+NRTgenInitialAttributeAlist attributeList ==
+  --alist has form ((item pred)...) where some items are constructor forms
+  alist := [x for x in attributeList | -- throw out constructors
+    not MEMQ(opOf first x,allConstructors())]
+  $lisplibAttributes := simplifyAttributeAlist
+    [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a ~= 'nothing]
+
+simplifyAttributeAlist al ==
+  al is [[a,:b],:r] =>
+    u := [x for x in r | x is [=a,:b]] 
+    null u => [first al,:simplifyAttributeAlist rest al]
+    pred := simpBool makePrefixForm([b,:ASSOCRIGHT u],'OR)
+    $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
+    s := [x for x in r | x isnt [=a,:b]]
+    [[a,:pred],:simplifyAttributeAlist s]
+  nil
+ 
+NRTgenFinalAttributeAlist() ==
+  [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ~= -1]
+ 
+predicateBitIndex x == 
+  pn(x,false) where
+    pn(x,flag) ==
+      u := simpBool transHasCode x
+      u = 'T  =>  0
+      u = nil => -1
+      p := POSN1(u,$NRTslot1PredicateList) => p + 1
+      not flag => pn(predicateBitIndexRemop x,true)
+      systemError nil
+
+predicateBitIndexRemop p==
+--transform attribute predicates taken out by removeAttributePredicates
+  p is [op,:argl] and op in '(AND and %and OR or %or NOT not %not) => 
+    simpBool makePrefixForm([predicateBitIndexRemop x for x in argl],op)
+  p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
+  p
+ 
+predicateBitRef x ==
+  x = 'T => 'T
+  ['testBitVector,'pv_$,predicateBitIndex x]
+ 
+makePrefixForm(u,op) ==
+  u := MKPF(u,op)
+  u = ''T => 'T
+  u
+
+--=======================================================================
+--               Generate Slot 3 Predicate Vector
+--=======================================================================
+makePredicateBitVector pl ==   --called by buildFunctor
+  if $insideCategoryPackageIfTrue then
+    pl := union(pl,$categoryPredicateList)
+  $predGensymAlist := nil --bound by buildFunctor, used by optHas
+  for p in removeAttributePredicates pl repeat
+    pred := simpBool transHasCode p
+    atom pred => 'skip                --skip over T and NIL
+    if isHasDollarPred pred then 
+      lasts := insert(pred,lasts)
+      for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts)
+    else 
+      firsts := insert(pred,firsts)
+  firstPl := SUBLIS($pairlis,nreverse orderByContainment firsts)
+  lastPl  := SUBLIS($pairlis,nreverse orderByContainment lasts)
+  firstCode:= 
+    ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)]
+  lastCode := augmentPredCode(# firstPl,lastPl)
+  $lisplibPredicates := [:firstPl,:lastPl] --what is stored under 'predicates
+  [$lisplibPredicates,firstCode,:lastCode]  --$pairlis set by compDefineFunctor1
+
+augmentPredCode(n,lastPl) ==
+  ['%list,:pl] := mungeAddGensyms(lastPl,$predGensymAlist)
+  delta := 2 ** n
+  l := [(u := MKPF([x,['augmentPredVector,"$",delta]],'AND); 
+         delta:=2 * delta; u) for x in pl]
+
+augmentPredVector(dollar,value) ==
+  vectorRef(dollar,3) := value + vectorRef(dollar,3)
+
+isHasDollarPred pred ==
+  pred is [op,:r] =>
+    op in '(AND and %and OR or %or NOT not %not) => 
+      or/[isHasDollarPred x for x in r]
+    op in '(HasCategory HasAttribute) => first r = '$
+  false
+
+stripOutNonDollarPreds pred ==
+  pred is [op,:r] and op in '(AND and %and OR or %or NOT not %not) => 
+    "append"/[stripOutNonDollarPreds x for x in r]
+  not isHasDollarPred pred => [pred]
+  nil
+
+removeAttributePredicates pl ==
+  [fn p for p in pl] where
+    fn p ==
+      p is [op,:argl] and op in '(AND and %and OR or %or NOT not %not) => 
+          makePrefixForm(fnl argl,op)
+      p is ["has",'$,['ATTRIBUTE,a]] =>
+        sayBrightlyNT '"Predicate: "
+        PRINT p
+        sayBrightlyNT '"  replaced by: "
+        PRINT LASSOC(a,$NRTattributeAlist)
+      p
+    fnl p == [fn x for x in p]
+ 
+transHasCode x ==
+  atom x => x
+  op := x.op
+  op in '(HasCategory HasAttribute) => x
+  op="has" => compHasFormat x
+  [transHasCode y for y in x]
+ 
+mungeAddGensyms(u,gal) ==
+  ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) ==
+    atom x => x
+    g := LASSOC(x,gal) =>
+      n = 0 => ["%LET",g,x]
+      g
+    [first x,:[fn(y,gal,n + 1) for y in rest x]]
+ 
+orderByContainment pl ==
+  null pl or null rest pl => pl
+  max := first pl
+  for x in rest pl repeat
+    if (y := CONTAINED(max,x)) then
+      if null assoc(max,$predGensymAlist)
+      then $predGensymAlist := [[max,:gensym()],:$predGensymAlist]
+    else if CONTAINED(x,max)
+         then if null assoc(x,$predGensymAlist) then $predGensymAlist := [[x,:gensym()],:$predGensymAlist]
+    if y then max := x
+  [max,:orderByContainment delete(max,pl)]
+ 
+buildBitTable(:l) == fn(reverse l,0) where fn(l,n) ==
+  null l => n
+  n := n + n
+  if first l then n := n + 1
+  fn(rest l,n)
+ 
+buildPredVector(init,n,l) == fn(init,2 ** n,l) where fn(acc,n,l) ==
+  null l => acc
+  if first l then acc := acc + n
+  fn(acc,n + n,rest l)
+
+testBitVector(vec,i) ==
+--bit vector indices are always 1 larger than position in vector
+  i = 0 => true
+  LOGBITP(i - 1,vec)
+ 
+bitsOf n ==
+  n = 0 => 0
+  1 + bitsOf(n quo 2)
+ 
 --% Standard Library Creation Functions
  
 readLib(fn,ft) == readLib1(fn,ft,"*")
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 48e18254..e9709f63 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -32,7 +32,6 @@
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
-import nrunopt
 import simpbool
 import profile
 import functor
@@ -404,6 +403,55 @@ washFunctorBody form == main form where
     x is ['%list] => nil
     x
 
+--=======================================================================
+--              Instantiation Code (Stuffslots)
+--=======================================================================
+stuffSlot(dollar,i,item) ==
+  dollar.i :=
+    atom item => [symbolFunction item,:dollar]
+    item is [n,:op] and integer? n => ['newGoGet,dollar,:item]
+    item is ['CONS,.,['FUNCALL,a,b]] =>
+      b = '$ => ['makeSpadConstant,eval a,dollar,i]
+      sayBrightlyNT '"Unexpected constant environment!!"
+      pp devaluate b
+      nil
+    item
+
+stuffDomainSlots dollar ==
+  domname := devaluate dollar
+  infovec := GETL(opOf domname,'infovec)
+  lookupFunction := getLookupFun infovec
+  lookupFunction :=
+    lookupFunction = 'lookupIncomplete => function lookupIncomplete
+    function lookupComplete
+  template := infovec.0
+  if template.5 then stuffSlot(dollar,5,template.5)
+  for i in (6 + # rest domname)..MAXINDEX template | item := template.i repeat
+    stuffSlot(dollar,i,item)
+  dollar.1 := LIST(lookupFunction,dollar,infovec.1)
+  dollar.2 := infovec.2
+  proto4 := infovec.3
+  dollar.4 := 
+    vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4]   --old style
+    bitVector := dollar.3
+    predvec := first proto4
+    packagevec := second proto4
+    auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn() ==
+      not testBitVector(bitVector,predvec.i) => nil
+      packagevec.i or true
+    [auxvec,:CDDR proto4]
+
+getLookupFun infovec ==
+  MAXINDEX infovec = 4 => infovec.4
+  'lookupIncomplete
+
+makeSpadConstant [fn,dollar,slot] ==
+  val := FUNCALL(fn,dollar)
+  u:= dollar.slot
+  u.first := function IDENTITY
+  u.rest := val
+  val
+
 buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
 --PARAMETERS
 --  $definition: constructor form, e.g. (SquareMatrix 10 (RationalNumber))
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
deleted file mode 100644
index fb525a68..00000000
--- a/src/interp/nrunopt.boot
+++ /dev/null
@@ -1,918 +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
-namespace BOOT
-
---=======================================================================
---            Generate Code to Create Infovec
---=======================================================================
-getInfovecCode() == 
---Function called by compDefineFunctor1 to create infovec at compile time
-  ['LIST,
-    MKQ makeDomainTemplate $template,
-      MKQ makeCompactDirect $NRTslot1Info,
-        MKQ NRTgenFinalAttributeAlist(),
-          NRTmakeCategoryAlist(),
-            MKQ $lookupFunction]
-
---=======================================================================
---         Generation of Domain Vector Template (Compile Time)
---=======================================================================
-makeDomainTemplate vec ==   
---NOTES: This function is called at compile time to create the template
---  (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1
-  newVec := newShell # vec
-  for index in 0..MAXINDEX vec repeat
-    item := vec.index
-    null item => nil
-    newVec.index :=
-      atom item => item
-      cons? first item => makeGoGetSlot(item,index)
-      item   
-  $byteVec := "append"/nreverse $byteVec
-  newVec
- 
-makeGoGetSlot(item,index) ==
---NOTES: creates byte vec strings for LATCH slots
---these parts of the $byteVec are created first; see also makeCompactDirect
-  [sig,whereToGo,op,:flag] := item
-  n := #sig - 1
-  newcode := [n,whereToGo,:makeCompactSigCode sig,index]
-  $byteVec := [newcode,:$byteVec]
-  curAddress := $byteAddress
-  $byteAddress := $byteAddress + n + 4
-  [curAddress,:op]
- 
---=======================================================================
---                Generate OpTable at Compile Time
---=======================================================================
---> called by getInfovecCode (see top of this file) from compDefineFunctor1
-makeCompactDirect u ==
-  $predListLength :local := # $NRTslot1PredicateList
-  $byteVecAcc: local := nil
-  [nam,[addForm,:opList]] := u
-  --pp opList 
-  d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(op,items)]
-  $byteVec := [:$byteVec,:"append"/nreverse $byteVecAcc]
-  LIST2VEC ("append"/d)
- 
-makeCompactDirect1(op,items) ==
---NOTES: creates byte codes for ops implemented by the domain
-    curAddress := $byteAddress
-    $op: local := op  --temp hack by RDJ 8/90 (see orderBySubsumption)
-    newcodes :=
-      "append"/[u for y in orderBySubsumption items | u := fn y] or return nil
-    $byteVecAcc := [newcodes,:$byteVecAcc]
-    curAddress
- where fn y ==
-  [sig,:r] := y
-  r = ['Subsumed] =>
-    n := #sig - 1
-    $byteAddress := $byteAddress + n + 4
-    [n,0,:makeCompactSigCode sig,0]  --always followed by subsuming signature
-    --identified by a 0 in slot position
-  if r is [n,:s] then
-    slot :=
-      n is [p,:.] => p  --the rest is linenumber of function definition
-      n
-    predCode :=
-      s is [pred,:.] => predicateBitIndex pred
-      0
-  --> drop items which are not present (predCode = -1)
-  predCode = -1 => return nil
-  --> drop items with NIL slots if lookup function is incomplete
-  if null slot then
-     $lookupFunction = 'lookupIncomplete => return nil
-     slot := 1   --signals that operation is not present
-  n := #sig - 1
-  $byteAddress := $byteAddress + n + 4
-  res := [n,predCode,:makeCompactSigCode sig,slot]
-  res
- 
-orderBySubsumption items ==
-  acc := subacc := nil
-  for x in items repeat
-    not $op in '(Zero One) and x is [.,.,.,'Subsumed] => subacc := [x,:subacc]
-    acc := [x,:acc]
-  y := z := nil
-  for [a,b,:.] in subacc | b repeat   
-  --NOTE: b = nil means that the signature a will appear in acc, that this
-  --  entry is be ignored (e.g. init: -> $ in ULS)
-    while (u := assoc(b,subacc)) repeat b := second u
-    u := assoc(b,acc) or systemError nil
-    if null second u then u := [first u,1] --mark as missing operation
-    y := [[a,'Subsumed],u,:y] --makes subsuming signature follow one subsumed
-    z := insert(b,z)  --mark a signature as already present
-  [:y,:[w for (w := [c,:.]) in acc | not member(c,z)]] --add those not subsuming
- 
-makeCompactSigCode sig == [fn for x in sig] where 
-  fn() == 
-    x = "$$" => 2
-    x = "$" => 0
-    not integer? x => 
-      systemError ['"code vector slot is ",x,'"; must be number"]
-    x
-  
---=======================================================================
---              Instantiation Code (Stuffslots)
---=======================================================================
-stuffDomainSlots dollar ==
-  domname := devaluate dollar
-  infovec := GETL(opOf domname,'infovec)
-  lookupFunction := getLookupFun infovec
-  lookupFunction :=
-    lookupFunction = 'lookupIncomplete => function lookupIncomplete
-    function lookupComplete
-  template := infovec.0
-  if template.5 then stuffSlot(dollar,5,template.5)
-  for i in (6 + # rest domname)..MAXINDEX template | item := template.i repeat
-    stuffSlot(dollar,i,item)
-  dollar.1 := LIST(lookupFunction,dollar,infovec.1)
-  dollar.2 := infovec.2
-  proto4 := infovec.3
-  dollar.4 := 
-    vector? CDDR proto4 => [COPY_-SEQ first proto4,:rest proto4]   --old style
-    bitVector := dollar.3
-    predvec := first proto4
-    packagevec := second proto4
-    auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn() ==
-      not testBitVector(bitVector,predvec.i) => nil
-      packagevec.i or true
-    [auxvec,:CDDR proto4]
-
-getLookupFun infovec ==
-  MAXINDEX infovec = 4 => infovec.4
-  'lookupIncomplete
-
-makeSpadConstant [fn,dollar,slot] ==
-  val := FUNCALL(fn,dollar)
-  u:= dollar.slot
-  u.first := function IDENTITY
-  u.rest := val
-  val
-
-stuffSlot(dollar,i,item) ==
-  dollar.i :=
-    atom item => [symbolFunction item,:dollar]
-    item is [n,:op] and integer? n => ['newGoGet,dollar,:item]
-    item is ['CONS,.,['FUNCALL,a,b]] =>
-      b = '$ => ['makeSpadConstant,eval a,dollar,i]
-      sayBrightlyNT '"Unexpected constant environment!!"
-      pp devaluate b
-      nil
-    item
-
---=======================================================================
---                Generate Slot 2 Attribute Alist
---=======================================================================
-NRTgenInitialAttributeAlist attributeList ==
-  --alist has form ((item pred)...) where some items are constructor forms
-  alist := [x for x in attributeList | -- throw out constructors
-    not MEMQ(opOf first x,allConstructors())]
-  $lisplibAttributes := simplifyAttributeAlist
-    [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a ~= 'nothing]
-
-simplifyAttributeAlist al ==
-  al is [[a,:b],:r] =>
-    u := [x for x in r | x is [=a,:b]] 
-    null u => [first al,:simplifyAttributeAlist rest al]
-    pred := simpBool makePrefixForm([b,:ASSOCRIGHT u],'OR)
-    $NRTslot1PredicateList := insert(pred,$NRTslot1PredicateList)
-    s := [x for x in r | x isnt [=a,:b]]
-    [[a,:pred],:simplifyAttributeAlist s]
-  nil
- 
-NRTgenFinalAttributeAlist() ==
-  [[a,:k] for [a,:b] in $NRTattributeAlist | (k := predicateBitIndex(b)) ~= -1]
- 
-predicateBitIndex x == 
-  pn(x,false) where
-    pn(x,flag) ==
-      u := simpBool transHasCode x
-      u = 'T  =>  0
-      u = nil => -1
-      p := POSN1(u,$NRTslot1PredicateList) => p + 1
-      not flag => pn(predicateBitIndexRemop x,true)
-      systemError nil
-
-predicateBitIndexRemop p==
---transform attribute predicates taken out by removeAttributePredicates
-  p is [op,:argl] and op in '(AND and %and OR or %or NOT not %not) => 
-    simpBool makePrefixForm([predicateBitIndexRemop x for x in argl],op)
-  p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
-  p
- 
-predicateBitRef x ==
-  x = 'T => 'T
-  ['testBitVector,'pv_$,predicateBitIndex x]
- 
-makePrefixForm(u,op) ==
-  u := MKPF(u,op)
-  u = ''T => 'T
-  u
---=======================================================================
---               Generate Slot 3 Predicate Vector
---=======================================================================
-makePredicateBitVector pl ==   --called by buildFunctor
-  if $insideCategoryPackageIfTrue then
-    pl := union(pl,$categoryPredicateList)
-  $predGensymAlist := nil --bound by buildFunctor, used by optHas
-  for p in removeAttributePredicates pl repeat
-    pred := simpBool transHasCode p
-    atom pred => 'skip                --skip over T and NIL
-    if isHasDollarPred pred then 
-      lasts := insert(pred,lasts)
-      for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts)
-    else 
-      firsts := insert(pred,firsts)
-  firstPl := SUBLIS($pairlis,nreverse orderByContainment firsts)
-  lastPl  := SUBLIS($pairlis,nreverse orderByContainment lasts)
-  firstCode:= 
-    ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)]
-  lastCode := augmentPredCode(# firstPl,lastPl)
-  $lisplibPredicates := [:firstPl,:lastPl] --what is stored under 'predicates
-  [$lisplibPredicates,firstCode,:lastCode]  --$pairlis set by compDefineFunctor1
-
-augmentPredCode(n,lastPl) ==
-  ['%list,:pl] := mungeAddGensyms(lastPl,$predGensymAlist)
-  delta := 2 ** n
-  l := [(u := MKPF([x,['augmentPredVector,"$",delta]],'AND); 
-         delta:=2 * delta; u) for x in pl]
-
-augmentPredVector(dollar,value) ==
-  vectorRef(dollar,3) := value + vectorRef(dollar,3)
-
-isHasDollarPred pred ==
-  pred is [op,:r] =>
-    op in '(AND and %and OR or %or NOT not %not) => 
-      or/[isHasDollarPred x for x in r]
-    op in '(HasCategory HasAttribute) => first r = '$
-  false
-
-stripOutNonDollarPreds pred ==
-  pred is [op,:r] and op in '(AND and %and OR or %or NOT not %not) => 
-    "append"/[stripOutNonDollarPreds x for x in r]
-  not isHasDollarPred pred => [pred]
-  nil
-
-removeAttributePredicates pl ==
-  [fn p for p in pl] where
-    fn p ==
-      p is [op,:argl] and op in '(AND and %and OR or %or NOT not %not) => 
-          makePrefixForm(fnl argl,op)
-      p is ["has",'$,['ATTRIBUTE,a]] =>
-        sayBrightlyNT '"Predicate: "
-        PRINT p
-        sayBrightlyNT '"  replaced by: "
-        PRINT LASSOC(a,$NRTattributeAlist)
-      p
-    fnl p == [fn x for x in p]
- 
-transHasCode x ==
-  atom x => x
-  op := x.op
-  op in '(HasCategory HasAttribute) => x
-  op="has" => compHasFormat x
-  [transHasCode y for y in x]
- 
-mungeAddGensyms(u,gal) ==
-  ['%list,:[fn(x,gal,0) for x in u]] where fn(x,gal,n) ==
-    atom x => x
-    g := LASSOC(x,gal) =>
-      n = 0 => ["%LET",g,x]
-      g
-    [first x,:[fn(y,gal,n + 1) for y in rest x]]
- 
-orderByContainment pl ==
-  null pl or null rest pl => pl
-  max := first pl
-  for x in rest pl repeat
-    if (y := CONTAINED(max,x)) then
-      if null assoc(max,$predGensymAlist)
-      then $predGensymAlist := [[max,:gensym()],:$predGensymAlist]
-    else if CONTAINED(x,max)
-         then if null assoc(x,$predGensymAlist) then $predGensymAlist := [[x,:gensym()],:$predGensymAlist]
-    if y then max := x
-  [max,:orderByContainment delete(max,pl)]
- 
-buildBitTable(:l) == fn(reverse l,0) where fn(l,n) ==
-  null l => n
-  n := n + n
-  if first l then n := n + 1
-  fn(rest l,n)
- 
-buildPredVector(init,n,l) == fn(init,2 ** n,l) where fn(acc,n,l) ==
-  null l => acc
-  if first l then acc := acc + n
-  fn(acc,n + n,rest l)
-
-testBitVector(vec,i) ==
---bit vector indices are always 1 larger than position in vector
-  i = 0 => true
-  LOGBITP(i - 1,vec)
- 
-bitsOf n ==
-  n = 0 => 0
-  1 + bitsOf(n quo 2)
- 
---=======================================================================
---               Generate Slot 4 Constructor Vectors
---=======================================================================
-NRTmakeCategoryAlist() ==
-  $depthAssocCache: local := hashTable 'EQ
-  $catAncestorAlist: local := NIL
-  pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
-  $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
-  opcAlist := nreverse SORTBY(function NRTcatCompare,pcAlist)
-  newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..]
-  slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist)
-                   | (k := predicateBitIndex b) ~= -1]
-  slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1]
-  sixEtc := [5 + i for i in 1..#$pairlis]
-  formals := ASSOCRIGHT $pairlis
-  for x in slot1 repeat
-       x.first := EQSUBSTLIST(["$$",:sixEtc],['$,:formals],first x)
-  -----------code to make a new style slot4 -----------------
-  predList := ASSOCRIGHT slot1  --is list of predicate indices
-  maxPredList := "MAX"/predList
-  catformvec := ASSOCLEFT slot1
-  maxElement := "MAX"/$byteVec
-  ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList],
-    ['CONS, MKQ LIST2VEC slot0,
-      ['CONS, MKQ LIST2VEC [encodeCatform x for x in catformvec],
-        ['makeByteWordVec2,maxElement,MKQ $byteVec]]]]
-  --NOTE: this is new form: old form satisfies vector? CDDR form
-
-encodeCatform x ==
-  k := NRTassocIndex x => k
-  atom x or atom rest x => x
-  [first x,:[encodeCatform y for y in rest x]]
- 
-NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist)
- 
-hasDefaultPackage catname ==
-  defname := makeSymbol strconc(catname,'"&")
-  constructor? defname => defname
-  nil
- 
- 
---=======================================================================
---             Generate Category Level Alist
---=======================================================================
-orderCatAnc x ==
-  nreverse ASSOCLEFT SORTBY(function rest,rest depthAssoc x)
- 
-depthAssocList u == 
-  u := delete('DomainSubstitutionMacro,u)  --hack by RDJ 8/90
-  removeDuplicates ("append"/[depthAssoc(y) for y in u])
- 
-depthAssoc x ==
-  y := HGET($depthAssocCache,x) => y
-  x is ['Join,:u] or (u := getCatAncestors x) =>
-    v := depthAssocList u
-    HPUT($depthAssocCache,x,[[x,:n],:v])
-      where n() == 1 + "MAX"/[rest y for y in v]
-  HPUT($depthAssocCache,x,[[x,:0]])
- 
-getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
- 
-listOfEntries form ==
-  atom form => form
-  form is [op,:l] =>
-    op = 'Join => "append"/[listOfEntries x for x in l]
-    op = 'CATEGORY => listOfCategoryEntries rest l
-    op = 'PROGN => listOfCategoryEntries l
-    op = '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 = 'ATTRIBUTE and first u is [f,:.] and constructor? f =>
-        [first u]
-      op in '(ATTRIBUTE SIGNATURE) => nil
-      op = '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]
- 
---=======================================================================
---                     Display Template
---=======================================================================
-dc(:r) ==
-  con := KAR r
-  options := KDR r
-  ok := MEMQ(con,allConstructors()) or (con := abbreviation? con)
-  null ok =>
-    sayBrightly '"Format is: dc(<constructor name or abbreviation>,option)"
-    sayBrightly 
-      '"options are: all (default), slots, atts, cats, data, ops, optable"
-  option := KAR options
-  option = 'all or null option => dcAll con
-  option = 'slots   =>  dcSlots con
-  option = 'atts    =>  dcAtts  con
-  option = 'cats    =>  dcCats  con
-  option = 'data    =>  dcData  con
-  option = 'ops     =>  dcOps   con
-  option = 'size    =>  dcSize( con,'full)
-  option = 'optable =>  dcOpTable con
-
-dcSlots con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  template := $infovec.0
-  for i in 5..MAXINDEX template repeat
-    sayBrightlyNT bright i
-    item := template.i
-    item is [n,:op] and integer? n => dcOpLatchPrint(op,n)
-    null item and i > 5 => sayBrightly ['"arg  ",strconc('"#",STRINGIMAGE(i - 5))]
-    atom item => sayBrightly ['"fun  ",item]
-    item is ['CONS,.,['FUNCALL,[.,a],b]] => sayBrightly ['"constant ",a]
-    sayBrightly concat('"lazy ",form2String formatSlotDomain i)
- 
-dcOpLatchPrint(op,index) ==
-  numvec := getCodeVector()
-  numOfArgs := numvec.index
-  whereNumber := numvec.(index := index + 1)
-  signumList := dcSig(numvec,index + 1,numOfArgs)
-  index := index + numOfArgs + 1
-  namePart := concat(bright "from",
-    dollarPercentTran form2String formatSlotDomain whereNumber)
-  sayBrightly ['"latch",:formatOpSignature(op,signumList),:namePart]
- 
-getInfovec name ==
-  u := GETL(name,'infovec) => u
-  GETL(name,'LOADED) => nil
-  fullLibName := getConstructorModuleFromDB name or return nil
-  startTimingProcess 'load
-  loadLibNoUpdate(name, name, fullLibName)
-  GETL(name,'infovec)
- 
-getOpSegment index ==
-  numOfArgs := (vec := getCodeVector()).index
-  [vec.i for i in index..(index + numOfArgs + 3)]
-
-getCodeVector() ==
-  proto4 := $infovec.3
-  u := CDDR proto4
-  vector? u => u           --old style
-  rest u                 --new style
-
-formatSlotDomain x ==
-  x = 0 => ["$"]
-  x = 2 => ["$$"]
-  integer? x =>
-    val := $infovec.0.x
-    null val => [strconc('"#",STRINGIMAGE (x  - 5))]
-    formatSlotDomain val
-  atom x => x
-  x is ['NRTEVAL,y] => (atom y => [y]; y)
-  [first x,:[formatSlotDomain y for y in rest x]]
- 
---=======================================================================
---                     Display OpTable
---=======================================================================
-dcOpTable con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  template := $infovec.0
-  $predvec: local := getConstructorPredicatesFromDB con
-  opTable := $infovec.1
-  for i in 0..MAXINDEX opTable repeat
-    op := opTable.i
-    i := i + 1
-    startIndex := opTable.i
-    stopIndex :=
-      i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector()
-      opTable.(i + 2)
-    curIndex := startIndex
-    while curIndex < stopIndex repeat
-      curIndex := dcOpPrint(op,curIndex)
- 
-dcOpPrint(op,index) ==
-  numvec := getCodeVector()
-  segment := getOpSegment index
-  numOfArgs := numvec.index
-  index := index + 1
-  predNumber := numvec.index
-  index := index + 1
-  signumList := dcSig(numvec,index,numOfArgs)
-  index := index + numOfArgs + 1
-  slotNumber := numvec.index
-  suffix :=
-    predNumber = 0 => nil
-    [:bright '"if",:pred2English $predvec.(predNumber - 1)]
-  namePart := bright
-    slotNumber = 0 => '"subsumed by next entry"
-    slotNumber = 1 => '"missing"
-    name := $infovec.0.slotNumber
-    atom name => name
-    name is ["CONS","IDENTITY",
-              ["FUNCALL", ["dispatchFunction", impl],"$"]] => impl
-    '"looked up"
-  sayBrightly [:formatOpSignature(op,signumList),:namePart, :suffix]
-  index + 1
- 
-dcSig(numvec,index,numOfArgs) ==
-  [formatSlotDomain numvec.(index + i) for i in 0..numOfArgs]
- 
-dcPreds con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  $predvec:= getConstructorPredicatesFromDB con
-  for i in 0..MAXINDEX $predvec repeat
-    sayBrightlyNT bright (i + 1)
-    sayBrightly pred2English $predvec.i
- 
-dcAtts con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  $predvec:= getConstructorPredicatesFromDB con
-  attList := $infovec.2
-  for [a,:predNumber] in attList for i in 0.. repeat
-    sayBrightlyNT bright i
-    suffix :=
-      predNumber = 0 => nil
-      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
-    sayBrightly [a,:suffix]
- 
-dcCats con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  u := $infovec.3
-  vector? CDDR u => dcCats1 con    --old style slot4
-  $predvec:= getConstructorPredicatesFromDB con
-  catpredvec := first u
-  catinfo := second u
-  catvec := third u
-  for i in 0..MAXINDEX catvec repeat
-    sayBrightlyNT bright i
-    form := catvec.i
-    predNumber := catpredvec.i
-    suffix :=
-      predNumber = 0 => nil
-      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
-    extra :=
-      null (info := catinfo.i) => nil
-      IDENTP info => bright '"package"
-      bright '"instantiated"
-    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
- 
-dcCats1 con ==
-  $predvec:= getConstructorPredicatesFromDB con
-  u := $infovec.3
-  catvec := second u
-  catinfo := first u
-  for i in 0..MAXINDEX catvec repeat
-    sayBrightlyNT bright i
-    [form,:predNumber] := catvec.i
-    suffix :=
-      predNumber = 0 => nil
-      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
-    extra :=
-      null (info := catinfo.i) => nil
-      IDENTP info => bright '"package"
-      bright '"instantiated"
-    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
- 
-dcData con ==
-  name := abbreviation? con or con
-  $infovec: local := getInfovec name
-  sayBrightly '"Operation data from slot 1"
-  PRINT_-FULL $infovec.1
-  vec := getCodeVector()
-  vec := (cons? vec => rest vec; vec)
-  sayBrightly ['"Information vector has ",# vec,'" entries"]
-  dcData1 vec
-
-dcData1 vec ==
-  n := MAXINDEX vec
-  tens := n quo 10
-  for i in 0..tens repeat
-    start := 10*i
-    sayBrightlyNT rightJustifyString(STRINGIMAGE start,6)
-    sayBrightlyNT '"  |"
-    for j in start..MIN(start + 9,n) repeat
-      sayBrightlyNT rightJustifyString(STRINGIMAGE vec.j,6)
-    sayNewLine()
-  vec
-
-dcSize(:options) ==
-  con := KAR options
-  options := rest options
-  null con => dcSizeAll()
-  quiet := 'quiet in options
-  full := 'full in options
-  name := abbreviation? con or con
-  infovec := getInfovec name
-  template := infovec.0
-  maxindex := MAXINDEX template
-  latch := 0  --# of go get slots
-  lazy  := 0  --# of lazy domain slots
-  fun   := 0  --# of function slots
-  lazyNodes := 0 --# of nodes needed for lazy domain slots
-  for i in 5..maxindex repeat
-    atom (item := template.i) =>   fun := fun + 1
-    integer? first item    => latch := latch + 1
-    'T                 =>  
-       lazy := lazy + 1
-       lazyNodes := lazyNodes + numberOfNodes item
-  tSize := sum(vectorSize(1 + maxindex),nodeSize(lazyNodes + latch))
-  -- functions are free in the template vector
-  oSize := vectorSize(# infovec.1)
-  aSize := numberOfNodes infovec.2
-  slot4 := infovec.3
-  catvec := 
-    vector? CDDR slot4 => second slot4
-    third slot4
-  n := MAXINDEX catvec
-  cSize := sum(nodeSize(2),vectorSize(# first slot4),vectorSize(n + 1),
-               nodeSize(+/[numberOfNodes catvec.i for i in 0..n]))
-  codeVector :=
-    vector? CDDR slot4 => CDDR slot4
-    CDDDR slot4
-  vSize := halfWordSize(# codeVector)
-  itotal := sum(tSize,oSize,aSize,cSize,vSize)
-  if null quiet then sayBrightly ['"infovec total = ",itotal,'" BYTES"]
-  if null quiet then
-    lookupFun := getLookupFun infovec
-    suffix := (lookupFun = 'lookupIncomplete => '"incomplete"; '"complete")
-    sayBrightly ['"template    = ",tSize]
-    sayBrightly ['"operations  = ",oSize,'" (",suffix,'")"]
-    sayBrightly ['"attributes  = ",aSize]
-    sayBrightly ['"categories  = ",cSize]
-    sayBrightly ['"data vector = ",vSize]
-  if null quiet then
-    sayBrightly ['"number of function slots (one extra node) = ",fun]
-    sayBrightly ['"number of latch slots (2 extra nodes) = ",latch]
-    sayBrightly ['"number of lazy slots (no extra nodes) = ",lazy]
-    sayBrightly ['"size of domain vectors = ",1 + maxindex,'" slots"]
-  vtotal := itotal + nodeSize(fun)       --fun   slot is ($ . function)
-  vtotal := vtotal + nodeSize(2 * latch) --latch slot is (newGoGet $ . code)
-  --NOTE: lazy slots require no cost     --lazy  slot is lazyDomainForm
-  if null quiet then sayBrightly ['"domain size = ",vtotal,'" BYTES"] 
-  etotal := nodeSize(fun + 2 * latch) + vectorSize(1 + maxindex)
-  if null quiet then sayBrightly ['"cost per instantiation = ",etotal,'" BYTES"]
-  vtotal
-
-dcSizeAll() ==
-  count := 0
-  total := 0
-  for x in allConstructors() | cons? GETL(x,'infovec) repeat
-    count := count + 1
-    s := dcSize(x,'quiet)
-    sayBrightly [s,'" : ",x]
-    total := total + s
-  sayBrightly '"------------total-------------"
-  sayBrightly [count," constructors; ",total," BYTES"]  
-    
-sum(:l) == +/l
-
-nodeSize(n) == 12 * n
-
-vectorSize(n) == 4 * (1 + n)
-
-halfWordSize(n) == 
-  n < 128 => n quo 2
-  n < 256 => n
-  2 * n
-
-numberOfNodes(x) ==
-  atom x => 0
-  1 + numberOfNodes first x + numberOfNodes rest x
-
-template con ==
-  con := abbreviation? con or con
-  ppTemplate getInfovec(con).0
-
-ppTemplate vec ==
-  for i in 0..MAXINDEX vec repeat
-    sayBrightlyNT bright i
-    pp vec.i
-
-infovec con == 
-  con := abbreviation? con or con
-  u := getInfovec con
-  sayBrightly '"---------------slot 0 is template-------------------"
-  ppTemplate u.0
-  sayBrightly '"---------------slot 1 is op table-------------------"
-  PRINT_-FULL u.1
-  sayBrightly '"---------------slot 2 is attribute list-------------"
-  PRINT_-FULL u.2
-  sayBrightly '"---------------slot 3.0 is catpredvec---------------"
-  PRINT_-FULL u.3.0
-  sayBrightly '"---------------slot 3.1 is catinfovec---------------"
-  PRINT_-FULL u.3.1
-  sayBrightly '"---------------slot 3.2 is catvec-------------------"
-  PRINT_-FULL u.3.2
-  sayBrightly '"---------------tail of slot 3 is datavector---------"
-  dcData1 CDDDR u.3
-  'done
-
-dcAll con ==
-  con := abbreviation? con or con
-  $infovec : local := getInfovec con
-  complete? := 
-    #$infovec = 4 => false
-    $infovec.4 = 'lookupComplete
-  sayBrightly '"----------------Template-----------------"
-  dcSlots con
-  sayBrightly
-    complete? => '"----------Complete Ops----------------"
-    '"----------Incomplete Ops---------------"
-  dcOpTable con
-  sayBrightly '"----------------Atts-----------------"
-  dcAtts con
-  sayBrightly '"----------------Preds-----------------"
-  dcPreds con
-  sayBrightly '"----------------Cats-----------------"
-  dcCats con
-  sayBrightly '"----------------Data------------------"
-  dcData con
-  sayBrightly '"----------------Size------------------"
-  dcSize(con,'full)
-  'done
-
-dcOps conname ==
-  for [op,:u] in reverse getConstructorOperationsFromDB conname repeat
-    for [sig,slot,pred,key,:.] in u repeat
-      suffix := 
-        atom pred => nil
-        concat('" if ",pred2English pred)
-      key = 'Subsumed =>
-        sayBrightly [:formatOpSignature(op,sig),'" subsumed by ",:formatOpSignature(op,slot),:suffix]
-      sayBrightly [:formatOpSignature(op,sig),:suffix]
-  
---=======================================================================
---              Compute the lookup function (complete or incomplete)
---=======================================================================
-NRTgetLookupFunction(domform,exCategory,addForm) ==
-  domform := SUBLIS($pairlis,domform)
-  addForm := SUBLIS($pairlis,addForm)
-  $why: local := nil
-  atom addForm => 'lookupComplete
-  extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm)
-  if null extends then 
-    [u,msg,:v] := $why
-    SAY '"--------------non extending category----------------------"
-    sayPatternMsg('"%1p of category %2p", [domform,u])
-    if v ~= nil then
-      sayPatternMsg('"%1b %2p",[msg,first v])
-    else
-      sayPatternMsg('"%1b",[msg])
-    SAY '"----------------------------------------------------------"
-  extends => 'lookupIncomplete
-  'lookupComplete
-
-getExportCategory form ==
-  [op,:argl] := form
-  op = 'Record => ['RecordCategory,:argl]
-  op = 'Union => ['UnionCategory,:argl]
-  functorModemap := getConstructorModemapFromDB op
-  [[.,target,:tl],:.] := functorModemap
-  EQSUBSTLIST(argl,$FormalMapVariableList,target)
- 
-NRTextendsCategory1(domform,exCategory,addForm) ==
-  addForm is ["%Comma",:r] => 
-    and/[extendsCategory(domform,exCategory,x) for x in r]
-  extendsCategory(domform,exCategory,addForm)
-
---=======================================================================
---         Compute if a domain constructor is forgetful functor
---=======================================================================
-extendsCategory(dom,u,v) ==
-  --does category u extend category v (yes iff u contains everything in v)
-  --is dom of category u also of category v?
-  u=v => true
-  v is ["Join",:l] => and/[extendsCategory(dom,u,x) for x in l]
-  v is ["CATEGORY",.,:l] => and/[extendsCategory(dom,u,x) for x in l]
-  v is ["SubsetCategory",cat,d] => extendsCategory(dom,u,cat) and isSubset(dom,d,$e)
-  v := substSlotNumbers(v,$template,$functorForm)
-  extendsCategoryBasic0(dom,u,v) => true
-  $why :=
-    v is ['SIGNATURE,op,sig] => [u,['"  has no ",:formatOpSignature(op,sig)]]
-    [u,'" has no",v]
-  nil
- 
-extendsCategoryBasic0(dom,u,v) ==
-  v is ['IF,p,['ATTRIBUTE,c],.] =>
-    uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
-    cons? c and isCategoryForm(c,nil) =>
-      slot4 := uVec.4
-      LASSOC(c,second slot4) is [=p,:.]
-    slot2 := uVec.2
-    LASSOC(c,slot2) is [=p,:.]
-  extendsCategoryBasic(dom,u,v)
- 
-extendsCategoryBasic(dom,u,v) ==
-  u is ["Join",:l] => or/[extendsCategoryBasic(dom,x,v) for x in l]
-  u = v => true
-  uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr
-  isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec)
-  v is ['SIGNATURE,op,sig] =>
-    or/[uVec.i is [[=op,=sig],:.] for i in 6..MAXINDEX uVec]
-  u is ['CATEGORY,.,:l] =>
-    v is ['IF,:.] => member(v,l)
-    nil
-  nil
- 
-catExtendsCat?(u,v,uvec) ==
-  u = v => true
-  uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr
-  slot4 := uvec.4
-  prinAncestorList := first slot4
-  member(v,prinAncestorList) => true
-  vOp := KAR v
-  if similarForm := assoc(vOp,prinAncestorList) then
-    PRINT u
-    sayBrightlyNT '"   extends "
-    PRINT similarForm
-    sayBrightlyNT '"   but not "
-    PRINT v
-  or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT second slot4]
- 
-substSlotNumbers(form,template,domain) ==
-  form is [op,:.] and
-    MEMQ(op,allConstructors()) => expandType(form,template,domain)
-  form is ['SIGNATURE,op,sig] =>
-    ['SIGNATURE,op,[substSlotNumbers(x,template,domain) for x in sig]]
-  form is ['CATEGORY,k,:u] =>
-    ['CATEGORY,k,:[substSlotNumbers(x,template,domain) for x in u]]
-  expandType(form,template,domain)
- 
-expandType(lazyt,template,domform) ==
-  atom lazyt => expandTypeArgs(lazyt,template,domform)
-  [functorName,:argl] := lazyt
-  functorName in '(Record Union) and first argl is [":",:.] =>
-     [functorName,:[['_:,tag,expandTypeArgs(dom,template,domform)]
-                                 for [.,tag,dom] in argl]]
-  lazyt is ['local,x] =>
-    n := POSN1(x,$FormalMapVariableList)
-    domform.(1 + n)
-  [functorName,:[expandTypeArgs(a,template,domform) for a in argl]]
- 
-expandTypeArgs(u,template,domform) ==
-  u = '$ => u --template.0      -------eliminate this as $ is rep by 0
-  integer? u => expandType(templateVal(template, domform, u), template,domform)
-  u is ['NRTEVAL,y] => y  --eval  y
-  u is ['QUOTE,y] => y
-  atom u => u
-  expandType(u,template,domform)
- 
-templateVal(template,domform,index) ==
---returns a domform or a lazy slot
-  index = 0 => BREAK() --template
-  template.index
-
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index b608d024..47260bb3 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -254,3 +254,350 @@ formatLazyDomainForm(dom,x) ==
  
 
 
+--=======================================================================
+--                     Display Template
+--=======================================================================
+dc(:r) ==
+  con := KAR r
+  options := KDR r
+  ok := MEMQ(con,allConstructors()) or (con := abbreviation? con)
+  null ok =>
+    sayBrightly '"Format is: dc(<constructor name or abbreviation>,option)"
+    sayBrightly 
+      '"options are: all (default), slots, atts, cats, data, ops, optable"
+  option := KAR options
+  option = 'all or null option => dcAll con
+  option = 'slots   =>  dcSlots con
+  option = 'atts    =>  dcAtts  con
+  option = 'cats    =>  dcCats  con
+  option = 'data    =>  dcData  con
+  option = 'ops     =>  dcOps   con
+  option = 'size    =>  dcSize( con,'full)
+  option = 'optable =>  dcOpTable con
+
+dcSlots con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  template := $infovec.0
+  for i in 5..MAXINDEX template repeat
+    sayBrightlyNT bright i
+    item := template.i
+    item is [n,:op] and integer? n => dcOpLatchPrint(op,n)
+    null item and i > 5 => sayBrightly ['"arg  ",strconc('"#",STRINGIMAGE(i - 5))]
+    atom item => sayBrightly ['"fun  ",item]
+    item is ['CONS,.,['FUNCALL,[.,a],b]] => sayBrightly ['"constant ",a]
+    sayBrightly concat('"lazy ",form2String formatSlotDomain i)
+ 
+dcOpLatchPrint(op,index) ==
+  numvec := getCodeVector()
+  numOfArgs := numvec.index
+  whereNumber := numvec.(index := index + 1)
+  signumList := dcSig(numvec,index + 1,numOfArgs)
+  index := index + numOfArgs + 1
+  namePart := concat(bright "from",
+    dollarPercentTran form2String formatSlotDomain whereNumber)
+  sayBrightly ['"latch",:formatOpSignature(op,signumList),:namePart]
+ 
+getInfovec name ==
+  u := GETL(name,'infovec) => u
+  GETL(name,'LOADED) => nil
+  fullLibName := getConstructorModuleFromDB name or return nil
+  startTimingProcess 'load
+  loadLibNoUpdate(name, name, fullLibName)
+  GETL(name,'infovec)
+ 
+getOpSegment index ==
+  numOfArgs := (vec := getCodeVector()).index
+  [vec.i for i in index..(index + numOfArgs + 3)]
+
+getCodeVector() ==
+  proto4 := $infovec.3
+  u := CDDR proto4
+  vector? u => u           --old style
+  rest u                 --new style
+
+formatSlotDomain x ==
+  x = 0 => ["$"]
+  x = 2 => ["$$"]
+  integer? x =>
+    val := $infovec.0.x
+    null val => [strconc('"#",STRINGIMAGE (x  - 5))]
+    formatSlotDomain val
+  atom x => x
+  x is ['NRTEVAL,y] => (atom y => [y]; y)
+  [first x,:[formatSlotDomain y for y in rest x]]
+ 
+--=======================================================================
+--                     Display OpTable
+--=======================================================================
+dcOpTable con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  template := $infovec.0
+  $predvec: local := getConstructorPredicatesFromDB con
+  opTable := $infovec.1
+  for i in 0..MAXINDEX opTable repeat
+    op := opTable.i
+    i := i + 1
+    startIndex := opTable.i
+    stopIndex :=
+      i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector()
+      opTable.(i + 2)
+    curIndex := startIndex
+    while curIndex < stopIndex repeat
+      curIndex := dcOpPrint(op,curIndex)
+ 
+dcOpPrint(op,index) ==
+  numvec := getCodeVector()
+  segment := getOpSegment index
+  numOfArgs := numvec.index
+  index := index + 1
+  predNumber := numvec.index
+  index := index + 1
+  signumList := dcSig(numvec,index,numOfArgs)
+  index := index + numOfArgs + 1
+  slotNumber := numvec.index
+  suffix :=
+    predNumber = 0 => nil
+    [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+  namePart := bright
+    slotNumber = 0 => '"subsumed by next entry"
+    slotNumber = 1 => '"missing"
+    name := $infovec.0.slotNumber
+    atom name => name
+    name is ["CONS","IDENTITY",
+              ["FUNCALL", ["dispatchFunction", impl],"$"]] => impl
+    '"looked up"
+  sayBrightly [:formatOpSignature(op,signumList),:namePart, :suffix]
+  index + 1
+ 
+dcSig(numvec,index,numOfArgs) ==
+  [formatSlotDomain numvec.(index + i) for i in 0..numOfArgs]
+ 
+dcPreds con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  $predvec:= getConstructorPredicatesFromDB con
+  for i in 0..MAXINDEX $predvec repeat
+    sayBrightlyNT bright (i + 1)
+    sayBrightly pred2English $predvec.i
+ 
+dcAtts con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  $predvec:= getConstructorPredicatesFromDB con
+  attList := $infovec.2
+  for [a,:predNumber] in attList for i in 0.. repeat
+    sayBrightlyNT bright i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    sayBrightly [a,:suffix]
+ 
+dcCats con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  u := $infovec.3
+  vector? CDDR u => dcCats1 con    --old style slot4
+  $predvec:= getConstructorPredicatesFromDB con
+  catpredvec := first u
+  catinfo := second u
+  catvec := third u
+  for i in 0..MAXINDEX catvec repeat
+    sayBrightlyNT bright i
+    form := catvec.i
+    predNumber := catpredvec.i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    extra :=
+      null (info := catinfo.i) => nil
+      IDENTP info => bright '"package"
+      bright '"instantiated"
+    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
+ 
+dcCats1 con ==
+  $predvec:= getConstructorPredicatesFromDB con
+  u := $infovec.3
+  catvec := second u
+  catinfo := first u
+  for i in 0..MAXINDEX catvec repeat
+    sayBrightlyNT bright i
+    [form,:predNumber] := catvec.i
+    suffix :=
+      predNumber = 0 => nil
+      [:bright '"if",:pred2English $predvec.(predNumber - 1)]
+    extra :=
+      null (info := catinfo.i) => nil
+      IDENTP info => bright '"package"
+      bright '"instantiated"
+    sayBrightly concat(form2String formatSlotDomain form,suffix,extra)
+ 
+dcData con ==
+  name := abbreviation? con or con
+  $infovec: local := getInfovec name
+  sayBrightly '"Operation data from slot 1"
+  PRINT_-FULL $infovec.1
+  vec := getCodeVector()
+  vec := (cons? vec => rest vec; vec)
+  sayBrightly ['"Information vector has ",# vec,'" entries"]
+  dcData1 vec
+
+dcData1 vec ==
+  n := MAXINDEX vec
+  tens := n quo 10
+  for i in 0..tens repeat
+    start := 10*i
+    sayBrightlyNT rightJustifyString(STRINGIMAGE start,6)
+    sayBrightlyNT '"  |"
+    for j in start..MIN(start + 9,n) repeat
+      sayBrightlyNT rightJustifyString(STRINGIMAGE vec.j,6)
+    sayNewLine()
+  vec
+
+dcSize(:options) ==
+  con := KAR options
+  options := rest options
+  null con => dcSizeAll()
+  quiet := 'quiet in options
+  full := 'full in options
+  name := abbreviation? con or con
+  infovec := getInfovec name
+  template := infovec.0
+  maxindex := MAXINDEX template
+  latch := 0  --# of go get slots
+  lazy  := 0  --# of lazy domain slots
+  fun   := 0  --# of function slots
+  lazyNodes := 0 --# of nodes needed for lazy domain slots
+  for i in 5..maxindex repeat
+    atom (item := template.i) =>   fun := fun + 1
+    integer? first item    => latch := latch + 1
+    'T                 =>  
+       lazy := lazy + 1
+       lazyNodes := lazyNodes + numberOfNodes item
+  tSize := sum(vectorSize(1 + maxindex),nodeSize(lazyNodes + latch))
+  -- functions are free in the template vector
+  oSize := vectorSize(# infovec.1)
+  aSize := numberOfNodes infovec.2
+  slot4 := infovec.3
+  catvec := 
+    vector? CDDR slot4 => second slot4
+    third slot4
+  n := MAXINDEX catvec
+  cSize := sum(nodeSize(2),vectorSize(# first slot4),vectorSize(n + 1),
+               nodeSize(+/[numberOfNodes catvec.i for i in 0..n]))
+  codeVector :=
+    vector? CDDR slot4 => CDDR slot4
+    CDDDR slot4
+  vSize := halfWordSize(# codeVector)
+  itotal := sum(tSize,oSize,aSize,cSize,vSize)
+  if null quiet then sayBrightly ['"infovec total = ",itotal,'" BYTES"]
+  if null quiet then
+    lookupFun := getLookupFun infovec
+    suffix := (lookupFun = 'lookupIncomplete => '"incomplete"; '"complete")
+    sayBrightly ['"template    = ",tSize]
+    sayBrightly ['"operations  = ",oSize,'" (",suffix,'")"]
+    sayBrightly ['"attributes  = ",aSize]
+    sayBrightly ['"categories  = ",cSize]
+    sayBrightly ['"data vector = ",vSize]
+  if null quiet then
+    sayBrightly ['"number of function slots (one extra node) = ",fun]
+    sayBrightly ['"number of latch slots (2 extra nodes) = ",latch]
+    sayBrightly ['"number of lazy slots (no extra nodes) = ",lazy]
+    sayBrightly ['"size of domain vectors = ",1 + maxindex,'" slots"]
+  vtotal := itotal + nodeSize(fun)       --fun   slot is ($ . function)
+  vtotal := vtotal + nodeSize(2 * latch) --latch slot is (newGoGet $ . code)
+  --NOTE: lazy slots require no cost     --lazy  slot is lazyDomainForm
+  if null quiet then sayBrightly ['"domain size = ",vtotal,'" BYTES"] 
+  etotal := nodeSize(fun + 2 * latch) + vectorSize(1 + maxindex)
+  if null quiet then sayBrightly ['"cost per instantiation = ",etotal,'" BYTES"]
+  vtotal
+
+dcSizeAll() ==
+  count := 0
+  total := 0
+  for x in allConstructors() | cons? GETL(x,'infovec) repeat
+    count := count + 1
+    s := dcSize(x,'quiet)
+    sayBrightly [s,'" : ",x]
+    total := total + s
+  sayBrightly '"------------total-------------"
+  sayBrightly [count," constructors; ",total," BYTES"]  
+    
+sum(:l) == +/l
+
+nodeSize(n) == 12 * n
+
+vectorSize(n) == 4 * (1 + n)
+
+halfWordSize(n) == 
+  n < 128 => n quo 2
+  n < 256 => n
+  2 * n
+
+numberOfNodes(x) ==
+  atom x => 0
+  1 + numberOfNodes first x + numberOfNodes rest x
+
+template con ==
+  con := abbreviation? con or con
+  ppTemplate getInfovec(con).0
+
+ppTemplate vec ==
+  for i in 0..MAXINDEX vec repeat
+    sayBrightlyNT bright i
+    pp vec.i
+
+infovec con == 
+  con := abbreviation? con or con
+  u := getInfovec con
+  sayBrightly '"---------------slot 0 is template-------------------"
+  ppTemplate u.0
+  sayBrightly '"---------------slot 1 is op table-------------------"
+  PRINT_-FULL u.1
+  sayBrightly '"---------------slot 2 is attribute list-------------"
+  PRINT_-FULL u.2
+  sayBrightly '"---------------slot 3.0 is catpredvec---------------"
+  PRINT_-FULL u.3.0
+  sayBrightly '"---------------slot 3.1 is catinfovec---------------"
+  PRINT_-FULL u.3.1
+  sayBrightly '"---------------slot 3.2 is catvec-------------------"
+  PRINT_-FULL u.3.2
+  sayBrightly '"---------------tail of slot 3 is datavector---------"
+  dcData1 CDDDR u.3
+  'done
+
+dcAll con ==
+  con := abbreviation? con or con
+  $infovec : local := getInfovec con
+  complete? := 
+    #$infovec = 4 => false
+    $infovec.4 = 'lookupComplete
+  sayBrightly '"----------------Template-----------------"
+  dcSlots con
+  sayBrightly
+    complete? => '"----------Complete Ops----------------"
+    '"----------Incomplete Ops---------------"
+  dcOpTable con
+  sayBrightly '"----------------Atts-----------------"
+  dcAtts con
+  sayBrightly '"----------------Preds-----------------"
+  dcPreds con
+  sayBrightly '"----------------Cats-----------------"
+  dcCats con
+  sayBrightly '"----------------Data------------------"
+  dcData con
+  sayBrightly '"----------------Size------------------"
+  dcSize(con,'full)
+  'done
+
+dcOps conname ==
+  for [op,:u] in reverse getConstructorOperationsFromDB conname repeat
+    for [sig,slot,pred,key,:.] in u repeat
+      suffix := 
+        atom pred => nil
+        concat('" if ",pred2English pred)
+      key = 'Subsumed =>
+        sayBrightly [:formatOpSignature(op,sig),'" subsumed by ",:formatOpSignature(op,slot),:suffix]
+      sayBrightly [:formatOpSignature(op,sig),:suffix]
+