;;;; warranty about the software, its performance or its conformity to any
;;;; specification.
-(sb-int:file-comment
- "$Header$")
-
(in-package "SB-PCL")
\f
(defmethod slot-accessor-function ((slotd effective-slot-definition) type)
(writer (setf (slot-definition-writer-function slotd) function))
(boundp (setf (slot-definition-boundp-function slotd) function))))
-(defconstant *slotd-reader-function-std-p* 1)
-(defconstant *slotd-writer-function-std-p* 2)
-(defconstant *slotd-boundp-function-std-p* 4)
-(defconstant *slotd-all-function-std-p* 7)
+(defconstant +slotd-reader-function-std-p+ 1)
+(defconstant +slotd-writer-function-std-p+ 2)
+(defconstant +slotd-boundp-function-std-p+ 4)
+(defconstant +slotd-all-function-std-p+ 7)
(defmethod slot-accessor-std-p ((slotd effective-slot-definition) type)
(let ((flags (slot-value slotd 'accessor-flags)))
(declare (type fixnum flags))
(if (eq type 'all)
- (eql *slotd-all-function-std-p* flags)
+ (eql +slotd-all-function-std-p+ flags)
(let ((mask (ecase type
- (reader *slotd-reader-function-std-p*)
- (writer *slotd-writer-function-std-p*)
- (boundp *slotd-boundp-function-std-p*))))
+ (reader +slotd-reader-function-std-p+)
+ (writer +slotd-writer-function-std-p+)
+ (boundp +slotd-boundp-function-std-p+))))
(declare (type fixnum mask))
(not (zerop (the fixnum (logand mask flags))))))))
(slotd effective-slot-definition)
type)
(let ((mask (ecase type
- (reader *slotd-reader-function-std-p*)
- (writer *slotd-writer-function-std-p*)
- (boundp *slotd-boundp-function-std-p*)))
+ (reader +slotd-reader-function-std-p+)
+ (writer +slotd-writer-function-std-p+)
+ (boundp +slotd-boundp-function-std-p+)))
(flags (slot-value slotd 'accessor-flags)))
(declare (type fixnum mask flags))
(setf (slot-value slotd 'accessor-flags)
class))
(defmethod class-predicate-name ((class t))
- 'function-returning-nil)
+ 'constantly-nil)
(defun ensure-class-values (class args)
(let* ((initargs (copy-list args))
(gather1 (cons (slot-definition-name dslotd)
(if initfunction
(funcall initfunction)
- *slot-unbound*))))))))
+ +slot-unbound+))))))))
(setq predicate-name (if predicate-name-p
(setf (slot-value class 'predicate-name)
(car predicate-name))
(defmethod shared-initialize :before ((class class) slot-names &key name)
(declare (ignore slot-names name))
+ ;; FIXME: Could this just be CLASS instead of `(CLASS ,CLASS)? If not,
+ ;; why not? (See also similar expression in !BOOTSTRAP-INITIALIZE-CLASS.)
(setf (slot-value class 'type) `(class ,class))
(setf (slot-value class 'class-eq-specializer)
(make-instance 'class-eq-specializer :class class)))
(:constructor ,constructor ()))
,@(mapcar #'(lambda (slot)
`(,(slot-definition-name slot)
- *slot-unbound*))
+ +slot-unbound+))
direct-slots)))
- (reader-names (mapcar #'(lambda (slotd)
- (intern (format nil "~A~A reader" conc-name
- (slot-definition-name slotd))))
+ (reader-names (mapcar (lambda (slotd)
+ (intern (format nil
+ "~A~A reader"
+ conc-name
+ (slot-definition-name
+ slotd))))
direct-slots))
- (writer-names (mapcar #'(lambda (slotd)
- (intern (format nil "~A~A writer" conc-name
- (slot-definition-name slotd))))
+ (writer-names (mapcar (lambda (slotd)
+ (intern (format nil
+ "~A~A writer"
+ conc-name
+ (slot-definition-name
+ slotd))))
direct-slots))
(readers-init
- (mapcar #'(lambda (slotd reader-name)
- (let ((accessor
- (slot-definition-defstruct-accessor-symbol slotd)))
- `(defun ,reader-name (obj)
- (declare (type ,name obj))
- (,accessor obj))))
+ (mapcar (lambda (slotd reader-name)
+ (let ((accessor
+ (slot-definition-defstruct-accessor-symbol
+ slotd)))
+ `(defun ,reader-name (obj)
+ (declare (type ,name obj))
+ (,accessor obj))))
direct-slots reader-names))
(writers-init
- (mapcar #'(lambda (slotd writer-name)
- (let ((accessor
- (slot-definition-defstruct-accessor-symbol slotd)))
- `(defun ,writer-name (nv obj)
- (declare (type ,name obj))
- (setf (,accessor obj) nv))))
+ (mapcar (lambda (slotd writer-name)
+ (let ((accessor
+ (slot-definition-defstruct-accessor-symbol
+ slotd)))
+ `(defun ,writer-name (nv obj)
+ (declare (type ,name obj))
+ (setf (,accessor obj) nv))))
direct-slots writer-names))
(defstruct-form
`(progn
(let* ((reader (gdefinition reader-name))
(writer (when (gboundp writer-name)
(gdefinition writer-name))))
- (setf (slot-value dslotd 'internal-reader-function) reader)
- (setf (slot-value dslotd 'internal-writer-function) writer)))
+ (setf (slot-value dslotd 'internal-reader-function)
+ reader)
+ (setf (slot-value dslotd 'internal-writer-function)
+ writer)))
direct-slots reader-names writer-names)
(setf (slot-value class 'defstruct-form) defstruct-form)
(setf (slot-value class 'defstruct-constructor) constructor))))
(format stream
"obsolete structure error in ~S:~@
for a structure of type: ~S"
- (sb-conditions::condition-function-name condition)
+ (sb-kernel::condition-function-name condition)
(type-of (obsolete-structure-datum condition))))))
(defun obsolete-instance-trap (owrapper nwrapper instance)
(setf (instance-ref nslots npos) (instance-ref oslots opos))
(progn
(push name discarded)
- (unless (eq (instance-ref oslots opos) *slot-unbound*)
+ (unless (eq (instance-ref oslots opos) +slot-unbound+)
(setf (getf plist name) (instance-ref oslots opos)))))))
;; Go through all the old shared slots.
(if npos
(setf (instance-ref nslots npos) (cdr oclass-slot-and-val))
(progn (push name discarded)
- (unless (eq val *slot-unbound*)
+ (unless (eq val +slot-unbound+)
(setf (getf plist name) val)))))))
;; Go through all the new local slots to compute the added slots.
projects / sbcl.git / blobdiff