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

Preserve sign better in real-complex ops.

Browse Source 
Found using random testing.
This commit is contained in:
Vincent St-Amour 2015-11-09 16:30:21 -06:00
parent d91d89ffc1
commit 7346abf91c
2 changed files with 44 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -219,14 +219,23 @@
#,@(let ()
(define (fl-sum cs)
(n-ary->binary/non-floats #'+ #'unsafe-fl+ this-syntax cs))
(define non-0-imags
;; to preserve result sign, ignore exact 0s
;; o/w, can have (+ -0.0 (->fl 0)) => 0.0, but would be -0.0
;; without the coercion
(for/list ([i (syntax->list #'(cs.imag-binding ...))]
#:unless (was-real? i))
i))
(list
#`((real-binding) #,(fl-sum #'(cs.real-binding ...)))
#`((imag-binding) #,(fl-sum #'(cs.imag-binding ...)))))))
#`((imag-binding)
#,(if (null? (cdr non-0-imags)) ; only one actual imag part
(car non-0-imags)
(fl-sum non-0-imags)))))))
(pattern (#%plain-app op:+^ :unboxed-float-complex-opt-expr)
#:when (subtypeof? this-syntax -FloatComplex)
#:do [(log-unboxing-opt "unboxed unary float complex")])
(pattern (#%plain-app op:-^ (~between cs:unboxed-float-complex-opt-expr 2 +inf.0) ...)
#:when (subtypeof? this-syntax -FloatComplex)
#:with (real-binding imag-binding) (binding-names)
@ -238,7 +247,17 @@
(n-ary->binary/non-floats #'- #'unsafe-fl- this-syntax cs))
(list
#`((real-binding) #,(fl-subtract #'(cs.real-binding ...)))
#`((imag-binding) #,(fl-subtract #'(cs.imag-binding ...)))))))
#`((imag-binding)
;; can't ignore exact 0 imag parts from real numbers, as with
;; addition, because the first value is special
;; so just conservatively use generic subtraction
#,(if (ormap was-real? (syntax->list #'(cs.imag-binding ...)))
(n-ary->binary
this-syntax
#'-
(for/list ([i (syntax->list #'(cs.imag-binding ...))])
(if (was-real? i) #'0 i)))
(fl-subtract #'(cs.imag-binding ...))))))))
(pattern (#%plain-app op:-^ c1:unboxed-float-complex-opt-expr) ; unary -
#:when (subtypeof? this-syntax -FloatComplex)
#:with (real-binding imag-binding) (binding-names)

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

@ -37,6 +37,22 @@ TR opt: float-complex-float.rkt 16:51 2.0324421f-21 -- non float complex in comp
TR opt: float-complex-float.rkt 16:6 (exact-round 1.8655746f+35) -- non float complex in complex ops
TR opt: float-complex-float.rkt 16:6 (exact-round 1.8655746f+35) -- non float complex in complex ops
TR opt: float-complex-float.rkt 16:65 (make-rectangular 4 1.7976931348623157e+308) -- make-rectangular elimination
TR opt: float-complex-float.rkt 17:0 (+ +inf.0-0.0i +nan.0) -- unboxed binary float complex
TR opt: float-complex-float.rkt 17:15 +nan.0 -- float in complex ops
TR opt: float-complex-float.rkt 17:3 +inf.0-0.0i -- unboxed literal
TR opt: float-complex-float.rkt 18:0 (+ (- 0.0 16 -inf.0+0.0i) +nan.0) -- unboxed binary float complex
TR opt: float-complex-float.rkt 18:10 16 -- non float complex in complex ops
TR opt: float-complex-float.rkt 18:13 -inf.0+0.0i -- unboxed literal
TR opt: float-complex-float.rkt 18:26 +nan.0 -- float in complex ops
TR opt: float-complex-float.rkt 18:3 (- 0.0 16 -inf.0+0.0i) -- unboxed binary float complex
TR opt: float-complex-float.rkt 18:6 0.0 -- float in complex ops
TR opt: float-complex-float.rkt 19:0 (+ (floor (+ (exact-round -25.263502f0) (exact-round -1/2))) (- 0.0 16 (make-rectangular -inf.0 0.0)) +nan.0) -- unboxed binary float complex
TR opt: float-complex-float.rkt 19:102 +nan.0 -- float in complex ops
TR opt: float-complex-float.rkt 19:3 (floor (+ (exact-round -25.263502f0) (exact-round -1/2))) -- non float complex in complex ops
TR opt: float-complex-float.rkt 19:61 (- 0.0 16 (make-rectangular -inf.0 0.0)) -- unboxed binary float complex
TR opt: float-complex-float.rkt 19:64 0.0 -- float in complex ops
TR opt: float-complex-float.rkt 19:68 16 -- non float complex in complex ops
TR opt: float-complex-float.rkt 19:71 (make-rectangular -inf.0 0.0) -- make-rectangular elimination
TR opt: float-complex-float.rkt 4:0 (+ 1.0+2.0i 2.0 3.0+6.0i) -- unboxed binary float complex
TR opt: float-complex-float.rkt 4:12 2.0 -- float in complex ops
TR opt: float-complex-float.rkt 4:16 3.0+6.0i -- unboxed literal
@ -75,6 +91,9 @@ END
-5.84330415295662e+36-2.521848811753627e+37i
-inf.0-0.0i
+nan.0+nan.0i
+nan.0-0.0i
+nan.0-0.0i
+nan.0-0.0i
END
#lang typed/scheme
@ -96,3 +115,6 @@ END
(/ 3.2993203f+37 (floor -2.2441852f0) (make-polar 0.42484267570553375 4.940078147009648))
(/ -5 2/7 (make-polar -0.0 (fltan (real->double-flonum -3.833043f+21))))
(/ (+ (exact-round 1.8655746f+35) (exact-round 1)) 2.0324421f-21 (make-rectangular 4 1.7976931348623157e+308))
(+ +inf.0-0.0i +nan.0)
(+ (- 0.0 16 -inf.0+0.0i) +nan.0)
(+ (floor (+ (exact-round -25.263502f0) (exact-round -1/2))) (- 0.0 16 (make-rectangular -inf.0 0.0)) +nan.0)