aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/clam.boot4
-rw-r--r--src/interp/daase.lisp5
-rw-r--r--src/interp/define.boot8
-rw-r--r--src/interp/nruncomp.boot2
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