From a3d29d9e03c3e175274a2a313de62cbd68ab695e Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 2 Nov 2015 15:45:27 -0600 Subject: [PATCH] Align float-complex/float division with Racket more. Found using random testing. --- .../typed-racket/optimizer/float-complex.rkt | 23 +++++++++++++++---- typed-racket-test/optimizer/known-bugs.rkt | 16 ++++++------- .../optimizer/tests/float-complex-float.rkt | 5 ++++ 3 files changed, 32 insertions(+), 12 deletions(-) diff --git a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt index d3e97d09..6801b284 100644 --- a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt +++ b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt @@ -57,7 +57,11 @@ ;; a+bi / c+di, names for real and imag parts of result -> one let-values binding clause (define (unbox-one-complex-/ a b c d res-real res-imag) - (define both-real? (and (0.0? b) (0.0? d))) + (define first-arg-real? (syntax-property b 'was-real?)) + (define second-arg-real? (syntax-property d 'was-real?)) + ;; if both are real, we can short-circuit a lot + (define both-real? (and first-arg-real? second-arg-real?)) + ;; we have the same cases as the Racket `/' primitive (except for the non-float ones) (define d=0-case #`(values (unsafe-fl+ (unsafe-fl/ #,a #,c) @@ -85,10 +89,17 @@ (unsafe-fl/ (unsafe-fl- (unsafe-fl* b r) a) den))]) (values (unsafe-fl/ (unsafe-fl+ b (unsafe-fl* a r)) den) i))) + (cond [both-real? #`[(#,res-real #,res-imag) (values (unsafe-fl/ #,a #,c) 0.0)]] ; currently not propagated + [second-arg-real? + #`[(#,res-real #,res-imag) + (values (unsafe-fl/ #,a #,c) + (unsafe-fl/ #,b #,c))]] + [first-arg-real? + (unbox-one-float-complex-/ a c d res-real res-imag)] [else #`[(#,res-real #,res-imag) (cond [(unsafe-fl= #,d 0.0) #,d=0-case] @@ -112,7 +123,7 @@ #`(let* ([cm (unsafe-flabs #,c)] [dm (unsafe-flabs #,d)] [swap? (unsafe-fl< cm dm)] - [a #,a] + [a #,a] ; don't swap with `b` (`0`) here, but handle below [c (if swap? #,d #,c)] [d (if swap? #,c #,d)] [r (unsafe-fl/ c d)] @@ -332,10 +343,14 @@ ((real-binding) (unsafe-flreal-part e*)) ((imag-binding) (unsafe-flimag-part e*)))) - ;; The following optimization is incorrect and causes bugs because it turns exact numbers into inexact (pattern e:number-expr #:with e* (generate-temporary) - #:with (real-binding imag-binding) (binding-names) + #:with (real-binding imag-binding*) (binding-names) + #:with imag-binding (if (subtypeof? #'e -Real) + ;; values that were originally reals may need to be + ;; handled specially + (syntax-property #'imag-binding 'was-real? #t) + #'imag-binding) #:do [(log-unboxing-opt (if (subtypeof? #'e -Flonum) "float in complex ops" diff --git a/typed-racket-test/optimizer/known-bugs.rkt b/typed-racket-test/optimizer/known-bugs.rkt index 3601f5d3..dcc0bc2e 100644 --- a/typed-racket-test/optimizer/known-bugs.rkt +++ b/typed-racket-test/optimizer/known-bugs.rkt @@ -58,29 +58,29 @@ ;; Arguments are converted to inexact too early (bad-opt (* (make-rectangular -inf.0 1) (* 1 1))) - (bad-opt (/ -inf.0-inf.0i 8)) + (good-opt (/ -inf.0-inf.0i 8)) (good-opt (- (* -1 1 +nan.0) 1.0+1.0i)) (good-opt (- (* (/ 6 11) (/ 1.2345678f0 123456.7f0)) (make-rectangular 0.0 0.3))) - (bad-opt (/ 1.0 0.0+0.0i)) + (good-opt (/ 1.0 0.0+0.0i)) (good-opt (+ 0.0+0.0i (* 1 1 +inf.0))) (bad-opt (* 1.0f-30 1.0f-30 1.0e60+1.0e60i)) ;; Unary division has bad underflow (good-opt (/ (make-rectangular 1e+100 1e-300))) (good-opt (/ 0.5+1.7e+308i)) - (bad-opt (/ 1 (make-rectangular 1e+100 1e-300))) - (bad-opt (/ 1 0.5+1.7e+308i)) + (good-opt (/ 1 (make-rectangular 1e+100 1e-300))) + (good-opt (/ 1 0.5+1.7e+308i)) ;; Division of complex 0 should only make part of the result nan (good-opt (/ 0.0+0.0i)) - (bad-opt (/ 1 0.0+0.0i)) - (bad-opt (/ 1.5 -3.0+9.8e-324i)) + (good-opt (/ 1 0.0+0.0i)) + (good-opt (/ 1.5 -3.0+9.8e-324i)) ;; Division of complex infinity should only make part of the result nan (good-opt (/ (make-rectangular 1.0 +inf.0))) (good-opt (/ (make-rectangular +inf.0 1.0))) - (bad-opt (/ 1 (make-rectangular 1.0 +inf.0))) - (bad-opt (/ 1 (make-rectangular +inf.0 1.0))) + (good-opt (/ 1 (make-rectangular 1.0 +inf.0))) + (good-opt (/ 1 (make-rectangular +inf.0 1.0))) ;; Exp of large real should have 0 imaginary component (good-opt (+ (exp 1.7976931348623151e+308) 0.0+0.0i)) diff --git a/typed-racket-test/optimizer/tests/float-complex-float.rkt b/typed-racket-test/optimizer/tests/float-complex-float.rkt index e61162a2..7ec33915 100644 --- a/typed-racket-test/optimizer/tests/float-complex-float.rkt +++ b/typed-racket-test/optimizer/tests/float-complex-float.rkt @@ -16,12 +16,16 @@ TR opt: float-complex-float.rkt 5:0 (- 1.0+2.0i 2.0+4.0i 3.0) -- unboxed binary TR opt: float-complex-float.rkt 5:12 2.0+4.0i -- unboxed literal TR opt: float-complex-float.rkt 5:21 3.0 -- float in complex ops TR opt: float-complex-float.rkt 5:3 1.0+2.0i -- unboxed literal +TR opt: float-complex-float.rkt 6:0 (/ 0.0 +inf.0-1.0i) -- unboxed binary float complex +TR opt: float-complex-float.rkt 6:3 0.0 -- float in complex ops +TR opt: float-complex-float.rkt 6:7 +inf.0-1.0i -- unboxed literal END #<