diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt new file mode 100644 index 00000000..124b4cbd --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt @@ -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)) diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt index cac5f063..2b92412d 100644 --- a/collects/typed-scheme/optimizer/unboxed-let.rkt +++ b/collects/typed-scheme/optimizer/unboxed-let.rkt @@ -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