From 7ce0611cdcc235063e66cd291bf20474dc40668c Mon Sep 17 00:00:00 2001
From: Gabriel Dos Reis <gdr@axiomatics.org>
Date: Wed, 20 Jan 2016 04:31:41 -0800
Subject: getConstructorFromFromDB: get it from compiled code.

---
 src/interp/daase.lisp    | 8 +-------
 src/interp/database.boot | 8 ++++++--
 2 files changed, 7 insertions(+), 9 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 8fbe451d..97e66462 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -507,7 +507,7 @@
 	  (setq dbstruct (|makeDB| (first item)))
 	  (setq *allconstructors* (adjoin item *allconstructors*)))
 	(setf (|dbSourceFile| dbstruct) (second item))
-	(setf (|dbConstructorForm| dbstruct) (third item))
+;	(setf (|dbConstructorForm| dbstruct) (third item))
 	(setf (database-documentation dbstruct) (fourth item))
 ;	(setf (|dbAttributes| dbstruct) (fifth item))
 ;	(setf (|dbPredicates| dbstruct) (sixth item))
@@ -667,10 +667,6 @@
 	       (setq stream *browse-stream*)
 	       (when struct
 		 (setq data (|dbSourceFile| struct))))
-	      (constructorform
-	       (setq stream *browse-stream*)
-	       (when struct
-		 (setq data (|dbConstructorForm| struct))))
 	      (constructorargs
 	       (setq data (cdr (|getConstructorFormFromDB| constructor))))
 	      (documentation
@@ -705,8 +701,6 @@
 		 (setf (|dbConstructor| struct) data))
 		(ancestors 
 		 (setf (|dbAncestors| struct) data))
-		(constructorform     
-		 (setf (|dbConstructorForm| struct) data))
 		(documentation 
 		 (setf (database-documentation struct) data))
 		(users     
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 79d49785..98dbc134 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -115,9 +115,13 @@ getConstructorModemap ctor ==
     loadDBIfNecessary db
   dbConstructorModemap db
 
-getConstructorFormFromDB: %Symbol -> %Form
+getConstructorFormFromDB: %Symbol -> %Maybe %Instantiation
 getConstructorFormFromDB ctor ==
-  GETDATABASE(ctor,"CONSTRUCTORFORM")
+  builtinConstructor? ctor => nil
+  db := constructorDB ctor or return nil -- FIXME: catch at call sites.
+  if not dbBeingDefined? db and dbConstructorForm db isnt [.,:.] then
+    loadDBIfNecessary db
+  dbConstructorForm db
 
 ++ Return the generic instantiation form of a constructor,
 ++ where the arguments are the parameters used in its
-- 
cgit v1.2.3