(let ((inherited (accessor-inherited-data name defstruct)))
(cond
((not inherited)
- (stuff `(proclaim '(inline ,name (setf ,name))))
+ (stuff `(declaim (inline ,name (setf ,name))))
;; FIXME: The arguments in the next two DEFUNs should
;; be gensyms. (Otherwise e.g. if NEW-VALUE happened to
;; be the name of a special variable, things could get
(dsd-index included-slot))
(dd-inherited-accessor-alist dd)
:test #'eq :key #'car))
- (parse-1-dsd dd
- modified
- (copy-structure included-slot)))))))
+ (let ((new-slot (parse-1-dsd dd
+ modified
+ (copy-structure included-slot))))
+ (when (and (neq (dsd-type new-slot) (dsd-type included-slot))
+ (not (subtypep (dsd-type included-slot)
+ (dsd-type new-slot)))
+ (dsd-safe-p included-slot))
+ (setf (dsd-safe-p new-slot) nil)
+ ;; XXX: notify?
+ )))))))
\f
;;;; various helper functions for setting up DEFSTRUCTs
(let ((predicate-name (dd-predicate-name dd)))
(when predicate-name
- (sb!xc:proclaim `(ftype (sfunction (t) t) ,predicate-name))
+ (sb!xc:proclaim `(ftype (sfunction (t) boolean) ,predicate-name))
;; Provide inline expansion (or not).
(ecase (dd-type dd)
((structure funcallable-structure)