From 443d8b9f917055d051844bb1cd4078a75dcdd592 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 14 Jul 2010 10:24:14 -0400 Subject: [PATCH] Fixnums and integers can now be coerced for complex operations. --- .../generic/inexact-complex-fixnum.rkt | 3 ++ .../generic/inexact-complex-integer.rkt | 3 ++ .../hand-optimized/inexact-complex-fixnum.rkt | 13 ++++++++ .../inexact-complex-integer.rkt | 9 +++++ .../non-optimized/inexact-complex-fixnum.rkt | 3 ++ .../non-optimized/inexact-complex-integer.rkt | 3 ++ collects/typed-scheme/optimizer/float.rkt | 2 +- .../optimizer/inexact-complex.rkt | 33 +++++++++++-------- 8 files changed, 55 insertions(+), 14 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-integer.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-fixnum.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-integer.rkt create mode 100644 collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-fixnum.rkt create mode 100644 collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-integer.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt new file mode 100644 index 0000000000..3f99e88165 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt @@ -0,0 +1,3 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(+ 2 1.0+2.0i 3.0+6.0i) diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-integer.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-integer.rkt new file mode 100644 index 0000000000..9d85760b13 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-integer.rkt @@ -0,0 +1,3 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops racket/flonum) +(+ (expt 2 100) 1.0+2.0i) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-fixnum.rkt new file mode 100644 index 0000000000..37ab6b2c3d --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-fixnum.rkt @@ -0,0 +1,13 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops) +(let* ((unboxed-gensym-1 (unsafe-fx->fl 2)) + (unboxed-gensym-2 1.0+2.0i) + (unboxed-gensym-3 (unsafe-flreal-part unboxed-gensym-2)) + (unboxed-gensym-4 (unsafe-flimag-part unboxed-gensym-2)) + (unboxed-gensym-5 3.0+6.0i) + (unboxed-gensym-6 (unsafe-flreal-part unboxed-gensym-5)) + (unboxed-gensym-7 (unsafe-flimag-part unboxed-gensym-5)) + (unboxed-gensym-8 (unsafe-fl+ (unsafe-fl+ unboxed-gensym-1 unboxed-gensym-3) + unboxed-gensym-6)) + (unboxed-gensym-9 (unsafe-fl+ unboxed-gensym-4 unboxed-gensym-7))) + (unsafe-make-flrectangular unboxed-gensym-8 unboxed-gensym-9)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-integer.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-integer.rkt new file mode 100644 index 0000000000..9e10a66157 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/inexact-complex-integer.rkt @@ -0,0 +1,9 @@ +#lang typed/scheme #:optimize +(require racket/unsafe/ops racket/flonum) +(let* ((unboxed-gensym-1 (->fl (expt 2 100))) + (unboxed-gensym-2 1.0+2.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)) diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-fixnum.rkt new file mode 100644 index 0000000000..ffc9f04a0a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-fixnum.rkt @@ -0,0 +1,3 @@ +#lang typed/scheme +(require racket/unsafe/ops) +(+ 2 1.0+2.0i 3.0+6.0i) diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-integer.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-integer.rkt new file mode 100644 index 0000000000..9ea1b37fd1 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-integer.rkt @@ -0,0 +1,3 @@ +#lang typed/scheme +(require racket/unsafe/ops racket/flonum) +(+ (expt 2 100) 1.0+2.0i) diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index 2c9f02cb5c..549cc49343 100644 --- a/collects/typed-scheme/optimizer/float.rkt +++ b/collects/typed-scheme/optimizer/float.rkt @@ -7,7 +7,7 @@ (types abbrev type-table utils subtype) (optimizer utils fixnum)) -(provide float-opt-expr) +(provide float-opt-expr float-expr int-expr) (define (mk-float-tbl generic) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index f6ebbf0f56..60f10b3ef1 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -4,7 +4,7 @@ "../utils/utils.rkt" (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops) (types abbrev type-table utils subtype) - (optimizer utils)) + (optimizer utils float fixnum)) (provide inexact-complex-opt-expr) @@ -161,15 +161,6 @@ #`(#,@(append (syntax->list #'(c.bindings ...)) (list #'(imag-part (unsafe-fl- 0.0 c.imag-part))))))) (pattern e:expr - ;; special handling of inexact reals - #:when (subtypeof? #'e -Flonum) - #:with real-part (unboxed-gensym) - #:with imag-part #f - #:with (bindings ...) - #`((real-part #,((optimize) #'e)))) - (pattern e:expr - ;; can't work on inexact reals, which are a subtype of inexact - ;; complexes, so this has to be equality #:when (isoftype? #'e -InexactComplex) #:with e* (unboxed-gensym) #:with real-part (unboxed-gensym) @@ -177,7 +168,23 @@ #:with (bindings ...) #`((e* #,((optimize) #'e)) (real-part (unsafe-flreal-part e*)) - (imag-part (unsafe-flimag-part e*))))) + (imag-part (unsafe-flimag-part e*)))) + ;; special handling of reals + (pattern e:float-expr + #:with real-part (unboxed-gensym) + #:with imag-part #f + #:with (bindings ...) + #`((real-part #,((optimize) #'e)))) + (pattern e:fixnum-expr + #:with real-part (unboxed-gensym) + #:with imag-part #f + #:with (bindings ...) + #`((real-part (unsafe-fx->fl #,((optimize) #'e))))) + (pattern e:int-expr + #:with real-part (unboxed-gensym) + #:with imag-part #f + #:with (bindings ...) + #`((real-part (->fl #,((optimize) #'e)))))) (define-syntax-class inexact-complex-unary-op (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part) @@ -188,7 +195,7 @@ (define-syntax-class inexact-complex-expr (pattern e:expr - #:when (subtypeof? #'e -InexactComplex) + #:when (isoftype? #'e -InexactComplex) #:with opt ((optimize) #'e))) (define-syntax-class inexact-complex-opt-expr @@ -196,7 +203,7 @@ #:with opt (begin (log-optimization "unary inexact complex" #'op) #'(op.unsafe n.opt))) - (pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:inexact-complex-expr ...)) + (pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:expr ...)) #:when (isoftype? #'exp -InexactComplex) #:with exp*:unboxed-inexact-complex-opt-expr #'exp #:with opt