X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fbraid.lisp;h=5fcad4d80a07793f51a326ae04e1b34638420402;hb=284c8f6833589a6bddf22a5af30d3ac4eafcd2cc;hp=00b4adcbdb26c44fdd570935a66e5678d7b343d8;hpb=832f3b5652ae1b4a8888829cd4a1b391a8ca9952;p=sbcl.git diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 00b4adc..5fcad4d 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -276,6 +276,7 @@ (set-slot 'name name) (set-slot 'finalized-p t) (set-slot 'source source) + (set-slot 'safe-p nil) (set-slot '%type (if (eq class (find-class t)) t ;; FIXME: Could this just be CLASS instead @@ -308,7 +309,8 @@ structure-class condition-class slot-class)) (set-slot 'direct-slots direct-slots) - (set-slot 'slots slots)) + (set-slot 'slots slots) + (set-slot 'slot-vector (make-slot-vector slots))) ;; For all direct superclasses SUPER of CLASS, make sure CLASS is ;; a direct subclass of SUPER. Note that METACLASS-NAME doesn't @@ -369,6 +371,7 @@ (set-val 'writers (get-val :writers)) (set-val 'allocation :instance) (set-val '%type (or (get-val :type) t)) + (set-val '%type-check-function (get-val 'type-check-function)) (set-val '%documentation (or (get-val :documentation) "")) (set-val '%class class) (when effective-p @@ -425,8 +428,7 @@ (list class-name) (list class-name) "automatically generated boundp method"))) - (let ((gf (ensure-generic-function accessor-name - :lambda-list arglist))) + (let ((gf (ensure-generic-function accessor-name :lambda-list arglist))) (if (find specls (early-gf-methods gf) :key #'early-method-specializers :test 'equal) @@ -515,16 +517,12 @@ (cons name cpl) wrapper prototype)))))) -(defmacro wrapper-of-macro (x) - `(layout-of ,x)) - -(defun class-of (x) - (wrapper-class* (wrapper-of-macro x))) - -;;; FIXME: We probably don't need both WRAPPER-OF and WRAPPER-OF-MACRO. #-sb-fluid (declaim (inline wrapper-of)) (defun wrapper-of (x) - (wrapper-of-macro x)) + (layout-of x)) + +(defun class-of (x) + (wrapper-class* (wrapper-of x))) (defun eval-form (form) (lambda () (eval form))) @@ -589,6 +587,7 @@ (pushnew 'ensure-deffoo-class sb-kernel::*defstruct-hooks*) (pushnew 'ensure-deffoo-class sb-kernel::*define-condition-hooks*) +;;; FIXME: only needed during bootstrap (defun make-class-predicate (class name) (let* ((gf (ensure-generic-function name :lambda-list '(object))) (mlist (if (eq *boot-state* 'complete)