diff --git a/collects/tests/typed-scheme/optimizer/tests/float-real.rkt b/collects/tests/typed-scheme/optimizer/tests/float-real.rkt new file mode 100644 index 0000000000..7f1aadd855 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/tests/float-real.rkt @@ -0,0 +1,15 @@ +#; +( +float-real.rkt 13:1 + -- binary float +float-real.rkt 14:1 + -- binary float +5.3 +8.7 +14.26 + ) + +#lang typed/racket + +;; reals within float expressions should be coerced when it's safe to do so +(+ 2.3 (ann 3 Real)) ; safe +(+ 2.3 (* (ann 2 Integer) 3.2)) ; inner = unsafe, outer = safe +(* 2.3 (* (ann 2 Integer) 3.1)) ; all unsafe diff --git a/collects/typed-scheme/optimizer/float-complex.rkt b/collects/typed-scheme/optimizer/float-complex.rkt index 534933a4aa..60f0ee0846 100644 --- a/collects/typed-scheme/optimizer/float-complex.rkt +++ b/collects/typed-scheme/optimizer/float-complex.rkt @@ -241,7 +241,7 @@ ;; special handling of reals inside complex operations ;; must be after any cases that we are supposed to handle - (pattern e:float-coerce-expr + (pattern e:float-arg-expr #:with real-binding (unboxed-gensym 'unboxed-float-) #:with imag-binding #f #:when (log-optimization "float-coerce-expr in complex ops" #'e) @@ -252,7 +252,7 @@ ;; we can eliminate boxing that was introduced by the user (pattern (#%plain-app (~and op (~or (~literal make-rectangular) (~literal unsafe-make-flrectangular))) - real:float-coerce-expr imag:float-coerce-expr) + real:float-arg-expr imag:float-arg-expr) #:with real-binding (unboxed-gensym "unboxed-real-") #:with imag-binding (unboxed-gensym "unboxed-imag-") #:with (bindings ...) @@ -260,7 +260,7 @@ #'(((real-binding) real.opt) ((imag-binding) imag.opt)))) (pattern (#%plain-app (~and op (~literal make-polar)) - r:float-coerce-expr theta:float-coerce-expr) + r:float-arg-expr theta:float-arg-expr) #:with magnitude (unboxed-gensym) #:with angle (unboxed-gensym) #:with real-binding (unboxed-gensym "unboxed-real-") diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index 13b51f7e4f..3b3d98e52b 100644 --- a/collects/typed-scheme/optimizer/float.rkt +++ b/collects/typed-scheme/optimizer/float.rkt @@ -7,7 +7,7 @@ (types numeric-tower) (optimizer utils fixnum)) -(provide float-opt-expr float-coerce-expr) +(provide float-opt-expr float-arg-expr) (define (mk-float-tbl generic) @@ -50,15 +50,6 @@ #:with opt ((optimize) #'e))) -;; generates coercions to floats -(define-syntax-class float-coerce-expr - #:commit - (pattern e:float-arg-expr - #:with opt #'e.opt) - (pattern e:real-expr - #:with opt #'(exact->inexact e.opt))) - - ;; if the result of an operation is of type float, its non float arguments ;; can be promoted, and we can use unsafe float operations ;; note: none of the unary operations have types where non-float arguments @@ -76,7 +67,12 @@ (pattern e:int-expr #:with opt #'(->fl e.opt)) (pattern e:float-expr - #:with opt #'e.opt)) + #:with opt #'e.opt) + ;; reals within float expressions are not always valid to optimize because + ;; of the exact 0 problem, but since float-opt-expr checks whether the + ;; surrounding expressing is of type Float and not just Real, this is safe + (pattern e:real-expr + #:with opt #'(exact->inexact e))) (define-syntax-class float-opt-expr #:commit