* interp/define.boot (getInfovecCode): Take a DB argument. Pass

	it to callees.  Adjust caller.
	* interp/database.boot (getConstructorPredicates): If contructor
	is being defined, return the predicates as currently known.
	* interp/daase.lisp (INITIAL-GETDATABASE): Remove
	(fillDatabasesInCore): Adjust.

7 files changed, 36 insertions, 212 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 7991ebf1..79e3e61c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2011-10-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/define.boot (getInfovecCode): Take a DB argument.  Pass
+	it to callees.  Adjust caller.
+	* interp/database.boot (getConstructorPredicates): If contructor
+	is being defined, return the predicates as currently known.
+	* interp/daase.lisp (INITIAL-GETDATABASE): Remove
+	(fillDatabasesInCore): Adjust.
+
+2011-10-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/compiler.boot (compHasFormat): Simplify type form.
 
 2011-10-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 7196c742..fce8ca41 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -424,196 +424,9 @@
  (browseopen)
  (setq *category-stream-stamp* '(0 . 0))
  (categoryopen) ;note: this depends on constructorform in browse.daase
- (unless |$buildingSystemAlgebra|
-   (initial-getdatabase))
 #+:AKCL (gbc t)
 )
 
-(defun initial-getdatabase ()
-  "fetch data we want in the saved system"
-  (let (hascategory constructormodemapAndoperationalist operation constr)
-    (when |$verbose|
-      (format t "Initial getdatabase~%"))
-    (setq hascategory '(
-			(|Equation| . |Ring|)
-			(|Expression| . |CoercibleTo|)
-			(|Expression| . |CommutativeRing|)
-			(|Expression| . |IntegralDomain|)
-			(|Expression| . |Ring|)
-			(|Float| . |RetractableTo|)
-			(|Fraction| . |Algebra|) 
-			(|Fraction| . |CoercibleTo|)
-			(|Fraction| . |OrderedSet|)
-			(|Fraction| . |RetractableTo|)
-			(|Integer| . |Algebra|) 
-			(|Integer| . |CoercibleTo|)
-			(|Integer| . |ConvertibleTo|)
-			(|Integer| . |LinearlyExplicitRingOver|)
-			(|Integer| . |RetractableTo|)
-			(|List| . |CoercibleTo|)
-			(|List| . |FiniteLinearAggregate|)
-			(|List| . |OrderedSet|)
-			(|Polynomial| . |CoercibleTo|) 
-			(|Polynomial| . |CommutativeRing|)
-			(|Polynomial| . |ConvertibleTo|)
-			(|Polynomial| . |OrderedSet|)
-			(|Polynomial| . |RetractableTo|)
-			(|Symbol| . |CoercibleTo|) 
-			(|Symbol| . |ConvertibleTo|)
-			(|Variable| . |CoercibleTo|)))
-    (dolist (pair hascategory)
-      (|constructorHasCategoryFromDB| pair))
-    (setq constructormodemapAndoperationalist 
-	  '(|BasicOperator| 
-	    |Boolean|
-	    |CardinalNumber|
-	    |Color|
-	    |Complex|
-	    |Database|
-	    |Equation| 
-	    |EquationFunctions2|
-	    |Expression|
-	    |Float| 
-	    |Fraction|
-	    |FractionFunctions2|
-	    |Integer| 
-	    |IntegralDomain|
-	    |Kernel|
-	    |List|
-	    |Matrix|
-	    |MappingPackage1|
-	    |Operator|
-	    |OutputForm|
-	    |NonNegativeInteger|
-	    |ParametricPlaneCurve|
-	    |ParametricSpaceCurve|
-	    |Point| 
-	    |Polynomial|
-	    |PolynomialFunctions2|
-	    |PositiveInteger|
-	    |Ring|
-	    |SetCategory| 
-	    |SegmentBinding|
-	    |SegmentBindingFunctions2|
-	    |DoubleFloat|
-	    |SparseMultivariatePolynomial|
-	    |SparseUnivariatePolynomial|
-	    |Segment|
-	    |String|
-	    |Symbol|
-	    |UniversalSegment|
-	    |Variable|
-	    |Vector|))
-    (dolist (con constructormodemapAndoperationalist)
-      (|getConstructorModemap| con)
-      (|getConstructorOperationsFromDB| con))
-    (setq operation 
-	  '(|+| |-| |*| |/| |**| 
-	    |coerce| |convert| |elt| |equation|
-	    |float| |sin| |cos| |map| |SEGMENT|))
-    (dolist (op operation)
-      (|getOperationFromDB| op))
-    (setq constr
-	  '( ;these are sorted least-to-most freq. delete early ones first
-	    |Factored| 
-	    |SparseUnivariatePolynomialFunctions2|
-	    |TableAggregate&|
-	    |RetractableTo&|
-	    |RecursiveAggregate&|
-	    |UserDefinedPartialOrdering|
-	    |None|
-	    |UnivariatePolynomialCategoryFunctions2|
-	    |IntegerPrimesPackage|
-	    |SetCategory&|
-	    |IndexedExponents| 
-	    |QuotientFieldCategory&|
-	    |Polynomial|
-	    |EltableAggregate&|
-	    |PartialDifferentialRing&| 
-	    |Set|
-	    |UnivariatePolynomialCategory&|
-	    |FlexibleArray|
-	    |SparseMultivariatePolynomial|
-	    |PolynomialCategory&|
-	    |DifferentialExtension&|
-	    |IndexedFlexibleArray|
-	    |AbelianMonoidRing&|
-	    |FiniteAbelianMonoidRing&|
-	    |DivisionRing&| 
-	    |FullyLinearlyExplicitRingOver&|
-	    |IndexedVector|
-	    |IndexedOneDimensionalArray| 
-	    |LocalAlgebra|
-	    |Localize|
-	    |Boolean|
-	    |Field&|
-	    |Vector|
-	    |IndexedDirectProductObject|
-	    |Aggregate&|
-	    |PolynomialRing|
-	    |FreeModule|
-	    |IndexedDirectProductAbelianGroup|
-	    |IndexedDirectProductAbelianMonoid|
-	    |SingletonAsOrderedSet|
-	    |SparseUnivariatePolynomial|
-	    |Fraction| 
-	    |Collection&|
-	    |HomogeneousAggregate&|
-	    |RepeatedSquaring|
-	    |IntegerNumberSystem&|
-	    |AbelianSemiGroup&|
-	    |AssociationList|
-	    |OrderedRing&| 
-	    |SemiGroup&|
-	    |Symbol|
-	    |UniqueFactorizationDomain&|
-	    |EuclideanDomain&|
-	    |IndexedAggregate&|
-	    |GcdDomain&|
-	    |IntegralDomain&|
-	    |DifferentialRing&|
-	    |Monoid&|
-	    |Reference|
-	    |UnaryRecursiveAggregate&| 
-	    |OrderedSet&|
-	    |AbelianGroup&|
-	    |Algebra&|
-	    |Module&| 
-	    |Ring&| 
-	    |StringAggregate&|
-	    |AbelianMonoid&|
-	    |ExtensibleLinearAggregate&|
-	    |PositiveInteger| 
-	    |StreamAggregate&|
-	    |IndexedString|
-	    |IndexedList|
-	    |ListAggregate&|
-	    |LinearAggregate&|
-	    |Character| 
-	    |String|
-	    |NonNegativeInteger|
-	    |SingleInteger|
-	    |OneDimensionalArrayAggregate&|
-	    |FiniteLinearAggregate&|
-	    |PrimitiveArray|
-	    |Integer| 
-	    |List|
-	    |OutputForm|))
-    (dolist (con constr)
-      (let ((c (|getSystemModulePath| 
-		(string (|getConstructorAbbreviationFromDB| con)))))
-	(when |$verbose|
-	  (format t "   preloading ~a.." c))
-	(if (probe-file c)
-	    (progn
-	      (|loadModule| c con)
-	      (setf (|dbLoadPath| (|constructorDB| con)) c)
-	      (when |$verbose|
-		(format t "loaded.~%")))
-	  (when |$verbose|
-	    (format t "skipped.~%")))))
-    (when |$verbose|
-      (format t "~%"))))
 
 ; format of an entry in interp.daase:
 ;  (constructor-name
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 5a0bd592..8e764e50 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -120,7 +120,9 @@ getDualSignature ctor ==
 
 getConstructorPredicates: %Constructor -> %List %Thing
 getConstructorPredicates ctor ==
-  dbPredicates loadDBIfNecessary constructorDB ctor
+  db := constructorDB ctor
+  dbBeingDefined? db => dbPredicates db
+  dbPredicates loadDBIfNecessary db
 
 getConstructorParentsFromDB: %Constructor -> %List %Constructor
 getConstructorParentsFromDB ctor ==
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 9975116c..3d282ec6 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -351,19 +351,19 @@ chaseInferences(pred,$e) ==
 --=======================================================================
 --            Generate Code to Create Infovec
 --=======================================================================
-getInfovecCode() == 
+getInfovecCode db == 
 --Function called by compDefineFunctor1 to create infovec at compile time
   ['LIST,
-    MKQ makeDomainTemplate $template,
-      MKQ makeCompactDirect $NRTslot1Info,
-        MKQ NRTgenFinalAttributeAlist $e,
-          NRTmakeCategoryAlist $e,
+    MKQ makeDomainTemplate(db,$template),
+      MKQ makeCompactDirect(db,$NRTslot1Info),
+        MKQ NRTgenFinalAttributeAlist(db,$e),
+          NRTmakeCategoryAlist(db,$e),
             MKQ $lookupFunction]
 
 --=======================================================================
 --         Generation of Domain Vector Template (Compile Time)
 --=======================================================================
-makeDomainTemplate vec ==   
+makeDomainTemplate(db,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
@@ -392,24 +392,24 @@ makeGoGetSlot(item,index) ==
 --                Generate OpTable at Compile Time
 --=======================================================================
 --> called by getInfovecCode (see top of this file) from compDefineFunctor1
-makeCompactDirect u ==
+makeCompactDirect(db,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)]
+  d := [[op,y] for [op,:items] in opList | y := makeCompactDirect1(db,op,items)]
   $byteVec := [:$byteVec,:"append"/reverse! $byteVecAcc]
   vector("append"/d)
  
-makeCompactDirect1(op,items) ==
+makeCompactDirect1(db,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
+    newcodes := "append"/[u for y in orderBySubsumption items |
+                            u := fn(db,y)] or return nil
     $byteVecAcc := [newcodes,:$byteVecAcc]
     curAddress
- where fn y ==
+ where fn(db,y) ==
   [sig,:r] := y
   r = ['Subsumed] =>
     n := #sig - 1
@@ -476,7 +476,7 @@ depthAssoc x ==
  
 getCatAncestors x ==  [CAAR y for y in parentsOf opOf x]
  
-NRTmakeCategoryAlist e ==
+NRTmakeCategoryAlist(db,e) ==
   $depthAssocCache: local := hashTable 'EQ
   $catAncestorAlist: local := nil
   pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
@@ -1456,7 +1456,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
       $NRTslot1PredicateList :=
         [simpBool x for x in $NRTslot1PredicateList]
       LAM_,FILEACTQ('loadTimeStuff,
-        ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
+        ['MAKEPROP,MKQ $op,''infovec,getInfovecCode db])
     $lisplibOperationAlist:= operationAlist
     -- Functors are incomplete during bootstrap
     if $bootStrapMode then
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 6883993a..f91491b0 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -428,7 +428,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
       code:=[v,:code]
   [["%LET",instantiatedBase,base],:code]
  
-DescendCode(code,flag,viewAssoc) ==
+DescendCode(db,code,flag,viewAssoc) ==
   -- flag = true if we are walking down code always executed;
   -- otherwise set to conditions in which
   code = nil => nil
@@ -436,16 +436,16 @@ DescendCode(code,flag,viewAssoc) ==
   isMacro(code,$e) => nil --RDJ: added 3/16/83
   code is ['add,base,:codelist] =>
     codelist:=
-      [v for u in codelist | (v:= DescendCode(u,flag,viewAssoc))~=nil]
+      [v for u in codelist | (v:= DescendCode(db,u,flag,viewAssoc))~=nil]
                   -- must do this first, to get this overriding Add code
     ['PROGN,:DescendCodeAdd(base,flag),:codelist]
   code is ['PROGN,:codelist] =>
     ['PROGN,:
             --Two REVERSEs leave original order, but ensure last guy wins
       reverse! [v for u in reverse codelist |
-                    (v:= DescendCode(u,flag,viewAssoc))~=nil]]
+                    (v:= DescendCode(db,u,flag,viewAssoc))~=nil]]
   code is ['%when,:condlist] =>
-    c:= [[u2:= ProcessCond(first u,$e),:q] for u in condlist] where q() ==
+    c:= [[u2:= ProcessCond(db,first u,$e),:q] for u in condlist] where q() ==
           null u2 => nil
           f:=
             TruthP u2 => flag;
@@ -454,7 +454,7 @@ DescendCode(code,flag,viewAssoc) ==
                u2
             flag := ['AND,flag,['NOT,u2]];
             ['AND,flag,u2]
-          [DescendCode(v, f,
+          [DescendCode(db,v, f,
             if first u is ['HasCategory,dom,cat]
               then [[dom,:cat],:viewAssoc]
               else viewAssoc) for v in rest u]
@@ -473,7 +473,7 @@ DescendCode(code,flag,viewAssoc) ==
           code:=['%store,['%tref,['%tref,'$,5],#$locals-#u],code]
           $epilogue:=
             TruthP flag => [code,:$epilogue]
-            [['%when,[ProcessCond(flag,$e),code]],:$epilogue]
+            [['%when,[ProcessCond(db,flag,$e),code]],:$epilogue]
           nil
         code
     code -- doItIf deletes entries from $locals so can't optimize this
@@ -488,7 +488,7 @@ DescendCode(code,flag,viewAssoc) ==
     if not $insideCategoryPackageIfTrue then
       updateCapsuleDirectory([second(u).args,third u],flag)
     ConstantCreator u =>
-      if flag ~= true then u:= ['%when,[ProcessCond(flag,$e),u]]
+      if flag ~= true then u:= ['%when,[ProcessCond(db,flag,$e),u]]
       $ConstantAssignments:= [u,:$ConstantAssignments]
       nil
     u
@@ -508,7 +508,7 @@ ConstantCreator u ==
   u is ['CONS,:.] => false
   true
  
-ProcessCond(cond,e) ==
+ProcessCond(db,cond,e) ==
   ncond := applySubst($pairlis,cond)
   valuePosition(ncond,$NRTslot1PredicateList) => predicateBitRef(ncond,e)
   cond
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 6c6e3018..639db319 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -64,7 +64,7 @@ simplifyAttributeAlist(db,al) ==
     [[a,:pred],:simplifyAttributeAlist(db,s)]
   nil
  
-NRTgenFinalAttributeAlist e ==
+NRTgenFinalAttributeAlist(db,e) ==
   [[a,:k] for [a,:b] in $NRTattributeAlist
      | (k := predicateBitIndex(b,e)) ~= -1]
  
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 5c659091..f4ac82b6 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -515,7 +515,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
   [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
     makePredicateBitVector([:ASSOCRIGHT $condAlist,:$NRTslot1PredicateList],$e)
 
-  storeOperationCode := DescendCode(code,true,nil)
+  storeOperationCode := DescendCode(db,code,true,nil)
   NRTaddDeltaCode()
   storeOperationCode:= NRTputInLocalReferences storeOperationCode
   NRTdescendCodeTran(storeOperationCode,nil) --side effects storeOperationCode