- ;; above.
- (loop for (key initfn initform) in default-initargs do
- (unless (member key initkeys :test #'eq)
- (if (constantp initform)
- (dolist (location (initarg-locations key))
- (if (consp location)
- (class-init location 'constant initform)
- (instance-init location 'constant initform)))
- (dolist (location (initarg-locations key))
- (if (consp location)
- (class-init location 'initfn initfn)
- (instance-init location 'initfn initfn))))))
- ;;
+ ;; above. Default initargs which are not in the supplied
+ ;; initargs are treated as if they were appended to supplied
+ ;; initargs, that is, their values must be evaluated even
+ ;; if not actually used for initializing a slot.
+ (loop for (key initfn initform) in default-initargs and i from 0
+ unless (member key initkeys :test #'eq) do
+ (let* ((type (if (constantp initform) 'constant 'var))
+ (init (if (eq type 'var) initfn initform)))
+ (when (eq type 'var)
+ (let ((init-var (default-init-var-name i)))
+ (setq init init-var)
+ (push (cons init-var initfn) default-inits)))
+ (dolist (location (initarg-locations key))
+ (if (consp location)
+ (class-init location type init)
+ (instance-init location type init)))))