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

Extended use-site analysis to look through trivial rebindings, to support for loops.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-29 17:25:44 -04:00
parent 914f142f4f
commit 27f8279711
4 changed files with 75 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(for/fold: : Inexact-Complex ((sum : Inexact-Complex 0.0+0.0i))
((i : Inexact-Complex '(1.0+2.0i 2.0+4.0i)))
(+ i sum))

44
collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-for.rkt Normal file
View File

@ -0,0 +1,44 @@
#lang racket
(require racket/unsafe/ops)
(let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?)
(let-values (((i) '(1.0+2.0i 2.0+4.0i)))
(values
unsafe-car
unsafe-cdr
i
(lambda (x) (not (null? x)))
(lambda (x) #t)
(lambda (x y) #t)))))
(void)
(let*-values (((unboxed-gensym-1) '0.0+0.0i)
((unboxed-gensym-2) (unsafe-flreal-part unboxed-gensym-1))
((unboxed-gensym-3) (unsafe-flimag-part unboxed-gensym-1)))
((letrec-values
(((for-loop)
(lambda (unboxed-real-1 unboxed-imag-2 pos)
(if (pos-cont? pos)
(let*-values (((unboxed-gensym-1) (pos->vals pos))
((unboxed-gensym-2) (unsafe-flreal-part unboxed-gensym-1))
((unboxed-gensym-3) (unsafe-flimag-part unboxed-gensym-1)))
(if (val-cont? (unsafe-make-flrectangular unboxed-gensym-2 unboxed-gensym-3))
(let-values (((sum)
(let-values ()
(let-values ()
(let*-values (((unboxed-gensym-1) (unsafe-fl+ unboxed-gensym-2 unboxed-real-1))
((unboxed-gensym-2) (unsafe-fl+ unboxed-gensym-3 unboxed-imag-2)))
(unsafe-make-flrectangular unboxed-gensym-1 unboxed-gensym-2))))))
(if (all-cont? pos (unsafe-make-flrectangular unboxed-gensym-2 unboxed-gensym-3))
(let*-values (((unboxed-gensym-1) sum)
((unboxed-gensym-2) (unsafe-flreal-part unboxed-gensym-1))
((unboxed-gensym-3) (unsafe-flimag-part unboxed-gensym-1)))
(for-loop unboxed-gensym-2 unboxed-gensym-3 (pos-next pos)))
sum))
(unsafe-make-flrectangular unboxed-real-1 unboxed-imag-2)))
(unsafe-make-flrectangular unboxed-real-1 unboxed-imag-2)))))
for-loop)
unboxed-gensym-2
unboxed-gensym-3
init)))
(void)

7
collects/tests/typed-scheme/optimizer/non-optimized/unboxed-for.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang typed/scheme
(require racket/unsafe/ops)
(for/fold: : Inexact-Complex ((sum : Inexact-Complex 0.0+0.0i))
((i : Inexact-Complex '(1.0+2.0i 2.0+4.0i)))
(+ i sum))

24
collects/typed-scheme/optimizer/unboxed-let.rkt
View File

@ -163,6 +163,23 @@
[exp:inexact-complex-arith-opt-expr
(or (direct-child-of? v #'exp)
(ormap rec (syntax->list #'exp)))]
;; if the variable gets rebound to something else, we look for unboxing
;; opportunities for the new variable too
;; this case happens in the expansion of the for macros, so we care
[(l:let-like-keyword
([ids e-rhs:expr] ...) e-body:expr ...)
#:with rebindings
(filter (lambda (x) x)
(map (syntax-parser
[((id) rhs)
#:when (and (identifier? #'rhs)
(free-identifier=? v #'rhs))
#'id]
[_ #f])
(syntax->list #'((ids e-rhs) ...))))
(or (look-at #'(e-rhs ... e-body ...))
(ormap (lambda (x) (could-be-unboxed-in? x exp))
(syntax->list #'rebindings)))]
;; recur down
[((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
@ -170,13 +187,6 @@
(look-at #'(e ...))]
[(case-lambda [formals e:expr ...] ...)
(look-at #'(e ... ...))]
[((~or (~literal let-values) (~literal letrec-values))
([ids e-rhs:expr] ...) e-body:expr ...)
(look-at #'(e-rhs ... e-body ...))]
[(letrec-syntaxes+values stx-bindings
([(ids ...) e-rhs:expr] ...)
e-body:expr ...)
(look-at #'(e-rhs ... e-body ...))]
[(kw:identifier expr ...)
#:when (ormap (lambda (k) (free-identifier=? k #'kw))
(list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression