0.8.0.8:

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

diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp
index d793f9a..d074eb6 100644 (file)
--- a/src/pcl/env.lisp
+++ b/src/pcl/env.lisp
@@ -158,7 +158,14 @@
                          (eq :instance (slot-definition-allocation slot))))
             (if (slot-boundp-using-class class object slot)
                 (let ((value (slot-value-using-class class object slot)))
-                  (inits `(setf (slot-value ,object ',slot-name) ',value)))
+                 (if (typep object 'structure-object)
+                     ;; low-level but less noisy initializer form
+                     (let* ((dd (get-structure-dd (class-name class)))
+                            (dsd (find slot-name (dd-slots dd)
+                                       :key #'dsd-name)))
+                       (inits `(,(slot-setter-lambda-form dd dsd)
+                                ',value ,object)))
+                     (inits `(setf (slot-value ,object ',slot-name) ',value))))
                 (inits `(slot-makunbound ,object ',slot-name))))))
       (values `(allocate-instance (find-class ',(class-name class)))
               `(progn ,@(inits))))))