- (loop for slot-entry across slot-vector and i from 0
- as (type value) = slot-entry collect
- (ecase type
- ((nil)
- (unless before-method-p
- `(setf (clos-slots-ref .slots. ,i) +slot-unbound+)))
- ((param var)
- `(setf (clos-slots-ref .slots. ,i) ,value))
- (initfn
- `(setf (clos-slots-ref .slots. ,i) (funcall ,value)))
- (initform/initfn
- (if before-method-p
- `(when (eq (clos-slots-ref .slots. ,i)
- +slot-unbound+)
- (setf (clos-slots-ref .slots. ,i)
- (funcall ,value)))
- `(setf (clos-slots-ref .slots. ,i)
- (funcall ,value))))
- (initform
- (if before-method-p
- `(when (eq (clos-slots-ref .slots. ,i)
- +slot-unbound+)
- (setf (clos-slots-ref .slots. ,i)
- ',(eval value)))
- `(setf (clos-slots-ref .slots. ,i)
- ',(eval value))))
- (constant
- `(setf (clos-slots-ref .slots. ,i) ',(eval value))))))
- (class-init-forms
- (loop for (location type value) in class-inits collect
- `(setf (cdr ',location)
- ,(ecase type
- (constant `',(eval value))
- ((param var) `,value)
- (initfn `(funcall ,value)))))))
- (multiple-value-bind (vars bindings)
- (loop for (var . initfn) in (nreverse default-inits)
- collect var into vars
- collect `(,var (funcall ,initfn)) into bindings
- finally (return (values vars bindings)))
- (values bindings vars (nreverse defaulting-initargs)
- `(,@(delete nil instance-init-forms)
- ,@class-init-forms)))))))
+ (loop for slot-entry across slot-vector and i from 0
+ as (type value) = slot-entry collect
+ (ecase type
+ ((nil)
+ (unless before-method-p
+ `(setf (clos-slots-ref .slots. ,i) +slot-unbound+)))
+ ((param var)
+ `(setf (clos-slots-ref .slots. ,i) ,value))
+ (initfn
+ `(setf (clos-slots-ref .slots. ,i) (funcall ,value)))
+ (initform/initfn
+ (if before-method-p
+ `(when (eq (clos-slots-ref .slots. ,i)
+ +slot-unbound+)
+ (setf (clos-slots-ref .slots. ,i)
+ (funcall ,value)))
+ `(setf (clos-slots-ref .slots. ,i)
+ (funcall ,value))))
+ (initform
+ (if before-method-p
+ `(when (eq (clos-slots-ref .slots. ,i)
+ +slot-unbound+)
+ (setf (clos-slots-ref .slots. ,i)
+ ',(eval value)))
+ `(setf (clos-slots-ref .slots. ,i)
+ ',(eval value))))
+ (constant
+ `(setf (clos-slots-ref .slots. ,i) ',(eval value)))))))
+ ;; we are not allowed to modify QUOTEd locations, so we can't
+ ;; generate code like (setf (cdr ',location) arg). Instead,
+ ;; we have to do (setf (cdr .L0.) arg) and arrange for .L0. to
+ ;; be bound to the location.
+ (multiple-value-bind (names locations class-init-forms)
+ (loop for (location type value) in class-inits
+ for i upfrom 0
+ for name = (location-var-name i)
+ collect name into names
+ collect location into locations
+ collect `(setf (cdr ,name)
+ ,(case type
+ (constant `',(eval value))
+ ((param var) `,value)
+ (initfn `(funcall ,value))))
+ into class-init-forms
+ finally (return (values names locations class-init-forms)))
+ (multiple-value-bind (vars bindings)
+ (loop for (var . initfn) in (nreverse default-inits)
+ collect var into vars
+ collect `(,var (funcall ,initfn)) into bindings
+ finally (return (values vars bindings)))
+ (values locations names
+ bindings vars
+ (nreverse defaulting-initargs)
+ `(,@(delete nil instance-init-forms)
+ ,@class-init-forms))))))))