suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Align float-complex/float division with Racket more.

Browse Source 
Found using random testing.
This commit is contained in:
Vincent St-Amour 2015-11-02 15:45:27 -06:00
parent ad0c69ea29
commit a3d29d9e03
3 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
typed-racket-lib/typed-racket/optimizer/float-complex.rkt
View File

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

16
typed-racket-test/optimizer/known-bugs.rkt
View File

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

5
typed-racket-test/optimizer/tests/float-complex-float.rkt
View File

@ -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
#<<END
6.0+8.0i
-4.0-10.0i
-4.0-4.0i
-4.0-2.0i
+nan.0+0.0i
END
#lang typed/scheme
@ -32,3 +36,4 @@ END
(- 1.0 2.0+4.0i 3.0+6.0i)
(- 1.0+2.0i 2.0 3.0+6.0i)
(- 1.0+2.0i 2.0+4.0i 3.0)
(/ 0.0 +inf.0-1.0i)