;;;; files for more information.
(in-package "SB!KERNEL")
-
-(file-comment
- "$Header$")
\f
;;;; getting LAYOUTs
(intern (string (dsd-%name dsd))
(if (dsd-accessor dsd)
(symbol-package (dsd-accessor dsd))
- *package*)))
+ (sane-package))))
\f
;;;; typed (non-class) structures
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))
;;; 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))
(%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))))
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)