From 0c79bf08a243116545f78251958abc61377f1ed3 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Fri, 28 Oct 2011 23:08:17 +0000 Subject: * interp/daase.lisp (DATABASE): Add new field CAPSULE-DEFINITIONS. (dbCapsuleDefinitions): New macro accessor. * interp/functor.boot (encodeFunctionName): Set it. * interp/lisplib.boot ($lisplibVariableAlist): Remove. ($lisplibSignatureAlist): Likewise. (writeCapsuleLevelDefinitions): New. (finalizeLisplib): Use it. (mergeSignatureAndLocalVarAlists): Remove. * interp/clam.boot (clearCategoryCaches): Use mkDomainCatName. * interp/define.boot (DomainSubstitutionFunction): Likewise. --- src/ChangeLog | 13 +++++++++++++ src/interp/clam.boot | 2 +- src/interp/daase.lisp | 4 ++++ src/interp/define.boot | 2 +- src/interp/functor.boot | 4 ++-- src/interp/lisplib.boot | 18 ++++-------------- src/interp/sys-globals.boot | 6 ------ 7 files changed, 25 insertions(+), 24 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 0f6eaa62..b1b88207 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2011-10-28 Gabriel Dos Reis + + * interp/daase.lisp (DATABASE): Add new field CAPSULE-DEFINITIONS. + (dbCapsuleDefinitions): New macro accessor. + * interp/functor.boot (encodeFunctionName): Set it. + * interp/lisplib.boot ($lisplibVariableAlist): Remove. + ($lisplibSignatureAlist): Likewise. + (writeCapsuleLevelDefinitions): New. + (finalizeLisplib): Use it. + (mergeSignatureAndLocalVarAlists): Remove. + * interp/clam.boot (clearCategoryCaches): Use mkDomainCatName. + * interp/define.boot (DomainSubstitutionFunction): Likewise. + 2011-10-28 Gabriel Dos Reis * interp/database.boot (orderPredTran): Tidy. diff --git a/src/interp/clam.boot b/src/interp/clam.boot index ef384409..ae13ae5f 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -358,7 +358,7 @@ clearCategoryCaches() == if getConstructorKindFromDB name = "category" then if BOUNDP(cacheName:= mkCacheName name) then symbolValue(cacheName) := nil - if BOUNDP(cacheName:= INTERNL strconc(symbolName name,'";CAT")) + if BOUNDP(cacheName:= mkDomainCatName name) then symbolValue(cacheName) := nil clearCategoryCache catName == diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index d434ba69..bf760d34 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -228,6 +228,7 @@ instantiations ; nil if mutable constructor being-defined ; T is definition of constructor is being processed load-path ; full object path name, when loaded. + capsule-definitions ; capsule-level definitions ) ; database structure @@ -294,6 +295,9 @@ (defmacro |dbLoadPath| (db) `(database-load-path ,db)) +(defmacro |dbCapsuleDefinitions| (db) + `(database-capsule-definitions ,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 99035a03..1481a24d 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -2438,7 +2438,7 @@ DomainSubstitutionFunction(parameters,body) == body isnt ["Join",:.] => body $definition isnt [.,:.] => body $definition.args = nil => body - name := makeSymbol strconc(KAR $definition,";CAT") + name := mkDomainCatName $definition.op SETANDFILE(name,nil) body := ['%when,[name],['%otherwise,['%store,name,body]]] body diff --git a/src/interp/functor.boot b/src/interp/functor.boot index c291c554..6883993a 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -800,8 +800,8 @@ encodeFunctionName(db,fun,signature,sep,count) == strconc(toString n,encodeItem x) encodedName:= INTERNL(symbolName dbAbbreviation db,'";", encodeItem fun,'";",encodedSig,sep,toString count) - $lisplibSignatureAlist := - [[encodedName,:signature'],:$lisplibSignatureAlist] + dbCapsuleDefinitions(db) := + [[encodedName,signature'],:dbCapsuleDefinitions db] encodedName ++ Return the linkage name of the local operation named `op'. diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index d565a74e..6c6e3018 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -389,8 +389,6 @@ compConLib1(fun,infileOrNil,outfileOrNil,auxOp,editFlag,traceFlag) == $lisplibPredicates: local := nil $lisplibOperationAlist: local := nil $libFile: local := nil - $lisplibVariableAlist: local := nil - $lisplibSignatureAlist: local := nil if cons? fun and null rest fun then fun:= first fun -- unwrap nullary libName:= getConstructorAbbreviation fun infile:= infileOrNil or getFunctionSourceFile fun or @@ -409,9 +407,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == $op: local := op $lisplibPredicates: local := nil -- set by makePredicateBitVector $lisplibOperationAlist: local := nil - $lisplibSignatureAlist: local := nil $libFile: local := nil - $lisplibVariableAlist: local := nil -- $lisplibRelatedDomains: local := nil --from ++ Related Domains: see c-doc --for categories, is rhs of definition; otherwise, is target of functor --will eventually become the "constructorCategory" property in lisplib @@ -507,6 +503,9 @@ writeAncestors(ctor,x,file) == writePrincipals(ctor,x,file) == writeInfo(ctor,x,'parents,'dbPrincipals,file) +writeCapsuleLevelDefinitions(ctor,x,file) == + writeInfo(ctor,x,'signaturesAndLocals,'dbCapsuleDefinitions,file) + ++ If compilation produces an error, issue inform user and ++ return to toplevel reader. leaveIfErrors(libName,kind) == @@ -538,9 +537,7 @@ finalizeLisplib(ctor,libName) == $NRTslot1PredicateList : local := [] NRTgenInitialAttributeAlist(db,rest opsAndAtts) writeSuperDomain(ctor,dbSuperDomain db,$libFile) - lisplibWrite('"signaturesAndLocals", - mergeSignatureAndLocalVarAlists($lisplibSignatureAlist, - $lisplibVariableAlist),$libFile) + writeCapsuleLevelDefinitions(ctor,dbCapsuleDefinitions db,$libFile) writeAttributes(ctor,dbAttributes db,$libFile) writePredicates(ctor,$lisplibPredicates,$libFile) writeAbbreviation(db,$libFile) @@ -568,13 +565,6 @@ getPartialConstructorModemapSig(c) == (s := getConstructorSignature c) => rest s throwEvalTypeMsg("S2IL0015",[c]) -mergeSignatureAndLocalVarAlists(signatureAlist, localVarAlist) == - -- this function makes a single Alist for both signatures - -- and local variable types, to be stored in the LISPLIB - -- for the function being compiled - [[funcName,:[signature,:LASSOC(funcName,localVarAlist)]] for - [funcName, :signature] in signatureAlist] - getConstructorOpsAndAtts(form,kind,modemap) == kind is 'category => getCategoryOpsAndAtts(form) getFunctorOpsAndAtts(form,modemap) diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 0d97305f..86fcf9cf 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -165,12 +165,6 @@ $libFile := nil ++ $lisplibOperationAlist := [] -++ -$lisplibSignatureAlist := [] - -++ -$lisplibVariableAlist := [] - ++ $mapSubNameAlist := [] -- cgit v1.2.3