0.pre7.98:

[sbcl.git] / src / pcl / fast-init.lisp

diff --git a/src/pcl/fast-init.lisp b/src/pcl/fast-init.lisp
index 4f23946..2d723e1 100644 (file)
--- a/src/pcl/fast-init.lisp
+++ b/src/pcl/fast-init.lisp
@@ -71,10 +71,10 @@
          ;; even if it hasn't been defined yet, the user doesn't get
          ;; obscure warnings about undefined internal implementation
          ;; functions like HAIRY-MAKE-instance-name.
-         (sb-kernel:become-defined-function-name sym)
+         (sb-kernel:become-defined-fun-name sym)
          `(,sym ',class (list ,@initargs)))))))
 
-(defmacro expanding-make-instance-top-level (&rest forms &environment env)
+(defmacro expanding-make-instance-toplevel (&rest forms &environment env)
   (let* ((*make-instance-function-keys* nil)
         (form (macroexpand `(expanding-make-instance ,@forms) env)))
     `(progn
@@ -95,12 +95,6 @@
                                      subform))))
               forms)))
 
-(defmacro defconstructor
-         (name class lambda-list &rest initialization-arguments)
-  `(expanding-make-instance-top-level
-    (defun ,name ,lambda-list
-      (make-instance ',class ,@initialization-arguments))))
-
 (defun get-make-instance-functions (key-list)
   (dolist (key key-list)
     (let* ((cell (find-class-cell (car key)))
@@ -178,7 +172,7 @@
                                     'initialize-info name)))
                 *initialize-info-cached-slots*)))
     `(progn
-       (defstruct initialize-info
+       (defstruct (initialize-info (:copier nil))
         key wrapper
         ,@(mapcar #'(lambda (name)
                       `(,name :unknown))
@@ -746,17 +740,18 @@
 
 (defmacro precompile-iis-functions (&optional system)
   `(progn
-    ,@(gathering1 (collecting)
-                  (dolist (iis-entry *initialize-instance-simple-alist*)
-                    (when (or (null (caddr iis-entry))
-                              (eq (caddr iis-entry) system))
-                      (when system (setf (caddr iis-entry) system))
-                      (gather1
-                       `(load-precompiled-iis-entry
-                         ',(car iis-entry)
-                         #',(car iis-entry)
-                         ',system
-                         ',(cdddr iis-entry))))))))
+    ,@(let (collect)
+        (dolist (iis-entry *initialize-instance-simple-alist*)
+          (when (or (null (caddr iis-entry))
+                    (eq (caddr iis-entry) system))
+            (when system (setf (caddr iis-entry) system))
+            (push `(load-precompiled-iis-entry
+                    ',(car iis-entry)
+                    #',(car iis-entry)
+                    ',system
+                    ',(cdddr iis-entry))
+                  collect)))
+        (nreverse collect))))
 
 (defun compile-iis-functions (after-p)
   (let ((*compile-make-instance-functions-p* t)