From b47a77dd57a4ed92f49cd92253c6c06905923f9f Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 30 Jul 2010 11:59:38 -0400 Subject: [PATCH] Eliminate user-introduced boxing. --- .../generic/unboxed-make-rectangular.rkt | 8 +++++ .../unboxed-make-rectangular.rkt | 21 +++++++++++++ .../unboxed-make-rectangular.rkt | 8 +++++ collects/typed-scheme/optimizer/float.rkt | 15 ++++++++- .../optimizer/inexact-complex.rkt | 31 ++++++++----------- 5 files changed, 64 insertions(+), 19 deletions(-) create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-make-rectangular.rkt create mode 100644 collects/tests/typed-scheme/optimizer/non-optimized/unboxed-make-rectangular.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt new file mode 100644 index 0000000000..87d3f05d22 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt @@ -0,0 +1,8 @@ +#lang typed/scheme #:optimize + +(require racket/unsafe/ops) + +(let ((x (make-rectangular 1.0 2.0))) + (+ x 2.0+4.0i)) +(let ((x (unsafe-make-flrectangular 1.0 2.0))) + (+ x 2.0+4.0i)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-make-rectangular.rkt new file mode 100644 index 0000000000..3d05b4e130 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-make-rectangular.rkt @@ -0,0 +1,21 @@ +#lang racket + +(require racket/unsafe/ops) + +(let*-values (((unboxed-gensym-1) 1.0) + ((unboxed-gensym-2) 2.0) + ((unboxed-gensym-3) 2.0+4.0i) + ((unboxed-gensym-4) (unsafe-flreal-part unboxed-gensym-3)) + ((unboxed-gensym-5) (unsafe-flimag-part unboxed-gensym-3)) + ((unboxed-gensym-6) (unsafe-fl+ unboxed-gensym-1 unboxed-gensym-4)) + ((unboxed-gensym-7) (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))) + (unsafe-make-flrectangular unboxed-gensym-6 unboxed-gensym-7)) +(let*-values (((unboxed-gensym-1) 1.0) + ((unboxed-gensym-2) 2.0) + ((unboxed-gensym-3) 2.0+4.0i) + ((unboxed-gensym-4) (unsafe-flreal-part unboxed-gensym-3)) + ((unboxed-gensym-5) (unsafe-flimag-part unboxed-gensym-3)) + ((unboxed-gensym-6) (unsafe-fl+ unboxed-gensym-1 unboxed-gensym-4)) + ((unboxed-gensym-7) (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))) + (unsafe-make-flrectangular unboxed-gensym-6 unboxed-gensym-7)) +(void) diff --git a/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-make-rectangular.rkt new file mode 100644 index 0000000000..9748b1e671 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/non-optimized/unboxed-make-rectangular.rkt @@ -0,0 +1,8 @@ +#lang typed/scheme + +(require racket/unsafe/ops) + +(let ((x (make-rectangular 1.0 2.0))) + (+ x 2.0+4.0i)) +(let ((x (unsafe-make-flrectangular 1.0 2.0))) + (+ x 2.0+4.0i)) diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index b797021216..17917d4424 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 float-expr int-expr) +(provide float-opt-expr float-expr int-expr float-coerce-expr) (define (mk-float-tbl generic) @@ -40,6 +40,19 @@ (pattern e:expr #:when (subtypeof? #'e -Integer) #:with opt ((optimize) #'e))) +(define-syntax-class real-expr + (pattern e:expr + #:when (subtypeof? #'e -Real) + #:with opt ((optimize) #'e))) + + +;; generates coercions to floats +(define-syntax-class float-coerce-expr + (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 diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index 0526c42e38..d18ac9f0b1 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -224,6 +224,17 @@ (begin (log-optimization "unboxed unary inexact complex" #'op) #'(c.bindings ...))) + ;; 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) + #:with real-binding (unboxed-gensym) + #:with imag-binding (unboxed-gensym) + #:with (bindings ...) + (begin (log-optimization "make-rectangular elimination" #'op) + #`(((real-binding) real.opt) + ((imag-binding) imag.opt)))) + ;; if we see a variable that's already unboxed, use the unboxed bindings (pattern v:id #:with unboxed-info (dict-ref unboxed-vars-table #'v #f) @@ -243,27 +254,11 @@ ((real-binding) (unsafe-flreal-part e*)) ((imag-binding) (unsafe-flimag-part e*)))) ;; special handling of reals - (pattern e:float-expr + (pattern e:float-coerce-expr #:with real-binding (unboxed-gensym) #:with imag-binding #f #:with (bindings ...) - #`(((real-binding) #,((optimize) #'e)))) - (pattern e:fixnum-expr - #:with real-binding (unboxed-gensym) - #:with imag-binding #f - #:with (bindings ...) - #`(((real-binding) (unsafe-fx->fl #,((optimize) #'e))))) - (pattern e:int-expr - #:with real-binding (unboxed-gensym) - #:with imag-binding #f - #:with (bindings ...) - #`(((real-binding) (->fl #,((optimize) #'e))))) - (pattern e:expr - #:when (isoftype? #'e -Real) - #:with real-binding (unboxed-gensym) - #:with imag-binding #f - #:with (bindings ...) - #`(((real-binding) (exact->inexact #,((optimize) #'e))))) + #`(((real-binding) e.opt))) (pattern e:expr #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not #:with e* (unboxed-gensym)