From e88142788728fb2ce4b2dd5c41f3b5d000c4497a Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Thu, 11 Jun 1998 08:09:57 +0000
Subject: [PATCH] Rather than compiling the constructors in dlisp3, just tickle
 the range of shapes defined, leaving the generation of the constructors to
 precompile-dfun-constructors.  This allows a more useful range of
 constructors to be built-in without the prior redundancy resulting from
 dlisp3.

---
 pcl/defsys.lisp |  1 -
 pcl/dlisp3.lisp | 18 ++++++++++++++++++
 2 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp
index 26b264f4d..897405594 100644
--- a/pcl/defsys.lisp
+++ b/pcl/defsys.lisp
@@ -590,7 +590,6 @@ and load your system with:
    (dfun        t                                   t (boot low cache))
    (fast-init   t                                   t (boot low))
    (braid       (+ precom1 precom2)                 t (boot defs low fin cache))
-   #+ignore
    (dlisp3      t                                   t (dlisp2 boot braid))
    (generic-functions t                             t (boot))
    (slots       t                                   t (vector boot defs low cache fin))
diff --git a/pcl/dlisp3.lisp b/pcl/dlisp3.lisp
index 26865a725..7e89d5637 100644
--- a/pcl/dlisp3.lisp
+++ b/pcl/dlisp3.lisp
@@ -67,8 +67,26 @@
 		       `(cons ',key (emit-checking-or-caching-macro ,@key)))
 		   checking-or-caching-list)))
 
+#+nil
 (defun initialize-checking-or-caching-function-list ()
   (setq checking-or-caching-function-list
 	(make-checking-or-caching-function-list)))
 
+#+nil
 (initialize-checking-or-caching-function-list)
+
+;;; Rather than compiling the constructors here, just tickle the range
+;;; of shapes defined above, leaving the generation of the
+;;; constructors to precompile-dfun-constructors.
+;;;
+(dolist (key checking-or-caching-list)
+  (destructuring-bind (cached-emf-p return-value-p metatypes applyp) key
+    (multiple-value-bind (args generator)
+	(if cached-emf-p
+	    (if return-value-p
+		(values (list metatypes) 'emit-constant-value)
+		(values (list metatypes applyp) 'emit-caching))
+	    (if return-value-p
+		(values (list metatypes) 'emit-in-checking-p)
+		(values (list metatypes applyp) 'emit-checking)))
+      (apply #'get-dfun-constructor generator args))))
-- 
GitLab