diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/interp/clam.boot | 4 | ||||
| -rw-r--r-- | src/interp/daase.lisp | 5 | ||||
| -rw-r--r-- | src/interp/define.boot | 8 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 2 |
5 files changed, 20 insertions, 8 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index b1b88207..fc1b46f5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2011-10-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/nruncomp.boot (mkDomainCatName): Remove. + * interp/daase.lisp (DATABSE): Add new field TEMPLATE. + (dbTemplate): New macro accessor. + * interp/clam.boot (clearCategoryCaches): Clear dbTemplate. + * interp/define.boot (DomainSubstitutionFunction): Generate code + to access or set dbTemplate. + +2011-10-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/daase.lisp (DATABASE): Add new field CAPSULE-DEFINITIONS. (dbCapsuleDefinitions): New macro accessor. * interp/functor.boot (encodeFunctionName): Set it. diff --git a/src/interp/clam.boot b/src/interp/clam.boot index ae13ae5f..98986f85 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -358,8 +358,8 @@ clearCategoryCaches() == if getConstructorKindFromDB name = "category" then if BOUNDP(cacheName:= mkCacheName name) then symbolValue(cacheName) := nil - if BOUNDP(cacheName:= mkDomainCatName name) - then symbolValue(cacheName) := nil + db := constructorDB name => + dbTemplate(db) := nil clearCategoryCache catName == symbolValue(mkCacheName catName) := nil diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index bf760d34..ddade882 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -229,6 +229,8 @@ being-defined ; T is definition of constructor is being processed load-path ; full object path name, when loaded. capsule-definitions ; capsule-level definitions + template ; for a category, this the generic instantce. + ; for a functor, this is the template. ) ; database structure @@ -298,6 +300,9 @@ (defmacro |dbCapsuleDefinitions| (db) `(database-capsule-definitions ,db)) +(defmacro |dbTemplate| (db) + `(database-template ,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 1481a24d..9975116c 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -2438,10 +2438,10 @@ DomainSubstitutionFunction(parameters,body) == body isnt ["Join",:.] => body $definition isnt [.,:.] => body $definition.args = nil => body - name := mkDomainCatName $definition.op - SETANDFILE(name,nil) - body := ['%when,[name],['%otherwise,['%store,name,body]]] - body + g := gensym() + ['%bind,[[g,['constructorDB,quote $definition.op]]], + ['%when,[['dbTemplate,g]], + ['%otherwise,['%store,['dbTemplate,g],body]]]] ++ Subroutine of compCategoryItem. diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 74486621..5c659091 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -577,8 +577,6 @@ NRTcheckVector domainShell == alist := [[first v,:vectorRef($SetFunctions,i)],:alist] alist -mkDomainCatName id == makeSymbol strconc(id,'";CAT") - NRTsetVector4Part1(siglist,formlist,condlist) == $uncondList: local := nil $condList: local := nil |