0.8.17.16:

	Plaster for the (COMPLEX RATIO) PFD flesh wound
	... treat (COMPLEX (AND <numeric> <hairy>+)) as the same as
		(COMPLEX <numeric>)

diff --git a/BUGS b/BUGS
index d5271f0..d82549c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))
 \f

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 23e5850..f472f24 100644 (file)
--- 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 (file)
--- 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"