[Guile-commits] 01/01: Fix flonum/complex type inference.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit d0811644f6c8b7bd7dd812b91e53dc3b8b153d12
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 11:56:24 2017 +0100

    Fix flonum/complex type inference.
    
    * module/language/cps/types.scm (define-binary-result!): Arithmetic
      where one argument is a flonum may produce a complex.
    * test-suite/tests/compiler.test: Add test.
---
 module/language/cps/types.scm  |  8 ++++++--
 test-suite/tests/compiler.test | 12 ++++++++++++
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index c7e4211..a66e4b8 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -970,11 +970,15 @@ minimum, and maximum."
       ;; One input not a number.  Perhaps we end up dispatching to
       ;; GOOPS.
       (define! result &all-types -inf.0 +inf.0))
-     ;; Complex and floating-point numbers are contagious.
+     ;; Complex numbers are contagious.
      ((or (eqv? a-type &complex) (eqv? b-type &complex))
       (define! result &complex -inf.0 +inf.0))
      ((or (eqv? a-type &flonum) (eqv? b-type &flonum))
-      (define! result &flonum min* max*))
+      ;; If one argument is a flonum, the result will be flonum or
+      ;; possibly complex.
+      (let ((result-type (logand (logior a-type b-type)
+                                 (logior &complex &flonum))))
+        (define! result result-type min* max*)))
      ;; Exact integers are closed under some operations.
      ((and closed? (eqv? a-type &exact-integer) (eqv? b-type &exact-integer))
       (define! result &exact-integer min* max*))
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 582ce6e..4f644f3 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -239,3 +239,15 @@
     (begin
       (test-proc)
       #t)))
+
+(with-test-prefix "flonum inference"
+  (define test-code
+    '(lambda (x) (let ((y (if x 0.0 0.0+0.0i))) (+ y 0.0))))
+  (define test-proc #f)
+  (pass-if "compiling test works"
+    (begin
+      (set! test-proc (compile test-code))
+      (procedure? test-proc)))
+
+  (pass-if-equal "test flonum" 0.0 (test-proc #t))
+  (pass-if-equal "test complex" 0.0+0.0i (test-proc #f)))