Re: Oh no! No #'slot-value-using-class?

[bill@cambridge.apple.com (Bill St. Clair)]

At 5:50 PM 5/18/95, Ken Tilton wrote:

>But 'slot-value-using-class seems necessary to this, since slot-value per
>se is a function.
>
>End of a dream? <g>

It's on the FTP server, but since it's small, I enclosed it below:

-------------------------------------------------------

; slot-value-using-class.lisp
;
; Slow and simple implementation of SLOT-VALUE-USING-CLASS and friends
; for MCL 2.0.
; This slows down all calls to SLOT-VALUE & friends and disables all
; optimization for DEFCLASS generated accessors.

(in-package :ccl)

(export '(slot-value-using-class slot-boundp-using-class 
          slot-exists-p-using-class))

(eval-when (:compile-toplevel :execute)
  (require "LISPEQU")                   ; for population-data
  )

(defvar *slot-value-using-class-inited* nil)

(unless *slot-value-using-class-inited*
  (setf (symbol-function 'std-slot-value) #'slot-value
        (symbol-function 'std-set-slot-value) #'set-slot-value
        (symbol-function 'std-slot-boundp) #'slot-boundp
        (symbol-function 'std-slot-exists-p) #'slot-exists-p
        (symbol-function 'std-slot-makunbound) #'slot-makunbound)
  ; This turns off optimization for DEFCLASS generated accessors
  (setq *standard-reader-method-class* nil
        *standard-writer-method-class* nil)
  (dolist (gf (population-data %all-gfs%))
    ; unoptimize existing accessors
    (compute-dcode gf))
  (setq *slot-value-using-class-inited* t))

(defmethod slot-value-using-class ((class t) instance slot-name)
  (std-slot-value instance slot-name))

(defmethod (setf slot-value-using-class) (value (class t) instance slot-name)
  (std-set-slot-value instance slot-name value))

(defmethod slot-boundp-using-class ((class t) instance slot-name)
  (std-slot-boundp instance slot-name))

(defmethod slot-exists-p-using-class ((class t) instance slot-name)
  (std-slot-exists-p instance slot-name))

(defmethod slot-makunbound-using-class ((class t) instance slot-name)
  (std-slot-makunbound instance slot-name))

(let ((*warn-if-redefine* nil)
      (*warn-if-redefine-kernel* nil))

(defun slot-value (instance slot-name)
  (slot-value-using-class (class-of instance) instance slot-name))

(defun set-slot-value (instance slot-name value)
  (setf (slot-value-using-class (class-of instance) instance slot-name)
        value))

(defun slot-boundp (instance slot-name)
  (slot-boundp-using-class (class-of instance) instance slot-name))

(defun slot-exists-p (instance slot-name)
  (slot-exists-p-using-class (class-of instance) instance slot-name))

(defun slot-makunbound (instance slot-name)
  (slot-makunbound-using-class (class-of instance) instance slot-name))