(!fix-early-generic-functions)
(!fix-ensure-accessor-specializers)
(compute-standard-slot-locations)
-(dolist (s '(condition structure-object))
- (dohash (k v (classoid-subclasses (find-classoid s)))
+(dolist (s '(condition function structure-object))
+ (dohash ((k v) (classoid-subclasses (find-classoid s)))
(find-class (classoid-name k))))
-(setq *boot-state* 'complete)
+(setq **boot-state** 'complete)
(defun print-std-instance (instance stream depth)
(declare (ignore depth))
(print-object instance stream))
-;;; Access the slot-vector created by MAKE-SLOT-VECTOR.
-(defun find-slot-definition (class slot-name)
- (declare (symbol slot-name) (inline getf))
- (let* ((vector (class-slot-vector class))
- (index (rem (sxhash slot-name) (length vector))))
- (declare (simple-vector vector) (index index))
- (do ((plist (svref vector index) (cdr plist)))
- ((not plist))
- (let ((key (car plist)))
- (setf plist (cdr plist))
- (when (eq key slot-name)
- (return (car plist)))))))
+(setf (compiler-macro-function 'slot-value) nil)
+(setf (compiler-macro-function 'set-slot-value) nil)
+
+(in-package "SB-C")
+
+(defknown slot-value (t symbol) t (any))
+(defknown (slot-boundp slot-exists-p) (t symbol) boolean)
+(defknown sb-pcl::set-slot-value (t symbol t) t (any))
+
+(defknown find-class (symbol &optional t lexenv-designator)
+ (or class null))
+(defknown class-of (t) class (flushable))
+(defknown class-name (class) symbol (flushable))
+
+(deftransform slot-value ((object slot-name) (t (constant-arg symbol)) *
+ :node node)
+ (let ((c-slot-name (lvar-value slot-name)))
+ (if (sb-pcl::interned-symbol-p c-slot-name)
+ (let* ((type (lvar-type object))
+ (dd (when (structure-classoid-p type)
+ (find-defstruct-description
+ (sb-kernel::structure-classoid-name type))))
+ (dsd (when dd
+ (find c-slot-name (dd-slots dd) :key #'dsd-name))))
+ (cond (dsd
+ `(,(dsd-accessor-name dsd) object))
+ (t
+ (delay-ir1-transform node :constraint)
+ `(sb-pcl::accessor-slot-value object ',c-slot-name))))
+ (give-up-ir1-transform "slot name is not an interned symbol"))))
+
+(deftransform sb-pcl::set-slot-value ((object slot-name new-value)
+ (t (constant-arg symbol) t)
+ * :node node)
+ (let ((c-slot-name (lvar-value slot-name)))
+ (if (sb-pcl::interned-symbol-p c-slot-name)
+ (let* ((type (lvar-type object))
+ (dd (when (structure-classoid-p type)
+ (find-defstruct-description
+ (sb-kernel::structure-classoid-name type))))
+ (dsd (when dd
+ (find c-slot-name (dd-slots dd) :key #'dsd-name))))
+ (cond (dsd
+ `(setf (,(dsd-accessor-name dsd) object) new-value))
+ ((policy node (= safety 3))
+ ;; Safe code wants to check the type, and the global
+ ;; accessor won't do that. Also see the comment in the
+ ;; compiler-macro.
+ (give-up-ir1-transform "cannot use optimized accessor in safe code"))
+ (t
+ (delay-ir1-transform node :constraint)
+ `(sb-pcl::accessor-set-slot-value object ',c-slot-name new-value))))
+ (give-up-ir1-transform "slot name is not an interned symbol"))))