From 79900718a4de54668c6ed6357453480c17b00168 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sat, 29 Oct 2011 00:23:23 +0000
Subject: 	* 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.

---
 src/ChangeLog            | 9 +++++++++
 src/interp/clam.boot     | 4 ++--
 src/interp/daase.lisp    | 5 +++++
 src/interp/define.boot   | 8 ++++----
 src/interp/nruncomp.boot | 2 --
 5 files changed, 20 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index b1b88207..fc1b46f5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+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.
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
-- 
cgit v1.2.3