* interp/lisplib.boot (writeCategory): New,

	(finalizeLisplib): Use it.  Write category bodies in generated
	Lisp code file.
	* interp/daase.lisp (GETDATABASE) [CONSTRUCTORCATEGORY]: Don't
	bother with package and domain constructors.
	* interp/database.boot (getConstructorCategory): Rename from
	getConstructorCategoryFromDB.  Reimplement,  Adjusr callers.

6 files changed, 21 insertions, 22 deletions

diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index bc0554a5..0b71c730 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -522,7 +522,7 @@ parentsOfForm [op,:argl] ==
 
 getParentsForDomain domname  == --called by parentsOf
   acc := nil
-  for x in folks getConstructorCategoryFromDB domname repeat
+  for x in folks getConstructorCategory domname repeat
     x :=
       getConstructorKindFromDB domname = "category" =>
         sublisFormal(IFCDR getConstructorForm domname,x,$TriangleVariableList)
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index fbb0b6c0..00505e8f 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -60,7 +60,7 @@ genCategoryTable() ==
   SETQ(_*HASCATEGORY_-HASH_*,hashTable 'EQUAL)
   genTempCategoryTable()
   domainTable :=
-    [addDomainToTable(con,getConstrCat getConstructorCategoryFromDB con)
+    [addDomainToTable(con,getConstrCat getConstructorCategory con)
       for con in allConstructors() | getConstructorKindFromDB con is "domain"]
   -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT
   specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains)
@@ -366,7 +366,7 @@ makeCatPred(zz, cats, thePred) ==
   cats
 
 getConstructorExports(conform,:options) == categoryParts(conform,
-  getConstructorCategoryFromDB opOf conform,IFCAR options)
+  getConstructorCategory opOf conform,IFCAR options)
 
 categoryParts(conform,category,:options) == main where
   main() ==
@@ -458,11 +458,10 @@ updateCategoryTable(cname,kind) ==
     kind is 'package => nil
     kind is 'category => updateCategoryTableForCategory(cname)
     updateCategoryTableForDomain(cname,getConstrCat(
-      getConstructorCategoryFromDB cname))
---+
+      getConstructorCategory cname))
   kind is 'domain =>
     updateCategoryTableForDomain(cname,getConstrCat(
-      getConstructorCategoryFromDB cname))
+      getConstructorCategory cname))
 
 updateCategoryTableForCategory(cname) ==
   clearTempCategoryTable([[cname,'category]])
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 5ee85320..96582c61 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -327,9 +327,7 @@
   "if true print out cache misses on getdatabase calls")
 
    ; note that constructorcategory information need only be kept for
-   ; items of type category. this will be fixed in the next iteration
-   ; when the need for the various caches are reviewed
-
+   ; items of type category.
    ; note that the *modemaps-hash* information does not need to be kept
    ; for system files. these are precomputed and kept in modemap.daase
    ; however, for user-defined files these are needed.
@@ -610,9 +608,7 @@
 ;    constructormodemap
 ;    modemaps            -- this should not be needed. eliminate it.
 ;    object              -- the name of the object file to load for this con.
-;    constructorcategory -- note that this info is the cadar of the
-;         constructormodemap for domains and packages so it is stored
-;         as NIL for them. it is valid for categories.
+;    constructorcategory -- note that this info is valid only for categories.
 ;    abbrev              -- kept directly
 ;    cosig               -- kept directly
 ;    constructorkind     -- kept directly
@@ -767,7 +763,7 @@
   (format t "~a: ~%" 'constructormodemap)
   (pprint (|getConstructorModemap| constructor))
   (format t "~&~a: ~%" 'constructorcategory)
-  (pprint (|getConstructorCategoryFromDB| constructor))
+  (pprint (|getConstructorCategory| constructor))
   (format t "~&~a: ~%" 'operationalist)
   (pprint (|getConstructorOperationsFromDB| constructor))
   (format t "~&~a: ~%" 'modemaps)
@@ -856,9 +852,7 @@
 	      (constructorcategory
 	       (setq stream *interp-stream*)
 	       (when struct
-		 (setq data (|dbCategory| struct))
-		 (when (null data) ;domain or package then subfield of constructormodemap
-		   (setq data (cadar (|getConstructorModemap| constructor))))))
+		 (setq data (|dbCategory| struct))))
 	      (operationalist
 	       (setq stream *interp-stream*)
 	       (when struct
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 53aba6ec..c65f2c42 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -63,9 +63,11 @@ getConstructorAbbreviationFromDB: %Constructor -> %Symbol
 getConstructorAbbreviationFromDB ctor ==
   GETDATABASE(ctor,"ABBREVIATION")
 
-getConstructorCategoryFromDB: %Constructor -> %Form
-getConstructorCategoryFromDB ctor ==
-  GETDATABASE(ctor,"CONSTRUCTORCATEGORY")
+getConstructorCategory: %Constructor -> %Form
+getConstructorCategory ctor ==
+  getConstructorKindFromDB ctor = 'category =>
+    GETDATABASE(ctor,"CONSTRUCTORCATEGORY")
+  getConstructorModemap(ctor).mmTarget
 
 getConstructorKindFromDB: %Constructor -> %Maybe %ConstructorKind
 getConstructorKindFromDB ctor ==
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index 4a0f08eb..bada82b8 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -412,7 +412,7 @@ getConditionsForCategoryOnType(t,cat) ==
 getConditionalCategoryOfType(t,conditions,match) ==
   if cons? t then t := first t
   t in '(Union Mapping Record) => nil
-  conCat := getConstructorCategoryFromDB t
+  conCat := getConstructorCategory t
   removeDuplicates rest getConditionalCategoryOfType1(conCat,conditions,match,[nil])
 
 getConditionalCategoryOfType1(cat,conditions,match,seen) ==
@@ -429,7 +429,7 @@ getConditionalCategoryOfType1(cat,conditions,match,seen) ==
   cat is [catName,:.] and (getConstructorKindFromDB catName = "category") =>
     member(cat, rest seen) => conditions
     seen.rest := [cat,:rest seen]
-    subCat := getConstructorCategoryFromDB catName
+    subCat := getConstructorCategory catName
     -- substitute vars of cat into category
     for v in rest cat for vv in $TriangleVariableList repeat
       subCat := substitute(v,vv,subCat)
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 8c39a1b5..e8d85247 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -550,6 +550,9 @@ writeAbbreviation(db,file) ==
 writeConstructorForm(ctor,form,file) ==
   writeInfo(ctor,form,'constructorForm,'dbConstructorForm,file)
 
+writeCategory(ctor,cat,file) ==
+  writeInfo(ctor,cat,'constructorCategory,'dbCategory,file)
+
 writeSuperDomain(ctor,domPred,file) ==
   writeInfo(ctor,domPred,'superDomain,'dbSuperDomain,file)
 
@@ -591,7 +594,8 @@ finalizeLisplib(ctor,libName) ==
   $lisplibCategory := $lisplibCategory or mm.mmTarget
   -- set to target of mm for package/domain constructors;
   -- to the right-hand sides (the definition) for category constructors
-  lisplibWrite('"constructorCategory",$lisplibCategory,$libFile)
+  if dbConstructorKind db = 'category then
+    writeCategory(ctor,$lisplibCategory,$libFile)
   lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
   lisplibWrite('"modemaps",removeZeroOne $lisplibModemapAlist,$libFile)
   opsAndAtts := getConstructorOpsAndAtts(form,kind,mm)