- `(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)))))))
+ `(setf (clos-slots-ref .slots. ,i)
+ ',(constant-form-value 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 `',(constant-form-value 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))))))))