aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/c-util.boot9
-rw-r--r--src/interp/daase.lisp4
-rw-r--r--src/interp/define.boot12
-rw-r--r--src/interp/lisplib.boot13
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)