diff options
-rw-r--r-- | module/language/cps/types.scm | 8 | ||||
-rw-r--r-- | 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 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))) |