0.9.2.43:
[sbcl.git] / src / code / cross-type.lisp
index 47fc196..c68b2ce 100644 (file)
 ;;; works.)
 (define-condition cross-type-style-warning (style-warning)
   ((call :initarg :call
-        :reader cross-type-style-warning-call)
+         :reader cross-type-style-warning-call)
    (message :reader cross-type-style-warning-message
-           #+cmu :initarg #+cmu :message ; (to stop bogus non-STYLE WARNING)
-           ))
+            #+cmu :initarg #+cmu :message ; (to stop bogus non-STYLE WARNING)
+            ))
   (:report (lambda (c s)
-            (format
-             s
-             "cross-compilation-time type ambiguity (should be OK) in ~S:~%~A"
-             (cross-type-style-warning-call c)
-             (cross-type-style-warning-message c)))))
+             (format
+              s
+              "cross-compilation-time type ambiguity (should be OK) in ~S:~%~A"
+              (cross-type-style-warning-call c)
+              (cross-type-style-warning-message c)))))
 
 ;;; This warning is issued when giving up on a type calculation where a
 ;;; conservative answer is acceptable. Since a conservative answer is
@@ -38,8 +38,8 @@
 (define-condition cross-type-giving-up-conservatively
     (cross-type-style-warning)
   ((message :initform "giving up conservatively"
-           #+cmu :reader #+cmu #.(gensym) ; (to stop bogus non-STYLE WARNING)
-           )))
+            #+cmu :reader #+cmu #.(gensym) ; (to stop bogus non-STYLE WARNING)
+            )))
 
 ;;; This warning refers to the flexibility in the ANSI spec with
 ;;; regard to run-time distinctions between floating point types.
 ;;; situation will get a lot more complicated.
 (defun warn-possible-cross-type-float-info-loss (call)
   (when (or (subtypep 'single-float 'double-float)
-           (subtypep 'double-float 'single-float))
+            (subtypep 'double-float 'single-float))
     (warn "possible floating point information loss in ~S" call)))
 
 (defun sb!xc:type-of (object)
   (let ((raw-result (type-of object)))
     (cond ((or (subtypep raw-result 'float)
-              (subtypep raw-result 'complex))
-          (warn-possible-cross-type-float-info-loss
-           `(sb!xc:type-of ,object))
-          raw-result)
-         ((subtypep raw-result 'integer)
-          (cond ((<= 0 object 1)
-                 'bit)
-                (;; We can't rely on the host's opinion of whether
-                 ;; it's a FIXNUM, but instead test against target
-                 ;; MOST-fooITIVE-FIXNUM limits.
-                 (fixnump object)
-                 'fixnum)
-                (t
-                 'integer)))
+               (subtypep raw-result 'complex))
+           (warn-possible-cross-type-float-info-loss
+            `(sb!xc:type-of ,object))
+           raw-result)
+          ((subtypep raw-result 'integer)
+           (cond ((<= 0 object 1)
+                  'bit)
+                 (;; We can't rely on the host's opinion of whether
+                  ;; it's a FIXNUM, but instead test against target
+                  ;; MOST-fooITIVE-FIXNUM limits.
+                  (fixnump object)
+                  'fixnum)
+                 (t
+                  'integer)))
           ((subtypep raw-result 'simple-string)
            `(simple-base-string ,(length object)))
           ((subtypep raw-result 'string) 'base-string)
-         ((some (lambda (type) (subtypep raw-result type))
-                '(array character list symbol))
-          raw-result)
-         (t
-          (error "can't handle TYPE-OF ~S in cross-compilation" object)))))
+          ((some (lambda (type) (subtypep raw-result type))
+                 '(array character list symbol))
+           raw-result)
+          (t
+           (error "can't handle TYPE-OF ~S in cross-compilation" object)))))
 
 ;;; Is SYMBOL in the CL package? Note that we're testing this on the
 ;;; cross-compilation host, which could do things any old way. In
 (defun cross-typep (host-object raw-target-type)
   (let ((target-type (type-expand raw-target-type)))
     (flet ((warn-and-give-up ()
-          ;; We don't have to keep track of this as long as system
-          ;; performance is acceptable, since giving up
-          ;; conservatively is a safe way out.
-          #+nil
-          (warn 'cross-type-giving-up-conservatively
-                :call `(cross-typep ,host-object ,raw-target-type))
-          (values nil nil))
-          (warn-about-possible-float-info-loss ()
-            (warn-possible-cross-type-float-info-loss
-              `(cross-typep ,host-object ,raw-target-type)))
-          ;; a convenient idiom for making more matches to special cases:
-          ;; Test both forms of target type for membership in LIST.
-          ;;
-          ;; (In order to avoid having to use too much deep knowledge
-          ;; of types, it's sometimes convenient to test RAW-TARGET-TYPE
-          ;; as well as the expanded type, since we can get matches with
-          ;; just EQL. E.g. SIMPLE-STRING can be matched with EQL, while
-          ;; safely matching its expansion,
-          ;;  (OR (SIMPLE-ARRAY CHARACTER (*)) (SIMPLE-BASE-STRING *))
-          ;; would require logic clever enough to know that, e.g., OR is
-          ;; commutative.)
-          (target-type-is-in (list)
-            (or (member raw-target-type list)
-                (member target-type list))))
+           ;; We don't have to keep track of this as long as system
+           ;; performance is acceptable, since giving up
+           ;; conservatively is a safe way out.
+           #+nil
+           (warn 'cross-type-giving-up-conservatively
+                 :call `(cross-typep ,host-object ,raw-target-type))
+           (values nil nil))
+           (warn-about-possible-float-info-loss ()
+             (warn-possible-cross-type-float-info-loss
+               `(cross-typep ,host-object ,raw-target-type)))
+           ;; a convenient idiom for making more matches to special cases:
+           ;; Test both forms of target type for membership in LIST.
+           ;;
+           ;; (In order to avoid having to use too much deep knowledge
+           ;; of types, it's sometimes convenient to test RAW-TARGET-TYPE
+           ;; as well as the expanded type, since we can get matches with
+           ;; just EQL. E.g. SIMPLE-STRING can be matched with EQL, while
+           ;; safely matching its expansion,
+           ;;  (OR (SIMPLE-ARRAY CHARACTER (*)) (SIMPLE-BASE-STRING *))
+           ;; would require logic clever enough to know that, e.g., OR is
+           ;; commutative.)
+           (target-type-is-in (list)
+             (or (member raw-target-type list)
+                 (member target-type list))))
       (cond (;; Handle various SBCL-specific types which can't exist on
-            ;; the ANSI cross-compilation host. KLUDGE: This code will
-            ;; need to be tweaked by hand if the names of these types
-            ;; ever change, ugh!
-            (if (consp target-type)
-                (member (car target-type)
-                        '(sb!alien:alien))
-                (member target-type
-                        '(system-area-pointer
-                          funcallable-instance
-                          sb!alien-internals:alien-value)))
-            (values nil t))
-           (;; special case when TARGET-TYPE isn't a type spec, but
-            ;; instead a CLASS object.
-            (typep target-type 'class)
-            (bug "We don't support CROSS-TYPEP of CLASS type specifiers"))
-           ((and (symbolp target-type)
-                 (find-classoid target-type nil)
-                 (sb!xc:subtypep target-type 'cl:structure-object)
-                 (typep host-object '(or symbol number list character)))
-            (values nil t))
-           ((and (symbolp target-type)
-                 (find-class target-type nil)
-                 (subtypep target-type 'sb!kernel::structure!object))
-            (values (typep host-object target-type) t))
-           (;; easy cases of arrays and vectors
-            (target-type-is-in
-             '(array simple-string simple-vector string vector))
-            (values (typep host-object target-type) t))
-           (;; general cases of vectors
-            (and (not (unknown-type-p (values-specifier-type target-type)))
-                 (sb!xc:subtypep target-type 'cl:vector))
-            (if (vectorp host-object)
-                (warn-and-give-up) ; general-case vectors being way too hard
-                (values nil t))) ; but "obviously not a vector" being easy
-           (;; general cases of arrays
-            (and (not (unknown-type-p (values-specifier-type target-type)))
-                 (sb!xc:subtypep target-type 'cl:array))
-            (if (arrayp host-object)
-                (warn-and-give-up) ; general-case arrays being way too hard
-                (values nil t))) ; but "obviously not an array" being easy
-           ((target-type-is-in '(*))
-            ;; KLUDGE: SBCL has * as an explicit wild type. While
-            ;; this is sort of logical (because (e.g. (ARRAY * 1)) is
-            ;; a valid type) it's not ANSI: looking at the ANSI
-            ;; definitions of complex types like like ARRAY shows
-            ;; that they consider * different from other type names.
-            ;; Someday we should probably get rid of this non-ANSIism
-            ;; in base SBCL, but until we do, we might as well here
-            ;; in the cross compiler. And in order to make sure that
-            ;; we don't continue doing it after we someday patch
-            ;; SBCL's type system so that * is no longer a type, we
-            ;; make this assertion. -- WHN 2001-08-08
-            (aver (typep (values-specifier-type '*) 'named-type))
-            (values t t))
-           (;; Many simple types are guaranteed to correspond exactly
-            ;; between any host ANSI Common Lisp and the target
-            ;; Common Lisp. (Some array types are too, but they
-            ;; were picked off earlier.)
-            (target-type-is-in
-             '(atom bit character complex cons float function integer keyword
-               list nil null number rational real signed-byte symbol t
-               unsigned-byte))
-            (values (typep host-object target-type) t))
-           (;; Floating point types are guaranteed to correspond,
-            ;; too, but less exactly.
-            (target-type-is-in
-             '(single-float double-float))
-            (cond ((floatp host-object)
-                   (warn-about-possible-float-info-loss)
-                   (values (typep host-object target-type) t))
-                  (t
-                   (values nil t))))
-           (;; Complexes suffer the same kind of problems as arrays
-            (and (not (unknown-type-p (values-specifier-type target-type)))
-                 (sb!xc:subtypep target-type 'cl:complex))
-            (if (complexp host-object)
-                (warn-and-give-up) ; general-case complexes being way too hard
-                (values nil t))) ; but "obviously not a complex" being easy
-           ;; Some types require translation between the cross-compilation
-           ;; host Common Lisp and the target SBCL.
-           ((target-type-is-in '(classoid))
-            (values (typep host-object 'classoid) t))
-           ((target-type-is-in '(fixnum))
-            (values (fixnump host-object) t))
-           ;; Some types are too hard to handle in the positive
-           ;; case, but at least we can be confident in a large
-           ;; fraction of the negative cases..
-           ((target-type-is-in
-             '(base-string simple-base-string simple-string))
-            (if (stringp host-object)
-                (warn-and-give-up)
-                (values nil t)))
-           ((target-type-is-in '(character base-char))
-            (cond ((typep host-object 'standard-char)
-                   (values t t))
-                  ((not (characterp host-object))
-                   (values nil t))
-                  (t
-                   (warn-and-give-up))))
-           ((target-type-is-in '(stream instance))
-            ;; Neither target CL:STREAM nor target SB!KERNEL:INSTANCE
-            ;; is implemented as a STRUCTURE-OBJECT, so they'll fall
-            ;; through the tests above. We don't want to assume too
-            ;; much about them here, but at least we know enough
-            ;; about them to say that neither T nor NIL nor indeed
-            ;; any other symbol in the cross-compilation host is one.
-            ;; That knowledge suffices to answer so many of the
-            ;; questions that the cross-compiler asks that it's well
-            ;; worth special-casing it here.
-            (if (symbolp host-object)
-                (values nil t)
-                (warn-and-give-up)))
-           ;; various hacks for composite types..
-           ((consp target-type)
-            (let ((first (first target-type))
-                  (rest (rest target-type)))
-              (case first
-                ;; Many complex types are guaranteed to correspond exactly
-                ;; between any host ANSI Common Lisp and the target SBCL.
-                ((integer member mod rational real signed-byte unsigned-byte)
-                 (values (typep host-object target-type) t))
-                ;; Floating point types are guaranteed to correspond,
-                ;; too, but less exactly.
-                ((single-float double-float)
-                 (cond ((floatp host-object)
-                        (warn-about-possible-float-info-loss)
-                        (values (typep host-object target-type) t))
-                       (t
-                        (values nil t))))
-                ;; Some complex types have translations that are less
-                ;; trivial.
-                (and (every/type #'cross-typep host-object rest))
-                (or  (any/type   #'cross-typep host-object rest))
-                ;; If we want to work with the KEYWORD type, we need
-                ;; to grok (SATISFIES KEYWORDP).
-                (satisfies
-                 (destructuring-bind (predicate-name) rest
-                   (if (and (in-cl-package-p predicate-name)
-                            (fboundp predicate-name))
-                       ;; Many predicates like KEYWORDP, ODDP, PACKAGEP,
-                       ;; and NULL correspond between host and target.
-                       ;; But we still need to handle errors, because
-                       ;; the code which calls us may not understand
-                       ;; that a type is unreachable. (E.g. when compiling
-                       ;; (AND STRING (SATISFIES ARRAY-HAS-FILL-POINTER-P))
-                       ;; CTYPEP may be called on the SATISFIES expression
-                       ;; even for non-STRINGs.)
-                       (multiple-value-bind (result error?)
-                           (ignore-errors (funcall predicate-name
-                                                   host-object))
-                         (if error?
-                             (values nil nil)
-                             (values result t)))
-                       ;; For symbols not in the CL package, it's not
-                       ;; in general clear how things correspond
-                       ;; between host and target, so we punt.
-                       (warn-and-give-up))))
-                ;; Some complex types are too hard to handle in the
-                ;; positive case, but at least we can be confident in
-                ;; a large fraction of the negative cases..
-                ((base-string simple-base-string simple-string)
-                 (if (stringp host-object)
-                     (warn-and-give-up)
-                     (values nil t)))
-                ((vector simple-vector)
-                 (if (vectorp host-object)
-                     (warn-and-give-up)
-                     (values nil t)))
-                ((array simple-array)
-                 (if (arrayp host-object)
-                     (warn-and-give-up)
-                     (values nil t)))
-                (function
-                 (if (functionp host-object)
-                     (warn-and-give-up)
-                     (values nil t)))
-                ;; And the Common Lisp type system is complicated,
-                ;; and we don't try to implement everything.
-                (otherwise (warn-and-give-up)))))
-           ;; And the Common Lisp type system is complicated, and
-           ;; we don't try to implement everything.
-           (t
-            (warn-and-give-up))))))
+             ;; the ANSI cross-compilation host. KLUDGE: This code will
+             ;; need to be tweaked by hand if the names of these types
+             ;; ever change, ugh!
+             (if (consp target-type)
+                 (member (car target-type)
+                         '(sb!alien:alien))
+                 (member target-type
+                         '(system-area-pointer
+                           funcallable-instance
+                           sb!alien-internals:alien-value)))
+             (values nil t))
+            (;; special case when TARGET-TYPE isn't a type spec, but
+             ;; instead a CLASS object.
+             (typep target-type 'class)
+             (bug "We don't support CROSS-TYPEP of CLASS type specifiers"))
+            ((and (symbolp target-type)
+                  (find-classoid target-type nil)
+                  (sb!xc:subtypep target-type 'cl:structure-object)
+                  (typep host-object '(or symbol number list character)))
+             (values nil t))
+            ((and (symbolp target-type)
+                  (find-class target-type nil)
+                  (subtypep target-type 'sb!kernel::structure!object))
+             (values (typep host-object target-type) t))
+            (;; easy cases of arrays and vectors
+             (target-type-is-in
+              '(array simple-string simple-vector string vector))
+             (values (typep host-object target-type) t))
+            (;; general cases of vectors
+             (and (not (unknown-type-p (values-specifier-type target-type)))
+                  (sb!xc:subtypep target-type 'cl:vector))
+             (if (vectorp host-object)
+                 (warn-and-give-up) ; general-case vectors being way too hard
+                 (values nil t))) ; but "obviously not a vector" being easy
+            (;; general cases of arrays
+             (and (not (unknown-type-p (values-specifier-type target-type)))
+                  (sb!xc:subtypep target-type 'cl:array))
+             (if (arrayp host-object)
+                 (warn-and-give-up) ; general-case arrays being way too hard
+                 (values nil t))) ; but "obviously not an array" being easy
+            ((target-type-is-in '(*))
+             ;; KLUDGE: SBCL has * as an explicit wild type. While
+             ;; this is sort of logical (because (e.g. (ARRAY * 1)) is
+             ;; a valid type) it's not ANSI: looking at the ANSI
+             ;; definitions of complex types like like ARRAY shows
+             ;; that they consider * different from other type names.
+             ;; Someday we should probably get rid of this non-ANSIism
+             ;; in base SBCL, but until we do, we might as well here
+             ;; in the cross compiler. And in order to make sure that
+             ;; we don't continue doing it after we someday patch
+             ;; SBCL's type system so that * is no longer a type, we
+             ;; make this assertion. -- WHN 2001-08-08
+             (aver (typep (values-specifier-type '*) 'named-type))
+             (values t t))
+            (;; Many simple types are guaranteed to correspond exactly
+             ;; between any host ANSI Common Lisp and the target
+             ;; Common Lisp. (Some array types are too, but they
+             ;; were picked off earlier.)
+             (target-type-is-in
+              '(atom bit character complex cons float function integer keyword
+                list nil null number rational real signed-byte symbol t
+                unsigned-byte))
+             (values (typep host-object target-type) t))
+            (;; Floating point types are guaranteed to correspond,
+             ;; too, but less exactly.
+             (target-type-is-in
+              '(single-float double-float))
+             (cond ((floatp host-object)
+                    (warn-about-possible-float-info-loss)
+                    (values (typep host-object target-type) t))
+                   (t
+                    (values nil t))))
+            (;; Complexes suffer the same kind of problems as arrays
+             (and (not (unknown-type-p (values-specifier-type target-type)))
+                  (sb!xc:subtypep target-type 'cl:complex))
+             (if (complexp host-object)
+                 (warn-and-give-up) ; general-case complexes being way too hard
+                 (values nil t))) ; but "obviously not a complex" being easy
+            ;; Some types require translation between the cross-compilation
+            ;; host Common Lisp and the target SBCL.
+            ((target-type-is-in '(classoid))
+             (values (typep host-object 'classoid) t))
+            ((target-type-is-in '(fixnum))
+             (values (fixnump host-object) t))
+            ;; Some types are too hard to handle in the positive
+            ;; case, but at least we can be confident in a large
+            ;; fraction of the negative cases..
+            ((target-type-is-in
+              '(base-string simple-base-string simple-string))
+             (if (stringp host-object)
+                 (warn-and-give-up)
+                 (values nil t)))
+            ((target-type-is-in '(character base-char))
+             (cond ((typep host-object 'standard-char)
+                    (values t t))
+                   ((not (characterp host-object))
+                    (values nil t))
+                   (t
+                    (warn-and-give-up))))
+            ((target-type-is-in '(stream instance))
+             ;; Neither target CL:STREAM nor target SB!KERNEL:INSTANCE
+             ;; is implemented as a STRUCTURE-OBJECT, so they'll fall
+             ;; through the tests above. We don't want to assume too
+             ;; much about them here, but at least we know enough
+             ;; about them to say that neither T nor NIL nor indeed
+             ;; any other symbol in the cross-compilation host is one.
+             ;; That knowledge suffices to answer so many of the
+             ;; questions that the cross-compiler asks that it's well
+             ;; worth special-casing it here.
+             (if (symbolp host-object)
+                 (values nil t)
+                 (warn-and-give-up)))
+            ;; various hacks for composite types..
+            ((consp target-type)
+             (let ((first (first target-type))
+                   (rest (rest target-type)))
+               (case first
+                 ;; Many complex types are guaranteed to correspond exactly
+                 ;; between any host ANSI Common Lisp and the target SBCL.
+                 ((integer member mod rational real signed-byte unsigned-byte)
+                  (values (typep host-object target-type) t))
+                 ;; Floating point types are guaranteed to correspond,
+                 ;; too, but less exactly.
+                 ((single-float double-float)
+                  (cond ((floatp host-object)
+                         (warn-about-possible-float-info-loss)
+                         (values (typep host-object target-type) t))
+                        (t
+                         (values nil t))))
+                 ;; Some complex types have translations that are less
+                 ;; trivial.
+                 (and (every/type #'cross-typep host-object rest))
+                 (or  (any/type   #'cross-typep host-object rest))
+                 ;; If we want to work with the KEYWORD type, we need
+                 ;; to grok (SATISFIES KEYWORDP).
+                 (satisfies
+                  (destructuring-bind (predicate-name) rest
+                    (if (and (in-cl-package-p predicate-name)
+                             (fboundp predicate-name))
+                        ;; Many predicates like KEYWORDP, ODDP, PACKAGEP,
+                        ;; and NULL correspond between host and target.
+                        ;; But we still need to handle errors, because
+                        ;; the code which calls us may not understand
+                        ;; that a type is unreachable. (E.g. when compiling
+                        ;; (AND STRING (SATISFIES ARRAY-HAS-FILL-POINTER-P))
+                        ;; CTYPEP may be called on the SATISFIES expression
+                        ;; even for non-STRINGs.)
+                        (multiple-value-bind (result error?)
+                            (ignore-errors (funcall predicate-name
+                                                    host-object))
+                          (if error?
+                              (values nil nil)
+                              (values result t)))
+                        ;; For symbols not in the CL package, it's not
+                        ;; in general clear how things correspond
+                        ;; between host and target, so we punt.
+                        (warn-and-give-up))))
+                 ;; Some complex types are too hard to handle in the
+                 ;; positive case, but at least we can be confident in
+                 ;; a large fraction of the negative cases..
+                 ((base-string simple-base-string simple-string)
+                  (if (stringp host-object)
+                      (warn-and-give-up)
+                      (values nil t)))
+                 ((vector simple-vector)
+                  (if (vectorp host-object)
+                      (warn-and-give-up)
+                      (values nil t)))
+                 ((array simple-array)
+                  (if (arrayp host-object)
+                      (warn-and-give-up)
+                      (values nil t)))
+                 (function
+                  (if (functionp host-object)
+                      (warn-and-give-up)
+                      (values nil t)))
+                 ;; And the Common Lisp type system is complicated,
+                 ;; and we don't try to implement everything.
+                 (otherwise (warn-and-give-up)))))
+            ;; And the Common Lisp type system is complicated, and
+            ;; we don't try to implement everything.
+            (t
+             (warn-and-give-up))))))
 
 ;;; This is an incomplete TYPEP which runs at cross-compile time to
 ;;; tell whether OBJECT is the host Lisp representation of a target
     ;; A program that calls TYPEP doesn't want uncertainty and
     ;; probably can't handle it.
     (if certain-p
-       opinion
-       (error "uncertain in SB!XC:TYPEP ~S ~S"
-              host-object
-              target-type-spec))))
+        opinion
+        (error "uncertain in SB!XC:TYPEP ~S ~S"
+               host-object
+               target-type-spec))))
 
 ;;; This is an incomplete, portable implementation for use at
 ;;; cross-compile time only.
 (defun ctypep (obj ctype)
   (check-type ctype ctype)
   (let (;; the Common Lisp type specifier corresponding to CTYPE
-       (type (type-specifier ctype)))
+        (type (type-specifier ctype)))
     (check-type type (or symbol cons))
     (cross-typep obj type)))
 
   (typecase x
     (function
      (if (typep x 'generic-function)
-        ;; Since at cross-compile time we build a CLOS-free bootstrap
-        ;; version of SBCL, it's unclear how to explain to it what a
-        ;; generic function is.
-        (error "not implemented: cross CTYPE-OF generic function")
-        ;; There's no ANSI way to find out what the function is
-        ;; declared to be, so we just return the CTYPE for the
-        ;; most-general function.
-        *universal-fun-type*))
+         ;; Since at cross-compile time we build a CLOS-free bootstrap
+         ;; version of SBCL, it's unclear how to explain to it what a
+         ;; generic function is.
+         (error "not implemented: cross CTYPE-OF generic function")
+         ;; There's no ANSI way to find out what the function is
+         ;; declared to be, so we just return the CTYPE for the
+         ;; most-general function.
+         *universal-fun-type*))
     (symbol
      (make-member-type :members (list x)))
     (number
     (array
      (let ((etype (specifier-type (array-element-type x))))
        (make-array-type :dimensions (array-dimensions x)
-                       :complexp (not (typep x 'simple-array))
-                       :element-type etype
-                       :specialized-element-type etype)))
+                        :complexp (not (typep x 'simple-array))
+                        :element-type etype
+                        :specialized-element-type etype)))
     (cons (specifier-type 'cons))
     (character
      (cond ((typep x 'standard-char)
-           ;; (Note that SBCL doesn't distinguish between BASE-CHAR and
-           ;; CHARACTER.)
-           (specifier-type 'base-char))
-          ((not (characterp x))
-           nil)
-          (t
-           ;; Beyond this, there seems to be no portable correspondence.
-           (error "can't map host Lisp CHARACTER ~S to target Lisp" x))))
+            ;; (Note that SBCL doesn't distinguish between BASE-CHAR and
+            ;; CHARACTER.)
+            (specifier-type 'base-char))
+           ((not (characterp x))
+            nil)
+           (t
+            ;; Beyond this, there seems to be no portable correspondence.
+            (error "can't map host Lisp CHARACTER ~S to target Lisp" x))))
     (structure!object
      (find-classoid (uncross (class-name (class-of x)))))
     (t