0.6.10:

[sbcl.git] / src / code / defstruct.lisp

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 62b9bd2..52880e8 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -11,9 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB!KERNEL")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; getting LAYOUTs
 
@@ -153,7 +150,7 @@
   (intern (string (dsd-%name dsd))
          (if (dsd-accessor dsd)
              (symbol-package (dsd-accessor dsd))
-             *package*)))
+             (sane-package))))
 \f
 ;;;; typed (non-class) structures
 
@@ -593,7 +590,7 @@
        spec))
 
     (when (find name (dd-slots defstruct) :test #'string= :key #'dsd-%name)
-      (error 'program-error
+      (error 'simple-program-error
             :format-control "duplicate slot name ~S"
             :format-arguments (list name)))
     (setf (dsd-%name islot) (string name))
@@ -1176,14 +1173,15 @@
 ;;; type declarations. Values are the values for the slots (in order.)
 ;;;
 ;;; This is split four ways because:
-;;; 1] list & vector structures need "name" symbols stuck in at various weird
-;;;    places, whereas STRUCTURE structures have a LAYOUT slot.
+;;; 1] list & vector structures need "name" symbols stuck in at
+;;;    various weird places, whereas STRUCTURE structures have
+;;;    a LAYOUT slot.
 ;;; 2] We really want to use LIST to make list structures, instead of
 ;;;    MAKE-LIST/(SETF ELT).
-;;; 3] STRUCTURE structures can have raw slots that must also be allocated and
-;;;    indirectly referenced. We use SLOT-ACCESSOR-FORM to compute how to set
-;;;    the slots, which deals with raw slots.
-;;; 4] funcallable structures are weird.
+;;; 3] STRUCTURE structures can have raw slots that must also be
+;;;    allocated and indirectly referenced. We use SLOT-ACCESSOR-FORM
+;;;    to compute how to set the slots, which deals with raw slots.
+;;; 4] Funcallable structures are weird.
 (defun create-vector-constructor
        (defstruct cons-name arglist vars types values)
   (let ((temp (gensym))
@@ -1230,10 +1228,10 @@
               (%delayed-get-compiler-layout ,(dd-name defstruct)))
         ,@(when n-raw-data
             `((setf (%instance-ref ,temp ,raw-index) ,n-raw-data)))
-        ,@(mapcar #'(lambda (dsd value)
-                      (multiple-value-bind (accessor index data)
-                          (slot-accessor-form defstruct dsd temp n-raw-data)
-                        `(setf (,accessor ,data ,index) ,value)))
+        ,@(mapcar (lambda (dsd value)
+                    (multiple-value-bind (accessor index data)
+                        (slot-accessor-form defstruct dsd temp n-raw-data)
+                      `(setf (,accessor ,data ,index) ,value)))
                   (dd-slots defstruct)
                   values)
         ,temp))))
@@ -1271,7 +1269,7 @@
             defstruct (dd-default-constructor defstruct)
             (arglist) (vals) (types) (vals))))
 
-;;; Given a structure and a BOA constructor spec, call Creator with
+;;; Given a structure and a BOA constructor spec, call CREATOR with
 ;;; the appropriate args to make a constructor.
 (defun create-boa-constructor (defstruct boa creator)
   (multiple-value-bind (req opt restp rest keyp keys allowp aux)