X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fenv.lisp;h=d074eb63fa8c3ca83ea29596f4112444c4480901;hb=2ef330d818799fe54587bdcb4c626b397ca15266;hp=d793f9a528c9928d7057198cc4f6d7c86f4a3c97;hpb=d1de626e8dcd1ab98ceedf818f055f64f3060a7b;p=sbcl.git diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp index d793f9a..d074eb6 100644 --- 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))))))