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

original commit: 27f8279711ae93601c00d27c8041a017afdf592c
This commit is contained in:
Vincent St-Amour 2010-07-29 17:25:44 -04:00
parent db1103ebbc
commit fbb55c63c4
2 changed files with 24 additions and 7 deletions

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

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