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

Fix unary / optimizations.

Browse Source 
original commit: aa3505d9374b48d6d273c141c178d760d2629871
This commit is contained in:
Eric Dobson 2013-10-27 11:27:59 -07:00
parent 63a1f89025
commit 7c00a7d443
2 changed files with 45 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -96,6 +96,39 @@
[(unsafe-fl= #,c 0.0) #,c=0-case]
[else #,general-case])]]))
;; a+bi / c+di, names for real and imag parts of result -> one let-values binding clause
;; b = exact 0
;; a,c,d are floats (!= exact 0)
(define (unbox-one-float-complex-/ a c d res-real res-imag)
;; TODO: In what cases is the negation in the d=0 case useful
(define d=0-case
#`(values (unsafe-fl/ #,a #,c)
(unsafe-fl* -1.0 (unsafe-fl* #,d #,a))))
(define c=0-case
#`(values (unsafe-fl* #,c #,a)
(unsafe-fl* -1.0 (unsafe-fl/ #,a #,d))))
(define general-case
#`(let* ([cm (unsafe-flabs #,c)]
[dm (unsafe-flabs #,d)]
[swap? (unsafe-fl< cm dm)]
[a #,a]
[c (if swap? #,d #,c)]
[d (if swap? #,c #,d)]
[r (unsafe-fl/ c d)]
[den (unsafe-fl+ d (unsafe-fl* c r))]
[i (if swap?
(unsafe-fl/ (unsafe-fl* -1.0 (unsafe-fl* a r)) den)
(unsafe-fl/ (unsafe-fl* -1.0 a) den))]
[j (if swap? a (unsafe-fl* a r))])
(values (unsafe-fl/ j den) i)))
#`[(#,res-real #,res-imag)
(cond [(unsafe-fl= #,d 0.0) #,d=0-case]
[(unsafe-fl= #,c 0.0) #,c=0-case]
[else #,general-case])])
;; it's faster to take apart a complex number and use unsafe operations on
;; its parts than it is to use generic operations
;; we keep the real and imaginary parts unboxed as long as we stay within
@ -225,8 +258,8 @@
#:do [(log-unboxing-opt "unboxed unary float complex")]
#:with (bindings ...)
#`(c1.bindings ...
#,(unbox-one-complex-/ #'1.0 #'0.0 #'c1.real-binding #'c1.imag-binding
#'real-binding #'imag-binding)))
#,(unbox-one-float-complex-/ #'1.0 #'c1.real-binding #'c1.imag-binding
#'real-binding #'imag-binding)))
(pattern (#%plain-app op:conjugate^ c:unboxed-float-complex-opt-expr)
#:when (subtypeof? this-syntax -FloatComplex)

15
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/known-bugs.rkt
View File

@ -66,15 +66,20 @@
(bad-opt (* 1.0f-30 1.0f-30 1.0e60+1.0e60i))
;; Unary division has bad underflow
(bad-opt (/ (make-rectangular 1e+100 1e-300)))
(bad-opt (/ 0.5+1.7e+308i))
(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))
;; Division of complex 0 should only make part of the result nan
(bad-opt (/ 0.0+0.0i))
(good-opt (/ 0.0+0.0i))
(bad-opt (/ 1 0.0+0.0i))
;; Division of complex infinity should only make part of the result nan
(bad-opt (/ (make-rectangular 1.0 +inf.0)))
(bad-opt (/ (make-rectangular +inf.0 1.0)))
(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)))
;; Exp of large real should have 0 imaginary component
(good-opt (+ (exp 1.7976931348623151e+308) 0.0+0.0i))