* interp/define.boot (compDefineCategory2): Mark begining and end

	of definition processing.
	(compDefineFunctor1): Likewise.
	* interp/daase.lisp (dbPrincipals): New accessor.
	* interp/br-data.boot (getDefaultPackageClients): Fix thinko.
	* interp/lisplib.boot (writeAncestors): New.
	(finalizeLisplib): Use it

5 files changed, 27 insertions, 6 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 5cb13b36..f426bf10 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-08-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/define.boot (compDefineCategory2): Mark begining and end
+	of definition processing.
+	(compDefineFunctor1): Likewise.
+	* interp/daase.lisp (dbPrincipals): New accessor.
+	* interp/br-data.boot (getDefaultPackageClients): Fix thinko.
+	* interp/lisplib.boot (writeAncestors): New.
+	(finalizeLisplib): Use it
+
 2011-08-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/lisplib.boot (writeInstanceCache): Remove.
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index b11b2adf..e8b1ba7b 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -427,7 +427,7 @@ mkUsersHashTable() ==  --called by buildDatabase (database.boot)
 getDefaultPackageClients con ==  --called by mkUsersHashTable
   catname := makeSymbol subString(s := symbolName con,0,maxIndex s)
   for [catAncestor,:.] in childrenOf([catname]) repeat
-    pakname := makeDefaultPackageName symbolName catAncestor
+    pakname := makeDefaultPackageName symbolName catAncestor.op
     if getCDTEntry(pakname,true) then acc := [pakname,:acc]
     acc := union([CAAR x for x in domainsOf([catAncestor],nil)],acc)
   listSort(function GLESSEQP,acc)
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 16a63f22..678c390f 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -260,6 +260,9 @@
 (defmacro |dbCategory| (db)
   `(database-constructorcategory ,db))
 
+(defmacro |dbPrincipals| (db)
+  `(database-parents ,db))
+
 (defmacro |dbAncestors| (db)
   `(database-ancestors ,db))
 
@@ -702,7 +705,7 @@
 	(setf (database-documentation dbstruct) (fourth item))
 	(setf (|dbAttributes| dbstruct) (fifth item))
 	(setf (|dbPredicates| dbstruct) (sixth item))
-	(setf (database-parents dbstruct) (seventh item))))
+	(setf (|dbPrincipals| dbstruct) (seventh item))))
     (format t "~&")))
 
 (defun categoryOpen ()
@@ -912,7 +915,7 @@
 	      (parents
 	       (setq stream *browse-stream*)
 	       (when struct
-		 (setq data (database-parents struct))))
+		 (setq data (|dbPrincipals| struct))))
 	      (users
 	       (setq stream *browse-stream*)
 	       (when struct
@@ -967,7 +970,7 @@
 		(documentation 
 		 (setf (database-documentation struct) data))
 		(parents   
-		 (setf (database-parents struct) data))
+		 (setf (|dbPrincipals| struct) data))
 		(superdomain
 		 (setf (|dbSuperDomain| struct) data))
 		(users     
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 70800868..5331907c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -998,7 +998,9 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
          --Set in DomainSubstitutionFunction, used further down
     -- 1.1  augment e to add declaration $: <form>
     [$op,:argl] := $definition
-    dbInstanceCache(constructorDB $op) := true
+    db := constructorDB $op
+    dbBeingDefined?(db) := true
+    dbInstanceCache(db) := true
     e:= addBinding("$",[['mode,:$definition]],e)
  
     -- 2. obtain signature
@@ -1059,6 +1061,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
       $lisplibAncestors := computeAncestorsOf($form,nil)
       form':=[op',:sargl]
       augLisplibModemapsFromCategory(form',formalBody,signature')
+    dbBeingDefined?(db) := false
     [fun,$Category,e]
 
 mkConstructor: %Form -> %Form
@@ -1338,6 +1341,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     originale:= $e
     [$op,:argl]:= form
     db := constructorDB $op
+    dbBeingDefined?(db) := true
     dbConstructorForm(db) := form
     $formalArgList:= [:argl,:$formalArgList]
     $pairlis: local := pairList(argl,$FormalMapVariableList)
@@ -1446,6 +1450,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     if $bootStrapMode then
       evalAndRwriteLispForm('%incomplete,
             ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'%incomplete], true])
+    dbBeingDefined?(db) := false
     [fun,['Mapping,:signature'],originale]
 
 
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index f0477250..dc2e587b 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -557,6 +557,9 @@ writeOperations(ctor,ops,file) ==
 writeConstructorModemap(ctor,mm,file) ==
   writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
 
+writeAncestors(ctor,x,file) ==
+  writeInfo(ctor,x,'ancestors,'dbAncestors,file)
+
 ++ If compilation produces an error, issue inform user and
 ++ return to toplevel reader.
 leaveIfErrors(libName,kind) ==
@@ -594,7 +597,7 @@ finalizeLisplib(ctor,libName) ==
   lisplibWrite('"predicates",removeZeroOne  $lisplibPredicates,$libFile)
   lisplibWrite('"abbreviation",dbAbbreviation constructorDB ctor,$libFile)
   lisplibWrite('"parents",removeZeroOne $lisplibParents,$libFile)
-  lisplibWrite('"ancestors",removeZeroOne $lisplibAncestors,$libFile)
+  writeAncestors(ctor,removeZeroOne $lisplibAncestors,$libFile)
   lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile)
   lisplibWrite('"slot1Info",removeZeroOne $lisplibSlot1,$libFile)
   if $profileCompiler then profileWrite()