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

Extend this handling to multiplication.

Browse Source 
Found using random testing.
This commit is contained in:
Vincent St-Amour 2015-11-06 16:27:05 -06:00
parent b101d396a3
commit 7ef06f74c9
3 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -247,6 +247,8 @@
(define o-real? (was-real? o2))
(define e-real? (was-real? (car e2)))
(define both-real? (and o-real? e-real?))
(define o-nf (as-non-float o1))
(define e-nf (as-non-float (car e1)))
(define new-imag-id (if both-real?
(mark-as-real (car is))
(car is)))
@ -261,11 +263,22 @@
#`(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
#,(cond [(and o-nf e-nf)
;; we haven't seen float operands yet, so
;; shouldn't prematurely convert to floats
;; (implies that they're both real)
(mark-as-non-float (car rs) (car rs))
#`(* #,o-nf #,e-nf)]
[(or o-real? e-real?)
#`(unsafe-fl*
#,(if (as-non-float o1)
;; we hit floats, need to coerce
#`(real->double-flonum #,o1)
o1)
#,(car e1))]
[else
#`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
(unsafe-fl* #,o2 #,(car e2))))))
(unsafe-fl* #,o2 #,(car e2)))]))
res))])))))
(pattern (#%plain-app op:*^ :unboxed-float-complex-opt-expr)
#:when (subtypeof? this-syntax -FloatComplex)

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

@ -56,7 +56,7 @@
(good-opt (- (* (/ 6 11) (/ 1.2345678f0 123456.7f0)) (make-rectangular 0.0 0.3)))
(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))
(good-opt (* 1.0f-30 1.0f-30 1.0e60+1.0e60i))
;; Unary division has bad underflow
(good-opt (/ (make-rectangular 1e+100 1e-300)))
@ -79,7 +79,7 @@
(good-opt (+ (exp 1.7976931348623151e+308) 0.0+0.0i))
;; Multiplication of multiple args should keep exact semantics for exact args
(bad-opt (* (expt 10 500) (expt 10 -500) 1.0+1.0i))
(good-opt (* (expt 10 500) (expt 10 -500) 1.0+1.0i))
;; Addition of multiple args should keep exact semantics for exact args
(good-opt (+ (expt 10 501) (expt -10 501) 1.0+1.0i))

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

@ -15,6 +15,11 @@ TR opt: float-complex-float.rkt 12:0 (+ 1.5245886f+12 (max (exact-round 2) (exac
TR opt: float-complex-float.rkt 12:17 (max (exact-round 2) (exact-round 5/4)) -- non float complex in complex ops
TR opt: float-complex-float.rkt 12:3 1.5245886f+12 -- non float complex in complex ops
TR opt: float-complex-float.rkt 12:57 (tanh (make-rectangular 1.4291365847030308e-64 -0.76987815f0)) -- unbox float-complex
TR opt: float-complex-float.rkt 13:0 (* (min 3/4) 0.9845773f0 (make-rectangular 3 0.0)) -- unboxed binary float complex
TR opt: float-complex-float.rkt 13:13 0.9845773f0 -- non float complex in complex ops
TR opt: float-complex-float.rkt 13:25 (make-rectangular 3 0.0) -- make-rectangular elimination
TR opt: float-complex-float.rkt 13:3 (min 3/4) -- non float complex in complex ops
TR opt: float-complex-float.rkt 13:3 (min 3/4) -- unary number
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
@ -49,6 +54,7 @@ END
+nan.0+0.0i
-0.8414709848078965-4.5353337789114595e-57i
5.381428268223429e-17-0.9694319337396835i
2.2152990102767944+0.0i
END
#lang typed/scheme
@ -66,3 +72,4 @@ END
(/ 2.3454025f0 (flmin (real->double-flonum 1.797693134862315e+308) (real->double-flonum -1.2848677f+32)) (make-rectangular +nan.0 0.0))
(+ (make-polar 4.8063810141303426e-57 -1.9082319f0) -0.8414709848078965)
(+ 1.5245886f+12 (max (exact-round 2) (exact-round 5/4)) (tanh (make-rectangular 1.4291365847030308e-64 -0.76987815f0)))
(* (min 3/4) 0.9845773f0 (make-rectangular 3 0.0))