* interp/daase.lisp (dbLookupFunction): New accessor macro.

	* interp/c-util.boot (lookupDefiningFunction): Use it.  Tidy.
	* interp/define.boot ($lookupFunction): Remove.
	(getInfovecCode): Use dbLookupFunction.
	(compDefineFunctor1): Set it.  Do not emit %incomplete anymore.
	* interp/lisplib.boot (writeLookupFunction): New.
	(finalizeLisplib): Use it.

5 files changed, 32 insertions, 18 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index b69f0ed2..8d7ced86 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,4 +1,14 @@
-2011-11-09  Gabriel Dos Reis  <gdr@cse.tamu.edu>
+2011-11-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/daase.lisp (dbLookupFunction): New accessor macro.
+	* interp/c-util.boot (lookupDefiningFunction): Use it.  Tidy.
+	* interp/define.boot ($lookupFunction): Remove.
+	(getInfovecCode): Use dbLookupFunction.
+	(compDefineFunctor1): Set it.  Do not emit %incomplete anymore.
+	* interp/lisplib.boot (writeLookupFunction): New.
+	(finalizeLisplib): Use it.
+
+2011-11-09  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/define.boot (compDefineFunctor1): Clear dbTemplate before
 	compilation starts.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 73fd9a83..3480c03b 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1879,8 +1879,9 @@ lookupDefiningFunction(op,sig,dc) ==
   -- 1. Read domain information, if available.  Silently give up if
   -- the constructor is just not there
   [ctor,:args] := dc
-  loadLibIfNotLoaded ctor
-  property(ctor,'%incomplete) => nil
+  db := constructorDB ctor or return nil -- we only deal with instantiations
+  loadDBIfNecessary db
+  dbTemplate db = nil => nil  -- incomplete functor
   -- 1.1. Niladic constructors don't need approximation.
   --      FIXME: However, there may be cylic dependencies
   --      such as AN ~> IAN ~> EXPR INT ~> AN that prevents
@@ -1891,10 +1892,10 @@ lookupDefiningFunction(op,sig,dc) ==
   isDefaultPackageName ctor => nil
   infovec := property(ctor,'infovec) or return nil
   -- 1.3. We need information about the original domain template
-  shell := first infovec               -- domain template
+  shell := dbTemplate db               -- domain template
   opTable := second infovec            -- operator-code table
   opTableLength := #opTable
-  forgetful := infovec.4 is 'lookupIncomplete
+  forgetful := dbLookupFunction db is 'lookupIncomplete
 
   -- 2. Get the address range of op's descriptor set
   [.,.,.,:funDesc] := fourth infovec
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index d848d8be..8024a8fc 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -231,6 +231,7 @@
  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.
  ) ; database structure
 
 
@@ -306,6 +307,9 @@
 (defmacro |dbTemplate| (db)
   `(database-template ,db))
 
+(defmacro |dbLookupFunction| (db)
+  `(database-lookup-function ,db))
+
 (defun |makeDB| (c)
   (let ((db (make-database)))
     (setf (|dbConstructor| db) c)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 873ee80e..3212979b 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -74,7 +74,6 @@ $NRTslot1PredicateList := []
 $NRTattributeAlist := []
 $NRTdeltaListComp := []
 $signature := nil
-$lookupFunction := nil
 $byteAddress := nil
 $byteVec := nil
 $sigAlist := []
@@ -352,7 +351,7 @@ getInfovecCode(db,e) ==
       MKQ makeCompactDirect(db,NRTmakeSlot1Info db),
         MKQ NRTgenFinalAttributeAlist(db,e),
           NRTmakeCategoryAlist(db,e),
-            MKQ $lookupFunction]
+            MKQ dbLookupFunction db]
 
 --=======================================================================
 --         Generation of Domain Vector Template (Compile Time)
@@ -421,7 +420,7 @@ makeCompactDirect1(db,op,items) ==
   predCode = -1 => return nil
   --> drop items with nil slots if lookup function is incomplete
   if null slot then
-     $lookupFunction is 'lookupIncomplete => return nil
+     dbLookupFunction db is 'lookupIncomplete => return nil
      slot := 1   --signals that operation is not present
   n := #sig - 1
   $byteAddress := $byteAddress + n + 4
@@ -1382,6 +1381,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     dbCompilerData(db) := makeCompilationData()
     dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList)
     dbTemplate(db) := nil
+    dbLookupFunction(db) := nil
     deduceImplicitParameters(db,$e)
     $formalArgList:= [:argl,:$formalArgList]
     -- all defaulting packages should have caching turned off
@@ -1460,17 +1460,13 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     dbAncestors(db) := computeAncestorsOf($form,nil)
     $insideFunctorIfTrue:= false
     if not $bootStrapMode then
-      $lookupFunction: local := NRTgetLookupFunction(db,$NRTaddForm,$e)
+      dbLookupFunction(db) := NRTgetLookupFunction(db,$NRTaddForm,$e)
           --either lookupComplete (for forgetful guys) or lookupIncomplete
       $NRTslot1PredicateList :=
         [simpBool x for x in $NRTslot1PredicateList]
       LAM_,FILEACTQ('loadTimeStuff,
         ['MAKEPROP,MKQ $op,''infovec,getInfovecCode(db,$e)])
     $lisplibOperationAlist:= operationAlist
-    -- Functors are incomplete during bootstrap
-    if $bootStrapMode then
-      evalAndRwriteLispForm('%incomplete,
-            ['MAKEPROP,quote op',quote '%incomplete,true])
     dbBeingDefined?(db) := nil
     [fun,['Mapping,:signature'],originale]
 
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 9449eff4..beebddb8 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -476,15 +476,17 @@ writeLoadInfo(ctor,info,key,prop,file) ==
   insn := ['%store,[prop,mkCtorDBForm ctor],info]
   LAM_,FILEACTQ(key,expandToVMForm insn)
 
-literalData x ==
-  x = nil => nil
-  quote x
-
 writeTemplate(db,file) ==
   dbConstructorKind db = 'category => nil
-  writeLoadInfo(dbConstructor db,literalData dbTemplate db,
+  writeLoadInfo(dbConstructor db,dbTemplate db,
     'template,'dbTemplate,file)
 
+writeLookupFunction(db,file) ==
+  fun := dbLookupFunction db =>
+    writeLoadInfo(dbConstructor db,quote fun,
+      'lookupFunction,'dbLookupFunction,file)
+  nil
+
 writeKind(ctor,kind,file) ==
   writeInfo(ctor,kind,'constructorKind,'dbConstructorKind,file)
 
@@ -541,6 +543,7 @@ finalizeLisplib(ctor,libName) ==
   form := dbConstructorForm db
   mm := getConstructorModemap ctor
   writeTemplate(db,$libFile)
+  writeLookupFunction(db,$libFile)
   writeConstructorForm(ctor,form,$libFile)
   writeKind(ctor,kind,$libFile)
   writeConstructorModemap(ctor,mm,$libFile)