X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fclass.lisp;h=0733b25d40833e0eefa126fcb96b8e66bc1d428f;hb=422b88abf96f4842a3d0999cd3b80d96f5a153d6;hp=9ccf56bc3c0bb881bf58ec03284b7deacff03176;hpb=a10eba73462a7203914114f3a4bdac98c741ec08;p=sbcl.git diff --git a/src/code/class.lisp b/src/code/class.lisp index 9ccf56b..0733b25 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -29,7 +29,7 @@ #+sb-xc cl:class (:make-load-form-fun class-make-load-form-fun) (:include ctype - (:class-info (type-class-or-lose #-sb-xc 'sb!xc:class + (class-info (type-class-or-lose #-sb-xc 'sb!xc:class #+sb-xc 'cl:class))) (:constructor nil) #-no-ansi-print-object @@ -52,7 +52,7 @@ ;; that CL:CLASS-NAME is a generic function.) (%name nil :type symbol) ;; the current layout for this class, or NIL if none assigned yet - (layout nil :type (or sb!kernel::layout null)) + (layout nil :type (or layout null)) ;; How sure are we that this class won't be redefined? ;; :READ-ONLY = We are committed to not changing the effective ;; slots or superclasses. @@ -96,7 +96,7 @@ ;;; Note: This bound is set somewhat less than MOST-POSITIVE-FIXNUM ;;; in order to guarantee that several hash values can be added without ;;; overflowing into a bignum. -(defconstant layout-clos-hash-max (ash most-positive-fixnum -3) +(def!constant layout-clos-hash-max (ash most-positive-fixnum -3) #!+sb-doc "the inclusive upper bound on LAYOUT-CLOS-HASH values") @@ -207,7 +207,7 @@ ;; renamed because some of us find it confusing to call something ;; a depth when it isn't quite. (depthoid -1 :type layout-depthoid) - ;; The number of top-level descriptor cells in each instance. + ;; the number of top level descriptor cells in each instance (length 0 :type index) ;; If this layout has some kind of compiler meta-info, then this is ;; it. If a structure, then we store the DEFSTRUCT-DESCRIPTION here. @@ -233,7 +233,7 @@ ;;;; support for the hash values used by CLOS when working with LAYOUTs -(defconstant layout-clos-hash-length 8) +(def!constant layout-clos-hash-length 8) #!-sb-fluid (declaim (inline layout-clos-hash)) (defun layout-clos-hash (layout i) ;; FIXME: Either this I should be declared to be `(MOD @@ -394,8 +394,8 @@ (let ((old-length (layout-length old-layout))) (unless (= old-length length) (warn "change in instance length of class ~S:~% ~ - ~A length: ~D~% ~ - ~A length: ~D" + ~A length: ~W~% ~ + ~A length: ~W" name old-context old-length context length) @@ -441,7 +441,6 @@ (declaim (ftype (function (symbol index simple-vector layout-depthoid) layout) find-and-init-or-check-layout)) (defun find-and-init-or-check-layout (name length inherits depthoid) - (/show0 "entering FIND-AND-INIT-OR-CHECK-LAYOUT") (let ((layout (find-layout name))) (init-or-check-layout layout (or (sb!xc:find-class name nil) @@ -736,6 +735,10 @@ #-sb-xc (declare (type sb!xc:class new-value)) (ecase (info :type :kind name) ((nil)) + (:forthcoming-defclass-type + ;; XXX Currently, nothing needs to be done in this case. Later, when + ;; PCL is integrated tighter into SBCL, this might need more work. + nil) (:instance (let ((old (class-of (sb!xc:find-class name))) (new (class-of new-value))) @@ -1131,10 +1134,10 @@ generic-sequence collection)) (null :translation (member nil) - :inherits (list sequence + :inherits (symbol list sequence mutable-sequence mutable-collection - generic-sequence collection symbol) - :direct-superclasses (list symbol)) + generic-sequence collection) + :direct-superclasses (symbol list)) (generic-number :state :read-only) (number :translation number :inherits (generic-number)) (complex @@ -1182,8 +1185,8 @@ :translation integer :inherits (rational real number generic-number)) (fixnum - :translation (integer #.sb!vm:*target-most-negative-fixnum* - #.sb!vm:*target-most-positive-fixnum*) + :translation (integer #.sb!xc:most-negative-fixnum + #.sb!xc:most-positive-fixnum) :inherits (integer rational real number generic-number) :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag)) @@ -1228,7 +1231,7 @@ (if (eq name t) nil (mapcar #'sb!xc:find-class direct-superclasses))))) - (setf (info :type :kind name) :primitive + (setf (info :type :kind name) #+sb-xc-host :defined #-sb-xc-host :primitive (class-cell-class (find-class-cell name)) class) (unless trans-p (setf (info :type :builtin name) class))