X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-type.lisp;h=6bc004ef62d06d79b4b6c2af12c8c4c6781344ab;hb=b2f0204834bd0c314d44942dd92475c15ffa8c89;hp=b338ad70907ba514600592ad04ad928053dad36f;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index b338ad7..6bc004e 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -221,10 +221,15 @@
   ;; specifier to win.
   (type (missing-arg) :type ctype))
 
-;;; The NAMED-TYPE is used to represent *, T and NIL. These types must
-;;; be super- or sub-types of all types, not just classes and * and
-;;; NIL aren't classes anyway, so it wouldn't make much sense to make
-;;; them built-in classes.
+;;; The NAMED-TYPE is used to represent *, T and NIL, the standard
+;;; special cases, as well as other special cases needed to
+;;; interpolate between regions of the type hierarchy, such as
+;;; INSTANCE (which corresponds to all those classes with slots which
+;;; are not funcallable), FUNCALLABLE-INSTANCE (those classes with
+;;; slots which are funcallable) and EXTENDED-SEQUUENCE (non-LIST
+;;; non-VECTOR classes which are also sequences).  These special cases
+;;; are the ones that aren't really discussed by Baker in his
+;;; "Decision Procedure for SUBTYPEP" paper.
 (defstruct (named-type (:include ctype
                                  (class-info (type-class-or-lose 'named)))
                        (:copier nil))
@@ -337,8 +342,13 @@
             (:copier nil))
   (pairs (missing-arg) :type list :read-only t))
 (defun make-character-set-type (&key pairs)
-  (aver (equal (mapcar #'car pairs)
-              (sort (mapcar #'car pairs) #'<)))
+  ; (aver (equal (mapcar #'car pairs)
+  ;              (sort (mapcar #'car pairs) #'<)))
+  ;; aver that the cars of the list elements are sorted into increasing order
+  (aver (or (null pairs)
+            (do ((p pairs (cdr p)))
+                ((null (cdr p)) t)
+              (when (> (caar p) (caadr p)) (return nil)))))
   (let ((pairs (let (result)
                 (do ((pairs pairs (cdr pairs)))
                     ((null pairs) (nreverse result))
@@ -525,11 +535,6 @@
            ((eq (info :type :kind spec) :instance)
             (find-classoid spec))
            ((typep spec 'classoid)
-            ;; There doesn't seem to be any way to translate
-            ;; (TYPEP SPEC 'BUILT-IN-CLASS) into something which can be
-            ;; executed on the host Common Lisp at cross-compilation time.
-            #+sb-xc-host (error
-                          "stub: (TYPEP SPEC 'BUILT-IN-CLASS) on xc host")
             (if (typep spec 'built-in-classoid)
                 (or (built-in-classoid-translation spec) spec)
                 spec))