diff options
| -rw-r--r-- | src/ChangeLog | 12 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 9 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 4 | ||||
| -rw-r--r-- | src/interp/define.boot | 12 | ||||
| -rw-r--r-- | src/interp/lisplib.boot | 13 |
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) |