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

Make sure that let-bound functions don't escape through a rhs before we change their interface.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-29 13:55:19 -04:00
parent 435407b37a
commit 260de85a6e
4 changed files with 34 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -0,0 +1,7 @@
#lang typed/scheme #:optimize
(require racket/unsafe/ops)
(letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
(g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
(f 1.0+2.0i))

17
collects/tests/typed-scheme/optimizer/hand-optimized/unboxed-let-functions8.rkt Normal file
View File

@ -0,0 +1,17 @@
#lang racket
(require racket/unsafe/ops)
(letrec-values (((f) (lambda (x)
(let*-values (((unboxed-gensym-1) x)
((unboxed-gensym-2) (unsafe-flreal-part unboxed-gensym-1))
((unboxed-gensym-3) (unsafe-flimag-part unboxed-gensym-1))
((unboxed-gensym-4) 2.0+4.0i)
((unboxed-gensym-5) (unsafe-flreal-part unboxed-gensym-4))
((unboxed-gensym-6) (unsafe-flimag-part unboxed-gensym-4))
((unboxed-gensym-7) (unsafe-fl+ unboxed-gensym-2 unboxed-gensym-5))
((unboxed-gensym-8) (unsafe-fl+ unboxed-gensym-3 unboxed-gensym-6)))
(unsafe-make-flrectangular unboxed-gensym-7 unboxed-gensym-8))))
((g) f))
(f 1.0+2.0i))
(void)

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

@ -0,0 +1,7 @@
#lang typed/scheme
(require racket/unsafe/ops)
(letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
(g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
(f 1.0+2.0i))

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

@ -46,7 +46,8 @@
(define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
#:literal-sets (kernel-literals)
(pattern (~and exp (letk:let-like-keyword
(clause:expr ...) body:expr ...))
((~and clause (lhs rhs ...)) ...)
body:expr ...))
;; we look for bindings of complexes that are not mutated and only
;; used in positions where we would unbox them
;; these are candidates for unboxing
@ -74,6 +75,7 @@
(and
;; if the function escapes, we can't change it's interface
(not (is-var-mutated? fun-name))
(not (escapes? fun-name #'(begin rhs ... ...) #f))
(not (escapes? fun-name #'(begin body ...) let-loop?))
(match (type-of (cadr p)) ; rhs, we want a lambda
[(tc-result1: (Function: (list (arr: doms rngs