0.6.11.37:

[sbcl.git] / src / code / class.lisp

diff --git a/src/code/class.lisp b/src/code/class.lisp
index f63e6b9..fda5bed 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -410,7 +410,7 @@
 (declaim (ftype (function (layout sb!xc:class index simple-vector layout-depthoid))
                check-layout))
 (defun check-layout (layout class length inherits depthoid)
-  (assert (eq (layout-class layout) class))
+  (aver (eq (layout-class layout) class))
   (when (redefine-layout-warning "current" layout
                                 "compile time" length inherits depthoid)
     ;; Classic CMU CL had more options here. There are several reasons
@@ -468,12 +468,12 @@
     ;; Attempting to register ourselves with a temporary undefined
     ;; class placeholder is almost certainly a programmer error. (I
     ;; should know, I did it.) -- WHN 19990927
-    (assert (not (undefined-class-p class)))
+    (aver (not (undefined-class-p class)))
 
     ;; This assertion dates from classic CMU CL. The rationale is
     ;; probably that calling REGISTER-LAYOUT more than once for the
     ;; same LAYOUT is almost certainly a programmer error.
-    (assert (not (eq class-layout layout)))
+    (aver (not (eq class-layout layout)))
 
     ;; Figure out what classes are affected by the change, and issue
     ;; appropriate warnings and invalidations.
@@ -667,11 +667,11 @@
 ;;; the two classes are equal, since there are EQ checks in those
 ;;; operations.
 (!define-type-method (sb!xc:class :simple-=) (type1 type2)
-  (assert (not (eq type1 type2)))
+  (aver (not (eq type1 type2)))
   (values nil t))
 
 (!define-type-method (sb!xc:class :simple-subtypep) (class1 class2)
-  (assert (not (eq class1 class2)))
+  (aver (not (eq class1 class2)))
   (let ((subclasses (class-subclasses class2)))
     (if (and subclasses (gethash class1 subclasses))
        (values t t)
@@ -995,6 +995,22 @@
                array sequence
                generic-string generic-vector generic-array mutable-sequence
                mutable-collection generic-sequence collection))
+    (list
+     :translation (or cons (member nil))
+     :inherits (sequence mutable-sequence mutable-collection
+               generic-sequence collection))
+    (cons
+     :codes (#.sb!vm:list-pointer-type)
+     :translation cons
+     :inherits (list sequence
+               mutable-sequence mutable-collection
+               generic-sequence collection))
+    (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))
     (complex
@@ -1034,28 +1050,6 @@
     (rational
      :translation rational
      :inherits (real number generic-number))
-
-    ;; FIXME: moved LIST, CONS, and NULL here to help with translation
-    ;; of RATIO now that sbcl-0.6.11.13 has real INTERSECTION-TYPE;
-    ;; but it would be tidier to move them further back, if possible,
-    ;; so that all the numeric types are in an uninterrupted sequence
-    (list
-     :translation (or cons (member nil))
-     :inherits (sequence mutable-sequence mutable-collection
-               generic-sequence collection))
-    (cons
-     :codes (#.sb!vm:list-pointer-type)
-     :translation cons
-     :inherits (list sequence
-               mutable-sequence mutable-collection
-               generic-sequence collection))
-    (null
-     :translation (member nil)
-     :inherits (list sequence
-               mutable-sequence mutable-collection
-               generic-sequence collection symbol)
-     :direct-superclasses (list symbol))
-
     (ratio
      :translation (and rational (not integer))
      :inherits (rational real number generic-number)
@@ -1098,15 +1092,15 @@
                                     '(t))))
        x
       (declare (ignore codes state translation))
-      (let ((inherits-list (if (eq name 't)
-                            ()
-                            (cons 't (reverse inherits))))
+      (let ((inherits-list (if (eq name t)
+                              ()
+                              (cons t (reverse inherits))))
            (class (make-built-in-class
                    :enumerable enumerable
                    :name name
                    :translation (if trans-p :initializing nil)
                    :direct-superclasses
-                   (if (eq name 't)
+                   (if (eq name t)
                      nil
                      (mapcar #'sb!xc:find-class direct-superclasses)))))
        (setf (info :type :kind name) :primitive