* interp/daase.lisp (dbArity, dbInstanceCache): New accessors.

	* interp/database.boot (loadDBIfnecessary): New.
	(dbMutable?): Likewise.
	* interp/lisplib.boot (finalizeLisplib): Record mutable property.

4 files changed, 29 insertions, 5 deletions

diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 50b6b63e..fcbc1a6a 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -225,7 +225,7 @@
  users                      ; browse.
  dependents                 ; browse.
  superdomain                ; interp.
- spare                      ; superstition
+ instantiations		    ; nil if mutable constructor
  ) ; database structure
 
 
@@ -277,6 +277,12 @@
 (defmacro |dbModule| (db)
   `(database-object ,db))
 
+(defmacro |dbArity| (db)
+  `(list-length (cdr (|dbConstructorForm| ,db))))
+
+(defmacro |dbInstanceCache| (db)
+  `(database-instantiations ,db))
+
 (defun |makeDB| (c)
   (let ((db (make-database)))
     (setf (|dbConstructor| db) c)
diff --git a/src/interp/database.boot b/src/interp/database.boot
index c6f9c50a..3ba37506 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -821,3 +821,18 @@ printAllInitdbInfo(srcdir,dbfile) ==
     for path in paths repeat
       printInitdbInfo(NAMESTRING path,out)
   finally closeStream out
+
+--%
+
+loadDBIfnecessary db ==
+  ctor := dbConstructor db
+  property(ctor,'LOADED) => db
+  loadLib ctor or return nil
+  constructorDB ctor
+
+++ Returns true if instantiations of the constructor
+++ defined by `db' should not be cached.
+dbMutable? db ==
+  dbInstanceCache loadDBIfnecessary db = nil
+
+  
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 28408072..c9c0f67d 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -664,10 +664,6 @@ HasCategory(domain,catform') ==
    opOf(catform) in '(Object Type) or  --temporary hack
     or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
 
---systemDependentMkAutoload(fn,cnam) ==
---    FBOUNDP(cnam) => "next"
---    symbolFunction(cnam) := mkAutoLoad(fn, cnam)
-
 domainEqual(a,b) == 
   vector? a and vector? b and a.0 = b.0
  
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 057f1b89..d448fd22 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -552,6 +552,11 @@ writeOperations(ctor,ops,file) ==
 writeConstructorModemap(ctor,mm,file) ==
   writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
 
+writeInstanceCache(ctor,file) ==
+  insn := ['%store,['dbInstanceCache,mkCtorDBForm ctor],'%true]
+  LAM_,FILEACTQ('instanceCache,expandToVMForm insn)
+  lisplibWrite('"instanceCache",'T,file)
+  
 ++ If compilation produces an error, issue inform user and
 ++ return to toplevel reader.
 leaveIfErrors(libName,kind) ==
@@ -568,6 +573,8 @@ finalizeLisplib(ctor,libName) ==
   writeConstructorForm(ctor,form,$libFile)
   writeKind(ctor,kind,$libFile)
   writeConstructorModemap(ctor,removeZeroOne mm,$libFile)
+  if not $mutableDomains then
+    writeInstanceCache(ctor,$libFile)
   $lisplibCategory := $lisplibCategory or mm.mmTarget
   -- set to target of mm for package/domain constructors;
   -- to the right-hand sides (the definition) for category constructors