Rename dbConstructorDefault to dbDefaultPackage

And various cleanups.

5 files changed, 36 insertions, 30 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 569e25d8..3f7dd18a 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -232,10 +232,6 @@ macro dbSubstituteQueries(db,x) ==
 dbSubstituteAllQuantified(db,x) ==
   applySubst([:dbQuerySubst db,:dbFormalSubst db],x)
 
-++ This predicate holds if this DB is for a category constructor.  
-dbForCategory? db ==
-  db ~= nil and dbConstructorKind db is 'category
-
 --%
 $SetCategory ==
   '(SetCategory)
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 86504bdb..d80cd961 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -209,15 +209,16 @@
  parents                    ; browse.
  users                      ; browse.
  dependents                 ; browse.
- superdomain                ; interp.
+ superdomain                ; interp. overloaded field
+                            ; for domain: base domain of a subdomain
+                            ; for category: default package constructor
  instantiations		    ; nil if mutable constructor
  compiler-data		    ; holds compiler data when processing constructor
  load-path		    ; full object path name, when loaded.
  capsule-definitions	    ; capsule-level definitions
  template		    ; for a category, this is the generic instance.
                             ; for a functor, this is the template.
- lookup-function	    ; for a functor, lookup function.  For category
-                            ; constructor, default package constructor.
+ lookup-function	    ; for a functor, lookup function.
  optable                    ; for a functor, operation table.
  ) ; database structure
 
@@ -1009,7 +1010,8 @@
 	  (finish-output out))
       (setq ancestorspos nil))
     (setq superpos
-	  (let ((super (|dbSuperDomain| struct)))
+	  (let ((super (and (not (|dbForCategory?| struct))
+			    (|dbSuperDomain| struct))))
 	    (when super
 	      (prog1 (file-position out)
 		(print (list (car super) (second super)) out)
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 091b2ff9..f7ba0516 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -41,10 +41,19 @@ import compat
 import daase
 namespace BOOT
 
+module database where
+  dbForCategory? : %Maybe %Database -> %Boolean
+
 $getUnexposedOperations := true
 $globalExposureGroupAlist := []
 
 
+--%
+
+++ This predicate holds if this DB is for a category constructor.  
+dbForCategory? db ==
+  db ~= nil and dbConstructorKind db = 'category
+
 --% 
 
 pathToDatabase name ==
@@ -74,13 +83,13 @@ makeConstructor(s,k == nil,a == nil) ==
 
 ++ Access to the default constructor of a category.
 ++ Note: Meaningful only for categories
-macro dbConstructorDefault db ==
-  dbLookupFunction db
+macro dbDefaultPackage db ==
+  dbSuperDomain db
 
 getCategoryConstructorDefault: %Symbol -> %Maybe %Symbol
 getCategoryConstructorDefault ctor ==
   builtinConstructor? ctor => nil
-  dbConstructorDefault loadDBIfNecessary constructorDB ctor
+  dbDefaultPackage loadDBIfNecessary constructorDB ctor
 
 getConstructorAbbreviationFromDB: %Symbol -> %Maybe %Symbol
 getConstructorAbbreviationFromDB ctor ==
@@ -858,7 +867,7 @@ writeMinimalDB(lhs,rhs,path,dbfile) ==
   writeNewline dbfile
   -- If this is a category with defaults, write out the data for 
   -- associated package.
-  dbConstructorKind db isnt 'category or rhs isnt ['add,:.] => nil
+  not dbForCategory? db or rhs isnt ['add,:.] => nil
   data := [defaultPackageForm lhs,'package,
              makeDefaultPackageAbbreviation db,path]
   prettyPrint(['makeInitialDB,quote data],dbfile)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 8f4cb615..ed1a565c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1002,7 +1002,7 @@ mkExportFromDescription desc ==
 mkCategoryPackage(db,cat,def,e) ==
   [op,:argl] := dbConstructorForm db
   packageName:= makeDefaultPackageName symbolName op
-  dbConstructorDefault(db) := packageName
+  dbDefaultPackage(db) := packageName
   packageAbb := makeDefaultPackageAbbreviation db
   $options:local := []
   -- This stops the next line from becoming confused
@@ -2134,7 +2134,7 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
 -- fn is the name of some category/domain/package constructor;
 -- we will cache all of its values on $ConstructorCache with reference
 -- counts
-  dbConstructorKind db = 'category =>
+  dbForCategory? db =>
     first compAndDefine(db,[[fn,['%slam,vl,:bodyl]]])
   dbInstanceCache db = nil =>
     first backendCompile(db,[[fn,['%lambda,vl,:bodyl]]])
@@ -2491,7 +2491,7 @@ compForMode(x,m,e) ==
   $bootStrapMode and m = $Category =>
     op := opOf x
     ident? op and (db := constructorDB op) =>
-      dbConstructorKind db = "category" => [x,m,e]
+      dbForCategory? db => [x,m,e]
       nil
     comp(x,m,e)
   comp(x,m,e)
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 30803167..3ab82e64 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -470,11 +470,11 @@ writeLoadInfo(db,info,key,prop) ==
   printBackendStmt(dbLibstream db,expandToVMForm insn)
 
 writeTemplate db ==
-  dbConstructorKind db = 'category => nil
+  dbForCategory? db => nil
   writeLoadInfo(db,dbTemplate db,'template,'dbTemplate)
 
 writeOperationTable db ==
-  dbConstructorKind db = 'category => nil
+  dbForCategory? db => nil
   writeLoadInfo(db,dbOperationTable db,'optable,'dbOperationTable)
 
 writeLookupFunction db ==
@@ -482,10 +482,9 @@ writeLookupFunction db ==
     writeLoadInfo(db,quote fun,'lookupFunction,'dbLookupFunction)
   nil
 
-writeCategoryDefault db ==
-  pac := dbConstructorDefault db
-  insn := ['%store,['dbConstructorDefault,mkCtorDBForm db],quote pac]
-  printBackendStmt(dbLibstream db,expandToVMForm insn)
+writeDefaultPackage db ==
+  pac := dbDefaultPackage db or return nil
+  writeLoadInfo(db,quote pac,'defaultPackage,'dbDefaultPackage)
 
 writeKind db ==
   writeInfo(db,dbConstructorKind db,'constructorKind,'dbConstructorKind)
@@ -537,7 +536,7 @@ writePrincipals db ==
   writeInfo(db,dbPrincipals db,'parents,'dbPrincipals)
 
 writeCapsuleLevelDefinitions db ==
-  dbConstructorKind db = 'category => nil  -- categories don't have capsules
+  dbForCategory? db => nil  -- categories don't have capsules
   writeLoadInfo(db,quote dbCapsuleDefinitions db,
     'signaturesAndLocals,'dbCapsuleDefinitions)
 
@@ -553,27 +552,27 @@ leaveIfErrors(libName,kind) ==
 finalizeLisplib(db,libName) ==
   form := dbConstructorForm db
   writeTemplate db
-  do   -- shared slot; careful.
-    dbConstructorKind db = 'category => writeCategoryDefault db
-    writeLookupFunction db
+  writeLookupFunction db
   writeConstructorForm db
   writeKind db
   writeConstructorModemap db
   writeDualSignature db
   -- set to target of dbConstructorModemap for package/domain constructors;
   -- to the right-hand sides (the definition) for category constructors
-  if dbConstructorKind db = 'category then
+  if dbForCategory? db then
     writeCategory db
   writeSourceFile db
   writeInteractiveModemaps db
   opsAndAtts :=
-    dbConstructorKind db = 'category => getCategoryOpsAndAtts db
+    dbForCategory? db => getCategoryOpsAndAtts db
     getFunctorOpsAndAtts db
   writeOperations(db,first opsAndAtts)
-  if dbConstructorKind db = 'category then
+  if dbForCategory? db then
      $NRTslot1PredicateList : local := []
      genInitialAttributeAlist(db,rest opsAndAtts)
-  writeSuperDomain db
+  if dbForCategory? db -- careful: overloaded field.
+    then writeDefaultPackage db
+    else writeSuperDomain db
   writeOperationTable db
   writeCapsuleLevelDefinitions db
   writeAttributes db
@@ -756,7 +755,7 @@ isFunctor x ==
   u := get(op,'isFunctor,$CategoryFrame) => u
   builtinFunctorName? op => true
   db := constructorDB op or return false
-  dbConstructorKind db = 'category => false
+  dbForCategory? db => false
   loadDBIfNecessary db
   updateCategoryFrameForConstructor op
   get(op,'isFunctor,$CategoryFrame)