(in-package "SB-PCL")
\f
-(defmacro slot-symbol (slot-name type)
- `(if (and (symbolp ,slot-name) (symbol-package ,slot-name))
- (or (get ,slot-name ',(ecase type
- (reader 'reader-symbol)
- (writer 'writer-symbol)
- (boundp 'boundp-symbol)))
- (intern (format nil "~A ~A slot ~A"
- (package-name (symbol-package ,slot-name))
- (symbol-name ,slot-name)
- ,(symbol-name type))
- *slot-accessor-name-package*))
- (progn
- (error "Non-symbol and non-interned symbol slot name accessors~
- are not yet implemented.")
- ;;(make-symbol (format nil "~A ~A" ,slot-name ,type))
- )))
-
-(defun slot-reader-symbol (slot-name)
- (slot-symbol slot-name reader))
-
-(defun slot-writer-symbol (slot-name)
- (slot-symbol slot-name writer))
-
-(defun slot-boundp-symbol (slot-name)
- (slot-symbol slot-name boundp))
-
(defmacro asv-funcall (sym slot-name type &rest args)
(declare (ignore type))
`(if (fboundp ',sym)
`(,name ,(class-name class) ,(slot-definition-name slotd)))))
(defun make-internal-reader-method-function (class-name slot-name)
- (list* ':method-spec `(internal-reader-method ,class-name ,slot-name)
+ (list* :method-spec `(internal-reader-method ,class-name ,slot-name)
(make-method-function
(lambda (instance)
(let ((wrapper (get-instance-wrapper-or-nil instance)))
(instance-read-internal
.pv. instance-slots 1
(slot-value instance slot-name))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(reader-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(reader-method ,class-name ,slot-name)
initargs)))
(defun make-std-writer-method-function (class-name slot-name)
(instance-write-internal
.pv. instance-slots 1 nv
(setf (slot-value instance slot-name) nv))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list nil (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(writer-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(writer-method ,class-name ,slot-name)
initargs)))
(defun make-std-boundp-method-function (class-name slot-name)
(instance-boundp-internal
.pv. instance-slots 1
(slot-boundp instance slot-name))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(boundp-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(boundp-method ,class-name ,slot-name)
initargs)))
(defun initialize-internal-slot-gfs (slot-name &optional type)