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

letrec: consider outside bindings safe.

Browse Source 
original commit: b045153177afe8aaebdbf179dbe27670b1cf577d
This commit is contained in:
Vincent St-Amour 2010-12-08 19:25:02 -05:00
parent bcb395b986
commit 2865f2801f
2 changed files with 5 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/typed-scheme/fail/safe-letrec.rkt
View File

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

8
collects/typed-scheme/typecheck/tc-let-unit.rkt
View File

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