wingo pushed a commit to branch master in repository guile. commit d0811644f6c8b7bd7dd812b91e53dc3b8b153d12 Author: Andy Wingo <wi...@pobox.com> 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)))