diff --git a/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt new file mode 100644 index 0000000000..7201c0d439 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(+ 1.0+2.0i 2+4i) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/maybe-exact-complex.rkt new file mode 100644 index 0000000000..d62cc96f1a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/maybe-exact-complex.rkt @@ -0,0 +1,14 @@ +#lang racket + +(require racket/unsafe/ops) + +(let* ((unboxed-gensym-1 1.0+2.0i) + (unboxed-gensym-2 (unsafe-flreal-part unboxed-gensym-1)) + (unboxed-gensym-3 (unsafe-flimag-part unboxed-gensym-1)) + (unboxed-gensym-4 2+4i) + (unboxed-gensym-5 (exact->inexact (real-part unboxed-gensym-4))) + (unboxed-gensym-6 (exact->inexact (imag-part unboxed-gensym-4))) + (unboxed-gensym-7 (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5)) + (unboxed-gensym-8 (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6))) + (unsafe-make-flrectangular unboxed-gensym-7 unboxed-gensym-8)) +(void) diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/maybe-exact-complex.rkt new file mode 100644 index 0000000000..45d560d85e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/non-optimized/maybe-exact-complex.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme + +(require racket/unsafe/ops) + +(+ 1.0+2.0i 2+4i) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index 3eeaa32bc9..b1987878a0 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -254,11 +254,13 @@ #`((real-binding (exact->inexact #,((optimize) #'e))))) (pattern e:expr #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not + #:with e* (unboxed-gensym) #:with real-binding (unboxed-gensym) #:with imag-binding (unboxed-gensym) #:with (bindings ...) - #`((real-binding (real-part #,((optimize) #'e))) - (imag-binding (imag-part #,((optimize) #'e))))) + #`((e* #,((optimize) #'e)) + (real-binding (exact->inexact (real-part e*))) + (imag-binding (exact->inexact (imag-part e*))))) (pattern e:expr #:with (bindings ...) (error "non exhaustive pattern match")