make-numeric-type: return complex types when asked.

Fixes lp#1856841 part 2
sbcl · Dec 18, 2019 · eb33071 · eb33071
1 parent 534691e
commit eb33071
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 3 deletions.
diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
@@ -359,14 +359,18 @@
     (when (and (null class) (member complexp '(:real :complex)))
       (return-from make-numeric-type
         (if (bounds-unbounded-p low high)
-            (specifier-type 'real)
+            (if (eq complexp :complex)
+                (specifier-type 'complex)
+                (specifier-type 'real))
             (unionize (rational single-float double-float)
                       (rational float float)
                       (:format format)))))
     (when (and (eql class 'float) (member complexp '(:complex :real)) (eql format nil))
       (return-from make-numeric-type
         (if (bounds-unbounded-p low high)
-            (specifier-type 'float)
+            (if (eq complexp :complex)
+                (specifier-type '(complex float))
+                (specifier-type 'real))
             (unionize (single-float double-float #+long-float (error "long-float"))
                       (float float)
                       (:format thing))))))

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
@@ -1065,7 +1065,6 @@
                                                 (type-union (make-numeric-type :low (numeric-type-low y)
                                                                                :high (numeric-type-high y))
                                                             (make-numeric-type :complexp :complex
-                                                                               :class 'float
                                                                                :low (numeric-type-low y)
                                                                                :high (numeric-type-high y)))))))))))
     (cond ((and (if-p (node-dest ref))

diff --git a/tests/constraint.pure.lisp b/tests/constraint.pure.lisp
@@ -63,3 +63,13 @@
                   (typep a '(integer 0 10))
                   nil))))
           '(function (t) (values null &optional)))))
+
+(with-test (:name :=-constraint-complex-no-bounds)
+  (checked-compile-and-assert
+      ()
+      `(lambda (p)
+	(let ((x #c(1 2)))
+          (when (= x p)
+            x)))
+    ((#c(1 2)) #c(1 2))
+    ((#c(2 1)) nil)))