;; default of WRAPPER-INVALID. Instead of trying
;; to find out, I just overrode the LAYOUT
;; default here. -- WHN 19991204
- (invalid nil))
- (:conc-name %wrapper-)
+ (invalid nil)
+ ;; This allows quick testing of wrapperness.
+ (for-std-class-p t))
(:constructor make-wrapper-internal)
(:copier nil))
(instance-slots-layout nil :type list)
(declare (special *boot-state* *the-class-standard-generic-function*))
(when (valid-function-name-p fun)
(setq fun (fdefinition fun)))
- (when (funcallable-instance-p fun)
- ;; HACK
- (case (classoid-name (classoid-of fun))
- (%method-function (setf (%method-function-name fun) new-name))
- (t ;; KLUDGE: probably a generic function...
- (if (if (eq *boot-state* 'complete)
- (typep fun 'generic-function)
- (eq (class-of fun) *the-class-standard-generic-function*))
- (setf (%funcallable-instance-info fun 2) new-name)
- (bug "unanticipated function type")))))
+ (typecase fun
+ (%method-function (setf (%method-function-name fun) new-name))
+ #+sb-eval
+ (sb-eval:interpreted-function
+ (setf (sb-eval:interpreted-function-name fun) new-name))
+ (funcallable-instance ;; KLUDGE: probably a generic function...
+ (cond ((if (eq *boot-state* 'complete)
+ (typep fun 'generic-function)
+ (eq (class-of fun) *the-class-standard-generic-function*))
+ (setf (%funcallable-instance-info fun 2) new-name))
+ (t
+ (bug "unanticipated function type")))))
;; Fixup name-to-function mappings in cases where the function
;; hasn't been defined by DEFUN. (FIXME: is this right? This logic
;; comes from CMUCL). -- CSR, 2004-12-31
(when (pcl-instance-p instance)
(get-slots instance)))
-(defmacro built-in-or-structure-wrapper (x) `(layout-of ,x))
-
(defmacro get-wrapper (inst)
(once-only ((wrapper `(wrapper-of ,inst)))
`(progn
;;; The definition of STRUCTURE-TYPE-P was moved to early-low.lisp.
-(defun get-structure-dd (type)
- (layout-info (classoid-layout (find-classoid type))))
-
(defun structure-type-included-type-name (type)
- (let ((include (dd-include (get-structure-dd type))))
+ (let ((include (dd-include (find-defstruct-description type))))
(if (consp include)
(car include)
include)))
(defun structure-type-slot-description-list (type)
(nthcdr (length (let ((include (structure-type-included-type-name type)))
(and include
- (dd-slots (get-structure-dd include)))))
- (dd-slots (get-structure-dd type))))
+ (dd-slots (find-defstruct-description include)))))
+ (dd-slots (find-defstruct-description type))))
(defun structure-slotd-name (slotd)
(dsd-name slotd))
(defun structure-slotd-writer-function (type slotd)
(if (dsd-read-only slotd)
- (let ((dd (get-structure-dd type)))
+ (let ((dd (find-defstruct-description type)))
(coerce (slot-setter-lambda-form dd slotd) 'function))
(fdefinition `(setf ,(dsd-accessor-name slotd)))))
:slot-names (fast-function name)
:boa-constructor %make-method-function
:superclass-name function
- :metaclass-name random-pcl-classoid
- :metaclass-constructor make-random-pcl-classoid
+ :metaclass-name static-classoid
+ :metaclass-constructor make-static-classoid
:dd-type funcallable-structure)
\f
;;; WITH-PCL-LOCK is used around some forms that were previously