X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-type.lisp;h=32becc381e97bce8778ca7d53a9900fbe23517f2;hb=7f9f1fd113d7047731bda9dab2c7719cdf092a21;hp=e4031af9dbc84f53f2f96bd02d80328c5d5fa8ba;hpb=42b8c7570a2faa21529fadeef84a0caea186aa8c;p=sbcl.git diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index e4031af..32becc3 100644 --- a/src/code/cross-type.lisp +++ b/src/code/cross-type.lisp @@ -21,16 +21,16 @@ ;;; 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. @@ -62,31 +62,34 @@ ;;; 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))) - ((some (lambda (type) (subtypep raw-result type)) - '(array character list symbol)) - raw-result) - (t - (error "can't handle TYPE-OF ~S in cross-compilation"))))) + (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))))) ;;; 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 @@ -107,219 +110,235 @@ (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 'sb!xc::structure-class) - ;; SBCL-specific types which have an analogue specially - ;; created on the host system - (if (sb!xc:subtypep (sb!xc:class-name target-type) - 'sb!kernel::structure!object) - (values (typep host-object (sb!xc:class-name target-type)) t) - (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)) - ((and (symbolp target-type) - (sb!xc:find-class target-type nil) - (sb!xc:subtypep target-type 'cl:structure-object) - (typep host-object '(or symbol number list character))) - (values nil 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 (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 '(sb!xc:class)) - (values (typep host-object 'sb!xc:class) 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 + 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)) + (;; sequence is not guaranteed to be an exhaustive + ;; partition, but it includes at least lists and vectors. + (target-type-is-in '(sequence)) + (if (or (vectorp host-object) (listp host-object)) + (values t t) + (if (typep host-object target-type) + (warn-and-give-up) + (values nil t)))) + (;; general cases of vectors + (and (not (hairy-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 (hairy-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. + ;; Our dumping logic is based on contents, however, so + ;; reasoning about them should be safe + (and (not (hairy-type-p (values-specifier-type target-type))) + (sb!xc:subtypep target-type 'cl:complex)) + (if (complexp host-object) + (let ((re (realpart host-object)) + (im (imagpart host-object))) + (if (or (and (eq target-type 'complex) + (typep re 'rational) (typep im 'rational)) + (and (equal target-type '(cl:complex single-float)) + (typep re 'single-float) (typep im 'single-float)) + (and (equal target-type '(cl:complex double-float)) + (typep re 'double-float) (typep im 'double-float))) + (values t t) + (progn + ;; We won't know how to dump it either. + (warn "Host complex too complex: ~S" host-object) + (warn-and-give-up)))) + (values nil t))) + ;; 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 @@ -335,55 +354,73 @@ ;; 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))) - (check-type type (or symbol cons)) - (cross-typep obj type))) + ;; There is at least one possible endless recursion in the + ;; cross-compiler type system: (SUBTYPEP NULL (OR UNKOWN0 UNKNOWN1) + ;; runs out of stack. The right way would probably be to not + ;; implement CTYPEP in terms of TYPE-SPECIFIER (:UNPARSE, that may + ;; call TYPE=, that in turn may call CTYPEP). Until then, pick a few + ;; cherries off. + (cond ((member-type-p ctype) + (if (member-type-member-p obj ctype) + (values t t) + (values nil t))) + ((union-type-p ctype) + (any/type #'ctypep obj (union-type-types ctype))) + (t + (let ( ;; the Common Lisp type specifier corresponding to CTYPE + (type (type-specifier ctype))) + (check-type type (or symbol cons)) + (cross-typep obj type))))) (defun ctype-of (x) (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 (ctype-of-number x)) + (string + (make-array-type :dimensions (array-dimensions x) + :complexp (not (typep x 'simple-array)) + :element-type (specifier-type 'base-char) + :specialized-element-type (specifier-type 'base-char))) (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.) - (sb!xc:find-class '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 - (sb!xc:find-class (uncross (class-name (class-of x))))) + (find-classoid (uncross (class-name (class-of x))))) (t ;; There might be more cases which we could handle with ;; sufficient effort; since all we *need* to handle are enough