From 2865f2801f60c63e73eb781b5cea8815fb694cc4 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 8 Dec 2010 19:25:02 -0500 Subject: [PATCH] letrec: consider outside bindings safe. original commit: b045153177afe8aaebdbf179dbe27670b1cf577d --- collects/tests/typed-scheme/fail/safe-letrec.rkt | 11 ----------- collects/typed-scheme/typecheck/tc-let-unit.rkt | 8 +++++--- 2 files changed, 5 insertions(+), 14 deletions(-) diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-scheme/fail/safe-letrec.rkt index febfb833..5e04f490 100644 --- a/collects/tests/typed-scheme/fail/safe-letrec.rkt +++ b/collects/tests/typed-scheme/fail/safe-letrec.rkt @@ -5,14 +5,3 @@ ;; make sure letrec takes into account that some bidings may be undefined (+ (letrec: ([x : Float x]) x) 1) ; PR 11511 - -(letrec: ([x : Number 3] - [y : Number z] ; bad - [z : Number x]) - z) - -(letrec: ([x : Number 3] - [y : (Number -> Number) (lambda (x) z)] ; bad - [z : Number x] - [w : (Number -> Number) (lambda (x) (y x))]) ; bad too - z) diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt index 447dba5a..2d8f6da3 100644 --- a/collects/typed-scheme/typecheck/tc-let-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt @@ -139,7 +139,7 @@ [transitively-safe-bindings '()]) ([names names] [clause clauses]) - (case (safe-letrec-values-clause? clause transitively-safe-bindings) + (case (safe-letrec-values-clause? clause transitively-safe-bindings flat-names) ;; transitively safe -> safe to mention in a subsequent rhs [(transitively-safe) (values (append names safe-bindings) (append names transitively-safe-bindings))] @@ -178,11 +178,13 @@ ;; Fixing Letrec (reloaded) paper), we are more conservative than a fully-connected component ;; based approach. On the other hand, our algorithm should cover most interesting cases and ;; is much simpler than Tarjan's. -(define (safe-letrec-values-clause? clause transitively-safe-bindings) +(define (safe-letrec-values-clause? clause transitively-safe-bindings letrec-bound-ids) (define clause-rhs (syntax-parse clause [(bindings . rhs) #'rhs])) - (cond [(andmap (lambda (fv) (s:member fv transitively-safe-bindings bound-identifier=?)) + (cond [(andmap (lambda (fv) + (or (not (s:member fv letrec-bound-ids bound-identifier=?)) ; from outside + (s:member fv transitively-safe-bindings bound-identifier=?))) (apply append (syntax-map (lambda (x) (free-vars x)) clause-rhs)))