From d321a14169a8d021f2a38ac265d7aa4674f0bd33 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 8 Sep 2004 15:01:47 +0000 Subject: [PATCH] o Change the def-type-translator for COMPLEX to fix some confusion in the compiler about what COMPLEX and (COMPLEX REAL) are. They should be the same. - Make (COMPLEX *) be the same as (COMPLEX REAL), because we were creating a plain COMPLEX, which isn't what we want. - If the typespec is a subtype of RATIONAL, return (COMPLEX RATIONAL). o Make (COMPLEX REAL) print out as COMPLEX instead of as a union of specialized complex types. o Modify CTYPE-OF-NUMBER so that it no longer creates (COMPLEX (INTEGER low high)) types; these are now (COMPLEX RATIONAL). This fixes a bug where (type-of #c(0 1/2)) was giving an error. (This is fixes the bug by removing the offending code. But do we really want and need to support (COMPLEX INTEGER) types in the compiler? Shouldn't (COMPLEX RATIONAL) be good enough?) --- code/type.lisp | 169 +++++++++++++++++++++++++++---------------------- 1 file changed, 92 insertions(+), 77 deletions(-) diff --git a/code/type.lisp b/code/type.lisp index 537c7b178..3caa93a98 100644 --- a/code/type.lisp +++ b/code/type.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.65 2003/10/09 15:50:01 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.66 2004/09/08 15:01:47 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2139,83 +2139,94 @@ (make-numeric-type :complexp nil))) (def-type-translator complex (&optional (typespec '*)) - (if (eq typespec '*) - (make-numeric-type :complexp :complex) - (labels ((not-numeric () - (error "The component type for COMPLEX is not numeric: ~S" - typespec)) - (not-real () - (error "The component type for COMPLEX is not real: ~S" - typespec)) - (complex1 (component-type) - (unless (numeric-type-p component-type) - (not-numeric)) - (when (eq (numeric-type-complexp component-type) :complex) - (not-real)) - (modified-numeric-type component-type :complexp :complex)) - (complex-union (component) - (unless (numberp component) - (not-numeric)) - ;; KLUDGE: This TYPECASE more or less does - ;; (UPGRADED-COMPLEX-PART-TYPE (TYPE-OF COMPONENT)), - ;; (plus a small hack to treat (EQL COMPONENT 0) specially) - ;; but uses logic cut and pasted from the DEFUN of - ;; UPGRADED-COMPLEX-PART-TYPE. That's fragile, because - ;; changing the definition of UPGRADED-COMPLEX-PART-TYPE - ;; would tend to break the code here. Unfortunately, - ;; though, reusing UPGRADED-COMPLEX-PART-TYPE here - ;; would cause another kind of fragility, because - ;; ANSI's definition of TYPE-OF is so weak that e.g. - ;; (UPGRADED-COMPLEX-PART-TYPE (TYPE-OF 1/2)) could - ;; end up being (UPGRADED-COMPLEX-PART-TYPE 'REAL) - ;; instead of (UPGRADED-COMPLEX-PART-TYPE 'RATIONAL). - ;; So using TYPE-OF would mean that ANSI-conforming - ;; maintenance changes in TYPE-OF could break the code here. - ;; It's not clear how best to fix this. -- WHN 2002-01-21, - ;; trying to summarize CSR's concerns in his patch - (typecase component - (complex (error "The component type for COMPLEX (EQL X) ~ + (labels ((not-numeric () + (error "The component type for COMPLEX is not numeric: ~S" + typespec)) + (not-real () + (error "The component type for COMPLEX is not real: ~S" + typespec)) + (complex1 (component-type) + (unless (numeric-type-p component-type) + (not-numeric)) + (when (eq (numeric-type-complexp component-type) :complex) + (not-real)) + (modified-numeric-type component-type :complexp :complex)) + (complex-union (component) + (unless (numberp component) + (not-numeric)) + ;; KLUDGE: This TYPECASE more or less does + ;; (UPGRADED-COMPLEX-PART-TYPE (TYPE-OF COMPONENT)), + ;; (plus a small hack to treat (EQL COMPONENT 0) specially) + ;; but uses logic cut and pasted from the DEFUN of + ;; UPGRADED-COMPLEX-PART-TYPE. That's fragile, because + ;; changing the definition of UPGRADED-COMPLEX-PART-TYPE + ;; would tend to break the code here. Unfortunately, + ;; though, reusing UPGRADED-COMPLEX-PART-TYPE here + ;; would cause another kind of fragility, because + ;; ANSI's definition of TYPE-OF is so weak that e.g. + ;; (UPGRADED-COMPLEX-PART-TYPE (TYPE-OF 1/2)) could + ;; end up being (UPGRADED-COMPLEX-PART-TYPE 'REAL) + ;; instead of (UPGRADED-COMPLEX-PART-TYPE 'RATIONAL). + ;; So using TYPE-OF would mean that ANSI-conforming + ;; maintenance changes in TYPE-OF could break the code here. + ;; It's not clear how best to fix this. -- WHN 2002-01-21, + ;; trying to summarize CSR's concerns in his patch + (typecase component + (complex (error "The component type for COMPLEX (EQL X) ~ is complex: ~S" - component)) - ((eql 0) (specifier-type nil)) ; as required by ANSI - (single-float (specifier-type '(complex single-float))) - (double-float (specifier-type '(complex double-float))) - #+long-float - (long-float (specifier-type '(complex long-float))) - (rational (specifier-type '(complex rational))) - (t (specifier-type '(complex real)))))) - (let ((ctype (specifier-type typespec))) - (typecase ctype - (numeric-type (complex1 ctype)) - (union-type (apply #'type-union - ;; FIXME: This code could suffer from - ;; (admittedly very obscure) cases of - ;; bug 145 e.g. when TYPE is - ;; (OR (AND INTEGER (SATISFIES ODDP)) - ;; (AND FLOAT (SATISFIES FOO)) - ;; and not even report the problem very well. - (mapcar #'complex1 - (union-type-types ctype)))) - ;; MEMBER-TYPE is almost the same as UNION-TYPE, but - ;; there's a gotcha: (COMPLEX (EQL 0)) is, according to - ;; ANSI, equal to type NIL, the empty set. - (member-type (apply #'type-union - (mapcar #'complex-union - (member-type-members ctype)))) - (t - (multiple-value-bind (subtypep certainly) - (csubtypep ctype (specifier-type 'real)) - (if (and (not subtypep) certainly) - (not-real) - ;; ANSI just says that TYPESPEC is any subtype of - ;; type REAL, not necessarily a NUMERIC-TYPE. In - ;; particular, at this point TYPESPEC could legally be - ;; an intersection type like (AND REAL (SATISFIES ODDP)), - ;; in which case we fall through the logic above and - ;; end up here, stumped. - (error "~@<(known bug #145): The type ~S is too hairy to be + component)) + ((eql 0) (specifier-type nil)) ; as required by ANSI + (single-float (specifier-type '(complex single-float))) + (double-float (specifier-type '(complex double-float))) + #+long-float + (long-float (specifier-type '(complex long-float))) + (rational (specifier-type '(complex rational))) + (t (specifier-type '(complex real)))))) + (let ((ctype (specifier-type typespec))) + (typecase ctype + (numeric-type + (if (csubtypep ctype (specifier-type 'rational)) + (complex1 (specifier-type 'rational)) + (complex1 ctype))) + (union-type (apply #'type-union + ;; FIXME: This code could suffer from + ;; (admittedly very obscure) cases of + ;; bug 145 e.g. when TYPE is + ;; (OR (AND INTEGER (SATISFIES ODDP)) + ;; (AND FLOAT (SATISFIES FOO)) + ;; and not even report the problem very well. + (mapcar #'complex1 + (union-type-types ctype)))) + (member-type + ;; MEMBER-TYPE is almost the same as UNION-TYPE, but there's + ;; a gotcha: (COMPLEX (EQL 0)) is unclear to me (rtoy). For + ;; now if the typespec is a subtype of rational, we create + ;; (COMPLEX RATIONAL). + (if (csubtypep ctype (specifier-type 'rational)) + (complex1 (specifier-type 'rational)) + (apply #'type-union + (mapcar #'complex-union + (member-type-members ctype))))) + (named-type + (if (eq (named-type-name ctype) '*) + (apply #'type-union + (mapcar #'complex1 + (union-type-types (specifier-type 'real)))) + (not-real))) + (t + (multiple-value-bind (subtypep certainly) + (csubtypep ctype (specifier-type 'real)) + (if (and (not subtypep) certainly) + (not-real) + ;; ANSI just says that TYPESPEC is any subtype of + ;; type REAL, not necessarily a NUMERIC-TYPE. In + ;; particular, at this point TYPESPEC could legally be + ;; an intersection type like (AND REAL (SATISFIES ODDP)), + ;; in which case we fall through the logic above and + ;; end up here, stumped. + (error "~@<(known bug #145): The type ~S is too hairy to be used for a COMPLEX component.~:@>" - typespec))))))))) + typespec)))))))) ;;; Check-Bound -- Internal ;;; @@ -2897,6 +2908,7 @@ ((type= type (specifier-type 'real)) 'real) ((type= type (specifier-type 'sequence)) 'sequence) ((type= type (specifier-type 'bignum)) 'bignum) + ((type= type (specifier-type 'complex)) 'complex) (t `(or ,@(mapcar #'type-specifier (union-type-types type)))))) (define-type-method (union :simple-=) (type1 type2) @@ -3389,7 +3401,10 @@ (values :complex (min num imag) (max num imag))) (values :real num num)) (make-numeric-type :class (etypecase num - (integer 'integer) + ;; We used to have an INTEGER type + ;; here, but is it really necessary? + ;; I (rtoy) think RATIONAL is as + ;; good. (rational 'rational) (float 'float)) :format (and (floatp num) (float-format-name num)) -- GitLab