0.7.8.8:
[sbcl.git] / src / code / class.lisp
index 4abd970..7d9b77d 100644 (file)
@@ -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")
 
 \f
 ;;;; 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
        (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)
   #-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)))
       :inherits (function)
       :state :read-only)
 
-     ;; FIXME: Are COLLECTION and MUTABLE-COLLECTION used for anything
-     ;; any more? COLLECTION is not defined in ANSI Common Lisp..
-     (collection :hierarchical-p nil :state :read-only)
-     (mutable-collection :state :read-only
-                        :inherits (collection))
-     (generic-sequence :state :read-only
-                      :inherits (collection))
-     (mutable-sequence :state :read-only
-                      :direct-superclasses (mutable-collection
-                                            generic-sequence)
-                      :inherits (mutable-collection
-                                 generic-sequence
-                                 collection))
-     (generic-array :state :read-only
-                   :inherits (mutable-sequence
-                              mutable-collection
-                              generic-sequence
-                              collection))
-     (generic-vector :state :read-only
-                    :inherits (generic-array
-                               mutable-sequence mutable-collection
-                               generic-sequence collection))
      (array :translation array :codes (#.sb!vm:complex-array-widetag)
-           :inherits (generic-array mutable-sequence mutable-collection
-                                    generic-sequence collection))
+            :hierarchical-p nil)
      (simple-array
       :translation simple-array :codes (#.sb!vm:simple-array-widetag)
-      :inherits (array generic-array mutable-sequence mutable-collection
-                generic-sequence collection))
+      :inherits (array))
      (sequence
-      :translation (or cons (member nil) vector)
-      :inherits (mutable-sequence mutable-collection generic-sequence
-                collection))
+      :translation (or cons (member nil) vector))
      (vector
       :translation vector :codes (#.sb!vm:complex-vector-widetag)
-      :direct-superclasses (array sequence generic-vector)
-      :inherits (array sequence generic-vector generic-array
-                mutable-sequence mutable-collection generic-sequence
-                collection))
+      :direct-superclasses (array sequence)
+      :inherits (array sequence))
      (simple-vector
       :translation simple-vector :codes (#.sb!vm:simple-vector-widetag)
       :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array
-                sequence generic-vector generic-array
-                mutable-sequence mutable-collection
-                generic-sequence collection))
+      :inherits (vector simple-array array sequence))
      (bit-vector
       :translation bit-vector :codes (#.sb!vm:complex-bit-vector-widetag)
-      :inherits (vector array sequence
-                generic-vector generic-array mutable-sequence
-                mutable-collection generic-sequence collection))
+      :inherits (vector array sequence))
      (simple-bit-vector
       :translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-widetag)
       :direct-superclasses (bit-vector simple-array)
       :inherits (bit-vector vector simple-array
-                array sequence
-                generic-vector generic-array mutable-sequence
-                mutable-collection generic-sequence collection))
+                array sequence))
      (simple-array-unsigned-byte-2
       :translation (simple-array (unsigned-byte 2) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-2-widetag)
       :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array sequence
-                generic-vector generic-array mutable-sequence
-                mutable-collection generic-sequence collection))
+      :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-4
       :translation (simple-array (unsigned-byte 4) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-4-widetag)
       :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array sequence
-                generic-vector generic-array mutable-sequence
-                mutable-collection generic-sequence collection))
+      :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-8
       :translation (simple-array (unsigned-byte 8) (*))
       :codes (#.sb!vm:simple-array-unsigned-byte-8-widetag)
       :direct-superclasses (vector simple-array)
-      :inherits (vector simple-array array sequence
-                generic-vector generic-array mutable-sequence
-                mutable-collection generic-sequence collection))
+      :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-16
      :translation (simple-array (unsigned-byte 16) (*))
      :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-32
      :translation (simple-array (unsigned-byte 32) (*))
      :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-8
      :translation (simple-array (signed-byte 8) (*))
      :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-16
      :translation (simple-array (signed-byte 16) (*))
      :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-30
      :translation (simple-array (signed-byte 30) (*))
      :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-32
      :translation (simple-array (signed-byte 32) (*))
      :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-single-float
      :translation (simple-array single-float (*))
      :codes (#.sb!vm:simple-array-single-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
      (simple-array-double-float
      :translation (simple-array double-float (*))
      :codes (#.sb!vm:simple-array-double-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
     #!+long-float
     (simple-array-long-float
      :translation (simple-array long-float (*))
      :codes (#.sb!vm:simple-array-long-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
     (simple-array-complex-single-float
      :translation (simple-array (complex single-float) (*))
      :codes (#.sb!vm:simple-array-complex-single-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
     (simple-array-complex-double-float
      :translation (simple-array (complex double-float) (*))
      :codes (#.sb!vm:simple-array-complex-double-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+     :inherits (vector simple-array array sequence))
     #!+long-float
     (simple-array-complex-long-float
      :translation (simple-array (complex long-float) (*))
      :codes (#.sb!vm:simple-array-complex-long-float-widetag)
      :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence
-               generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
-    (generic-string
-     :state :read-only
-     :inherits (mutable-sequence mutable-collection generic-sequence
-               collection))
+     :inherits (vector simple-array array sequence))
     (string
      :translation string
      :codes (#.sb!vm:complex-string-widetag)
-     :direct-superclasses (vector generic-string)
-     :inherits (vector array sequence
-               generic-vector generic-array generic-string
-               mutable-sequence mutable-collection
-               generic-sequence collection))
+     :direct-superclasses (vector)
+     :inherits (vector array sequence))
     (simple-string
      :translation simple-string
      :codes (#.sb!vm:simple-string-widetag)
      :direct-superclasses (string simple-array)
      :inherits (string vector simple-array
-               array sequence
-               generic-string generic-vector generic-array mutable-sequence
-               mutable-collection generic-sequence collection))
+               array sequence))
     (list
      :translation (or cons (member nil))
-     :inherits (sequence mutable-sequence mutable-collection
-               generic-sequence collection))
+     :inherits (sequence))
     (cons
      :codes (#.sb!vm:list-pointer-lowtag)
      :translation cons
-     :inherits (list sequence
-               mutable-sequence mutable-collection
-               generic-sequence collection))
+     :inherits (list sequence))
     (null
      :translation (member nil)
-     :inherits (list sequence
-               mutable-sequence mutable-collection
-               generic-sequence collection symbol)
-     :direct-superclasses (list symbol))
-    (generic-number :state :read-only)
-    (number :translation number :inherits (generic-number))
+     :inherits (symbol list sequence)
+     :direct-superclasses (symbol list))
+    (number :translation number)
     (complex
      :translation complex
-     :inherits (number generic-number)
+     :inherits (number)
      :codes (#.sb!vm:complex-widetag))
     (complex-single-float
      :translation (complex single-float)
-     :inherits (complex number generic-number)
+     :inherits (complex number)
      :codes (#.sb!vm:complex-single-float-widetag))
     (complex-double-float
      :translation (complex double-float)
-     :inherits (complex number generic-number)
+     :inherits (complex number)
      :codes (#.sb!vm:complex-double-float-widetag))
     #!+long-float
     (complex-long-float
      :translation (complex long-float)
-     :inherits (complex number generic-number)
+     :inherits (complex number)
      :codes (#.sb!vm:complex-long-float-widetag))
-    (real :translation real :inherits (number generic-number))
+    (real :translation real :inherits (number))
     (float
      :translation float
-     :inherits (real number generic-number))
+     :inherits (real number))
     (single-float
      :translation single-float
-     :inherits (float real number generic-number)
+     :inherits (float real number)
      :codes (#.sb!vm:single-float-widetag))
     (double-float
      :translation double-float
-     :inherits (float real number generic-number)
+     :inherits (float real number)
      :codes (#.sb!vm:double-float-widetag))
     #!+long-float
     (long-float
      :translation long-float
-     :inherits (float real number generic-number)
+     :inherits (float real number)
      :codes (#.sb!vm:long-float-widetag))
     (rational
      :translation rational
-     :inherits (real number generic-number))
+     :inherits (real number))
     (ratio
      :translation (and rational (not integer))
-     :inherits (rational real number generic-number)
+     :inherits (rational real number)
      :codes (#.sb!vm:ratio-widetag))
     (integer
      :translation integer
-     :inherits (rational real number generic-number))
+     :inherits (rational real number))
     (fixnum
-     :translation (integer #.sb!vm:*target-most-negative-fixnum*
-                          #.sb!vm:*target-most-positive-fixnum*)
-     :inherits (integer rational real number
-               generic-number)
+     :translation (integer #.sb!xc:most-negative-fixnum
+                          #.sb!xc:most-positive-fixnum)
+     :inherits (integer rational real number)
      :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag))
     (bignum
      :translation (and integer (not fixnum))
-     :inherits (integer rational real number
-               generic-number)
+     :inherits (integer rational real number)
      :codes (#.sb!vm:bignum-widetag))
     (stream
      :state :read-only
                    (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))
           (inherits-list (second x))
           (class (make-standard-class :name name))
           (class-cell (find-class-cell name)))
+      ;; Needed to open-code the MAP, below
+      (declare (type list inherits-list))
       (setf (class-cell-class class-cell) class
            (info :type :class name) class-cell
            (info :type :kind name) :instance)