Remove $AncestorsTable. Adjust users.

4 files changed, 29 insertions, 43 deletions

diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 89bdc430..b45b0dd1 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -55,10 +55,9 @@ displayCategoryTable(:options) ==
     sayMSG [:bright id,'"extends:"]
     PRINT val
 
-genCategoryTable() ==
-  $AncestorsTable := makeTable function symbolEq?
+generateCategoryTable ancestors ==
   $HasCategoryTable := makeTable function EQUAL
-  genTempCategoryTable()
+  generateAncestorCategoryTable ancestors
   domainTable :=
     [addDomainToTable(con,getConstrCat getConstructorCategory con)
       for con in allConstructors() | not builtinFunctorName? con
@@ -70,22 +69,21 @@ genCategoryTable() ==
   for [id,:entry] in domainTable repeat
     for [a,:b] in encodeCategoryAlist(id,entry) repeat
       tableValue($HasCategoryTable,[id,:a]) := b
-  simpTempCategoryTable()
+  simplifyAncestorCategoryTable ancestors
   simpCategoryTable()
 
-simpTempCategoryTable() ==
-  for [id,:.] in entries $AncestorsTable repeat
+simplifyAncestorCategoryTable ancestors ==
+  for [id,:.] in entries ancestors repeat
     for u in getConstructorAncestorsFromDB id repeat
       u.rest := simpHasPred rest u
 
-simpCategoryTable() == main where
-  main() ==
-    for [key,:entry] in entries $HasCategoryTable repeat
-      null entry => tableRemove!($HasCategoryTable,key)
-      change :=
-        opOf entry isnt [.,:.] => simpHasPred entry
-        [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred]
-      tableValue($HasCategoryTable,key) := change
+simpCategoryTable() ==
+  for [key,:entry] in entries $HasCategoryTable repeat
+    null entry => tableRemove!($HasCategoryTable,key)
+    change :=
+      opOf entry isnt [.,:.] => simpHasPred entry
+      [[x,:npred] for [x,:pred] in entry | npred := simpHasPred pred]
+    tableValue($HasCategoryTable,key) := change
 
 simpHasPred(pred,:options) == main where
   main() ==
@@ -186,24 +184,24 @@ addDomainToTable(id,catl) ==
 domainHput(table,key:=[id,:a],b) ==
   tableValue(table,key) := b
 
-genTempCategoryTable() ==
+generateAncestorCategoryTable ancestors ==
   --generates hashtable with key=categoryName and value of the form
   --     ((form . pred) ..) meaning that
   --           "IF pred THEN ofCategory(key,form)"
   --  where form can involve #1, #2, ... the parameters of key
   for con in allConstructors()  repeat
     getConstructorKindFromDB con is "category" =>
-      addToCategoryTable con
-  for [id,:item] in entries $AncestorsTable repeat
+      addToCategoryTable(ancestors,con)
+  for [id,:item] in entries ancestors repeat
     for u in item repeat
       u.rest := simpCatPredicate simpBool rest u
-    tableValue($AncestorsTable,id) := listSort(function GLESSEQP,item)
+    tableValue(ancestors,id) := listSort(function GLESSEQP,item)
 
-addToCategoryTable con ==
+addToCategoryTable(ancestors,con) ==
   -- adds an entry to $tempCategoryTable with key=con and alist entries
   u := getConstructorModemap(con).mmDC --domain
   alist := getCategoryExtensionAlist u
-  tableValue($AncestorsTable,first u) := alist
+  tableValue(ancestors,first u) := alist
   alist
 
 encodeCategoryAlist(id,alist) ==
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 3c0ab977..213ffdf4 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -87,13 +87,8 @@
 
 
 ;;TTT 7/2/97
-; Regarding the 'ancestors field for a category: At database build
-; time there exists a $AncestorsTable hash table that gets filled
-; with CATEGORY (not domain) ancestor information. This later provides
-; the information that goes into interp.daase This $AncestorsTable
-; does not exist at normal runtime (it can be made by a call to
-; genCategoryTable). Note that the ancestor information in
-; $AncestorsTable (and hence interp.daase) involves #1, #2, etc
+; Regarding the 'ancestors field for a category: Note that the ancestor
+; information in interp.daase involves #1, #2, etc
 ; instead of R, Coef, etc. The latter thingies appear in all
 ; .NRLIB/index.KAF files. So we need to be careful when we )lib
 ; categories and update the ancestor info.
@@ -969,7 +964,8 @@
   (final-name (root) 
 	      (concat root ".daase"))
   )
- (let (d)
+ (let ((ancestors-table (make-hash-table :test #'eq))
+       d)
   (declare (special |$constructorList|))
   (do-symbols (symbol)
    (when (|constructorDB| symbol)
@@ -1000,10 +996,7 @@
   (|buildGloss|)
   (write-browsedb)
   (write-operationdb)
- ; note: genCategoryTable creates a new $HasCategoryTable table
- ; this smashes the existing table and regenerates it.
- ; write-categorydb does getdatabase calls to write the new information
-  (write-categorydb)
+  (write-categorydb ancestors-table)
   (dolist (con (|allConstructors|))
    (let (dbstruct)
      (when (setq dbstruct (|constructorDB| con))
@@ -1016,9 +1009,7 @@
                  (when (= (length d) (length (|dbConstructorForm| dbstruct)))
                        (format t "   ~a has a default domain of ~a~%" con (car d))
                        (setf (|dbDefaultDomain| dbstruct) (car d)))))))
-                                        ; note: genCategoryTable creates $AncestorsTable. write-interpdb
-                                        ; does gethash calls into it rather than doing a getdatabase call.
-  (write-interpdb)
+  (write-interpdb ancestors-table)
 #+:AKCL  (write-warmdata)
   (when (probe-file (final-name "interp"))
         (delete-file (final-name "interp")))
@@ -1035,9 +1026,8 @@
   (rename-file "category.build" 
                (final-name "category")))))
 
-(defun write-interpdb ()
+(defun write-interpdb (ancestors-table)
  "build interp.daase from hash tables"
- (declare (special |$AncestorsTable|))
  (let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
         concategory categorypos kind cosig abbrev defaultdomain
         ancestors ancestorspos superpos out)
@@ -1076,7 +1066,7 @@
     (setq cosig (|dbDualSignature| struct))
     (setq kind (|dbConstructorKind| struct))
     (setq defaultdomain (|dbDefaultDomain| struct))
-    (setq ancestors (gethash constructor |$AncestorsTable|)) ;cattable.boot
+    (setq ancestors (gethash constructor ancestors-table))
     (if ancestors
 	(progn
 	  (setq ancestorspos (file-position out))
@@ -1136,11 +1126,11 @@
   (finish-output out)
   (close out)))
 
-(defun write-categorydb ()
+(defun write-categorydb (ancestors-table)
  "make category.daase from scratch. contains the $HasCategoryTable table"
  (let (out master pos *print-pretty*)
   (print "building category.daase")
-  (|genCategoryTable|)
+  (|generateCategoryTable| ancestors-table)
   (setq out (open "category.build" :direction :output))
   (princ "                              " out)
   (finish-output out)
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 7f0d11b3..7f01fdb3 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -302,7 +302,7 @@ buildDatabase(filemode,expensive) ==
   SAY '"Making constructor autoload"
   makeConstructorsAutoLoad()
   SAY '"Building category table"
-  genCategoryTable()
+  generateCategoryTable makeTable function symbolEq?
   SAY '"Building libdb.text"
   buildLibdb()
   SAY '"splitting libdb.text"
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 5cffb749..0d515fa5 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -302,8 +302,6 @@ $Echo := false
 ++ answers x has y category questions
 $HasCategoryTable := nil
 
-$AncestorsTable := nil
-
 ++
 _*BUILD_-VERSION_* := nil
 _*YEARWEEK_* := nil