- (ecase (dd-type dd)
- ((vector list funcallable-structure)
- ;; nothing extra to do in this case
- )
- ((structure)
- (let* ((name (dd-name dd))
- (class (sb!xc:find-class name)))
-
- (let ((copier (dd-copier dd)))
- (when copier
- (proclaim `(ftype (function (,name) ,name) ,copier))))
-
- (dolist (dsd (dd-slots dd))
- (let* ((accessor-name (dsd-accessor-name dsd)))
- (when accessor-name
- (multiple-value-bind (reader-designator writer-designator)
- (accessor-inline-expansion-designators dd dsd)
- (proclaim-as-defstruct-fun-name accessor-name)
- (setf (info :function
- :inline-expansion-designator
- accessor-name)
- reader-designator
- (info :function :inlinep accessor-name)
- :inline)
- (unless (dsd-read-only dsd)
- (proclaim-as-defstruct-fun-name `(setf ,accessor-name))
- (let ((setf-accessor-name `(setf ,accessor-name)))
- (setf (info :function
- :inline-expansion-designator
- setf-accessor-name)
- writer-designator
- (info :function :inlinep setf-accessor-name)
- :inline)))))))
-
- ;; FIXME: Couldn't this logic be merged into
- ;; PROCLAIM-AS-DEFSTRUCT-FUN-NAME?
- (when (boundp 'sb!c:*free-functions*) ; when compiling
- (let ((free-functions sb!c:*free-functions*))
- (dolist (slot (dd-slots dd))
- (let ((accessor-name (dsd-accessor-name slot)))
- (remhash accessor-name free-functions)
- (unless (dsd-read-only slot)
- (remhash `(setf ,accessor-name) free-functions))))
- (remhash (dd-predicate-name dd) free-functions)
- (remhash (dd-copier dd) free-functions))))))
+ (let* ((dd-name (dd-name dd))
+ (class (sb!xc:find-class dd-name)))
+
+ (let ((copier-name (dd-copier-name dd)))
+ (when copier-name
+ (sb!xc:proclaim `(ftype (function (,dd-name) ,dd-name) ,copier-name))))
+
+ (let ((predicate-name (dd-predicate-name dd)))
+ (when predicate-name
+ (sb!xc:proclaim `(ftype (function (t) t) ,predicate-name))))
+
+ (dolist (dsd (dd-slots dd))
+ (let* ((accessor-name (dsd-accessor-name dsd))
+ (dsd-type (dsd-type dsd)))
+ (when accessor-name
+ (multiple-value-bind (reader-designator writer-designator)
+ (accessor-inline-expansion-designators dd dsd)
+ (sb!xc:proclaim `(ftype (function (,dd-name) ,dsd-type)
+ ,accessor-name))
+ (setf (info :function
+ :inline-expansion-designator
+ accessor-name)
+ reader-designator
+ (info :function :inlinep accessor-name)
+ :inline)
+ (unless (dsd-read-only dsd)
+ (let ((setf-accessor-name `(setf ,accessor-name)))
+ (sb!xc:proclaim
+ `(ftype (function (,dsd-type ,dd-name) ,dsd-type)
+ ,setf-accessor-name))
+ (setf (info :function
+ :inline-expansion-designator
+ setf-accessor-name)
+ writer-designator
+ (info :function :inlinep setf-accessor-name)
+ :inline))))))))