summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-02-19 11:56:24 +0100
committerAndy Wingo <wingo@pobox.com>2017-02-19 12:11:07 +0100
commitd0811644f6c8b7bd7dd812b91e53dc3b8b153d12 (patch)
treeca82d98cc8ca688a475a7ae784bc4367fad5384c
parentc58c143f31fe4c1717fc8846a8681de2bb4b3869 (diff)
downloadguile-d0811644f6c8b7bd7dd812b91e53dc3b8b153d12.tar.gz
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.
-rw-r--r--module/language/cps/types.scm8
-rw-r--r--test-suite/tests/compiler.test12
2 files changed, 18 insertions, 2 deletions
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index c7e42117c..a66e4b800 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 582ce6e28..4f644f339 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)))