From 669eaea6857ab6211bfd6c00c7d227f3263200b9 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 2 Dec 2004 18:19:24 +0000 Subject: [PATCH] 0.8.17.16: Plaster for the (COMPLEX RATIO) PFD flesh wound ... treat (COMPLEX (AND +)) as the same as (COMPLEX ) --- BUGS | 4 ++++ NEWS | 2 ++ src/code/late-type.lisp | 26 +++++++++++++++++++++----- src/compiler/fndb.lisp | 2 +- tests/type.pure.lisp | 2 ++ version.lisp-expr | 2 +- 6 files changed, 31 insertions(+), 7 deletions(-) diff --git a/BUGS b/BUGS index d5271f0..d82549c 100644 --- a/BUGS +++ b/BUGS @@ -437,6 +437,10 @@ WORKAROUND: conformance problem, since seems hard to construct useful code where it matters.) + [ partially fixed by CSR in 0.8.17.17 because of a PFD ansi-tests + report that (COMPLEX RATIO) was failing; still failing on types of + the form (AND NUMBER (SATISFIES REALP) (SATISFIES ZEROP)). ] + b. (fixed in 0.8.3.43) 146: diff --git a/NEWS b/NEWS index 5b1d40e..467557e 100644 --- a/NEWS +++ b/NEWS @@ -23,6 +23,8 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: parameters correctly. ** FORMATTER deals with the ~@[ ~] conditional directive where the consequent uses no arguments correctly. + ** the system has a partial understanding of the (COMPLEX RATIO) + type specifier. changes in sbcl-0.8.17 relative to sbcl-0.8.16: * new feature: a build-time option (controlled by the :SB-UNICODE diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 341ff51..1dacf88 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1736,6 +1736,21 @@ (apply #'type-union (mapcar (lambda (x) (complex1 (ctype-of x))) (member-type-members ctype)))) + ((and (typep ctype 'intersection-type) + ;; FIXME: This is very much a + ;; not-quite-worst-effort, but we are required to do + ;; something here because of our representation of + ;; RATIO as (AND RATIONAL (NOT INTEGER)): we must + ;; allow users to ask about (COMPLEX RATIO). This + ;; will of course fail to work right on such types + ;; as (AND INTEGER (SATISFIES ZEROP))... + (let ((numbers (remove-if-not + #'numeric-type-p + (intersection-type-types ctype)))) + (and (car numbers) + (null (cdr numbers)) + (eq (numeric-type-complexp (car numbers)) :real) + (complex1 (car numbers)))))) (t (multiple-value-bind (subtypep certainly) (csubtypep ctype (specifier-type 'real)) @@ -1743,11 +1758,12 @@ (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. - (bug "~@<(known bug #145): The type ~S is too hairy to be + ;; particular, at this point TYPESPEC could legally + ;; be a hairy type like (AND NUMBER (SATISFIES + ;; REALP) (SATISFIES ZEROP)), in which case we fall + ;; through the logic above and end up here, + ;; stumped. + (bug "~@<(known bug #145): The type ~S is too hairy to be ~ used for a COMPLEX component.~:@>" typespec))))))))) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 309758f..8939dbc 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -44,7 +44,7 @@ (defknown type-of (t) t (foldable flushable)) ;;; These can be affected by type definitions, so they're not FOLDABLE. -(defknown (upgraded-complex-part-type sb!xc:upgraded-array-element-type) +(defknown (sb!xc:upgraded-complex-part-type sb!xc:upgraded-array-element-type) (type-specifier &optional lexenv-designator) type-specifier (unsafely-flushable)) diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index 23e5850..f472f24 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -215,6 +215,8 @@ (assert (subtypep 'complex '(complex real))) (assert (subtypep '(complex real) 'complex)) (assert (subtypep '(complex (eql 1)) '(complex (member 1 2)))) +(assert (subtypep '(complex ratio) '(complex rational))) +(assert (subtypep '(complex ratio) 'complex)) (assert (equal (multiple-value-list (subtypep '(complex (integer 1 2)) '(member #c(1 1) #c(1 2) #c(2 1) #c(2 2)))) diff --git a/version.lisp-expr b/version.lisp-expr index ef20f2f..b2dc2be 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.17.15" +"0.8.17.16" -- 1.7.10.4