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

Use more precise notion of "real argument" for multiplication too.

Browse Source 
Found using random testing.
This commit is contained in:
Vincent St-Amour 2015-11-02 16:29:58 -06:00
parent e47ffeb0e8
commit ca9306bb1d
3 changed files with 34 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,10 +50,6 @@
"The optimizer could optimize it better if it had type Float-Complex.")
this-syntax))
;; If a part is 0.0?
(define (0.0? stx)
(equal? (syntax->datum stx) 0.0))
;; 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)
@ -209,27 +205,33 @@
#'(cs.imag-binding ...))
(list #'imag-binding))]
[res '()])
(if (null? e1)
(reverse res)
(loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is)
;; complex multiplication, imag part, then real part (reverse)
;; we eliminate operations on the imaginary parts of reals
(let ((o-real? (0.0? o2))
(e-real? (0.0? (car e2))))
(list* #`((#,(car is))
#,(cond ((and o-real? e-real?) #'0.0)
(o-real? #`(unsafe-fl* #,o1 #,(car e2)))
(e-real? #`(unsafe-fl* #,o2 #,(car e1)))
(else
#`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
(unsafe-fl* #,o1 #,(car e2))))))
#`((#,(car rs))
#,(cond ((or o-real? e-real?)
#`(unsafe-fl* #,o1 #,(car e1)))
(else
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
(unsafe-fl* #,o2 #,(car e2))))))
res))))))))
(cond
[(null? e1)
(reverse res)]
[else
(define o-real? (syntax-property o2 'was-real?))
(define e-real? (syntax-property (car e2) 'was-real?))
(define both-real? (and o-real? e-real?))
(define new-imag-id (if both-real?
(syntax-property (car is) 'was-real? #t)
(car is)))
(loop (car rs) new-imag-id (cdr e1) (cdr e2) (cdr rs) (cdr is)
;; complex multiplication, imag part, then real part (reverse)
;; we eliminate operations on the imaginary parts of reals
(list* #`((#,new-imag-id)
#,(cond ((and o-real? e-real?) #'0.0)
(o-real? #`(unsafe-fl* #,o1 #,(car e2)))
(e-real? #`(unsafe-fl* #,o2 #,(car e1)))
(else
#`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
(unsafe-fl* #,o1 #,(car e2))))))
#`((#,(car rs))
#,(cond ((or o-real? e-real?)
#`(unsafe-fl* #,o1 #,(car e1)))
(else
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
(unsafe-fl* #,o2 #,(car e2))))))
res))])))))
(pattern (#%plain-app op:*^ :unboxed-float-complex-opt-expr)
#:when (subtypeof? this-syntax -FloatComplex)
#:do [(log-unboxing-opt "unboxed unary float complex")])

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

@ -57,7 +57,7 @@
(test-suite "Known bugs"
;; Arguments are converted to inexact too early
(bad-opt (* (make-rectangular -inf.0 1) (* 1 1)))
(good-opt (* (make-rectangular -inf.0 1) (* 1 1)))
(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)))

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

@ -19,6 +19,10 @@ 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
TR opt: float-complex-float.rkt 7:0 (* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541)) -- unboxed binary float complex
TR opt: float-complex-float.rkt 7:23 3/2 -- non float complex in complex ops
TR opt: float-complex-float.rkt 7:27 (make-rectangular +inf.f 0.7692234292042541) -- make-rectangular elimination
TR opt: float-complex-float.rkt 7:3 -0.9263371220283309 -- float in complex ops
END
#<<END
6.0+8.0i
@ -26,6 +30,7 @@ END
-4.0-4.0i
-4.0-2.0i
+nan.0+0.0i
-inf.0-1.0688403264087485i
END
#lang typed/scheme
@ -37,3 +42,4 @@ END
(- 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)
(* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541))