suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Eliminate user-introduced boxing.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-30 11:59:38 -04:00
parent 551ef5ba30
commit b47a77dd57
5 changed files with 64 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt Normal file
View File

@ -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))

21
collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-make-rectangular.rkt Normal file
View File

@ -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)

8
collects/tests/typed-scheme/optimizer/non-optimized/unboxed-make-rectangular.rkt Normal file
View File

@ -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))

15
collects/typed-scheme/optimizer/float.rkt
View File

@ -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

31
collects/typed-scheme/optimizer/inexact-complex.rkt
View File

@ -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)