mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 05:30:21 +02:00
Code Activity

Fix flonum/complex type inference.

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-02-19 11:56:24 +01:00
parent c58c143f31
commit d0811644f6
2 changed files with 18 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/language/cps/types.scm
View file

@ -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*))

12
test-suite/tests/compiler.test
View file

@ -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)))