Simplify (and robustify) regular PACKing

[sbcl.git] / src / pcl / braid.lisp

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index f4b6377..8f1ef7b 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -118,7 +118,7 @@
                  (let ((wr (format-symbol *pcl-package* "~A-WRAPPER" class)))
                    `(setf ,wr ,(if (eq class 'standard-generic-function)
                                    '*sgf-wrapper*
-                                   `(boot-make-wrapper
+                                   `(!boot-make-wrapper
                                      (early-class-size ',class)
                                      ',class))
                           ,class (allocate-standard-instance
@@ -199,7 +199,7 @@
                                   ((eq class standard-generic-function)
                                    standard-generic-function-wrapper)
                                   (t
-                                   (boot-make-wrapper (length slots) name))))
+                                   (!boot-make-wrapper (length slots) name))))
                    (proto nil))
               (when (eq name t) (setq *the-wrapper-of-t* wrapper))
               (set (make-class-symbol name) class)
@@ -386,8 +386,9 @@
       (set-val 'initform     (get-val :initform))
       (set-val 'initfunction (get-val :initfunction))
       (set-val 'initargs     (get-val :initargs))
-      (set-val 'readers      (get-val :readers))
-      (set-val 'writers      (get-val :writers))
+      (unless effective-p
+        (set-val 'readers      (get-val :readers))
+        (set-val 'writers      (get-val :writers)))
       (set-val 'allocation   :instance)
       (set-val '%type        (or (get-val :type) t))
       (set-val '%documentation (or (get-val :documentation) ""))
@@ -580,11 +581,9 @@
            :readers ,(condition-slot-readers slot)
            :writers ,(condition-slot-writers slot)
            ,@(when (condition-slot-initform-p slot)
-               (let ((form-or-fun (condition-slot-initform slot)))
-                 (if (functionp form-or-fun)
-                     `(:initfunction ,form-or-fun)
-                     `(:initform ,form-or-fun
-                       :initfunction ,(lambda () form-or-fun)))))
+               (let ((initform (condition-slot-initform slot))
+                     (initfun (condition-slot-initfunction slot)))
+                 `(:initform ',initform :initfunction ,initfun)))
            :allocation ,(condition-slot-allocation slot)
            :documentation ,(condition-slot-documentation slot))))
     (cond ((structure-type-p name)