diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-sin.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-sin.rkt new file mode 100644 index 0000000000..144f45a9d7 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-sin.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +((lambda: ((t : Integer)) + (+ (sin (* t 6.28)) 0.0+0.0i)) + 1) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-sin.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-sin.rkt new file mode 100644 index 0000000000..d041747006 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-sin.rkt @@ -0,0 +1,11 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +((lambda: ((t : Integer)) + (let* ((unboxed-gensym-1 (exact->inexact (sin (* t 6.28)))) + (unboxed-gensym-2 0.0+0.0i) + (unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2)) + (unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2)) + (unboxed-gensym-5 (unsafe-fl+ unboxed-gensym-1 unboxed-gensym-3)) + (unboxed-gensym-6 unboxed-gensym-4)) + (unsafe-make-flrectangular unboxed-gensym-5 unboxed-gensym-6))) + 1) diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-sin.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-sin.rkt new file mode 100644 index 0000000000..d38cb3ae36 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-sin.rkt @@ -0,0 +1,5 @@ +#lang typed/scheme +(require racket/unsafe/ops) +((lambda: ((t : Integer)) + (+ (sin (* t 6.28)) 0.0+0.0i)) + 1) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index 07da71f9c5..99ec1c3842 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -206,7 +206,18 @@ #:with real-part (unboxed-gensym) #:with imag-part #f #:with (bindings ...) - #`((real-part (->fl #,((optimize) #'e)))))) + #`((real-part (->fl #,((optimize) #'e))))) + (pattern e:expr + #:when (isoftype? #'e -Real) + #:with real-part (unboxed-gensym) + #:with imag-part #f + #:with (bindings ...) + #`((real-part (exact->inexact #,((optimize) #'e))))) + (pattern e:expr + #:with (bindings ...) + (error "non exhaustive pattern match") + #:with real-part #f + #:with imag-part #f)) (define-syntax-class inexact-complex-unary-op (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part)