Don't shortcut simple letrec forms that aren't lambdas.

Closes PR 12841.

original commit: 2500dad8f124429fc5b035fc58add891f2bd7bb8
This commit is contained in:
Sam Tobin-Hochstadt 2012-07-14 21:36:56 -04:00
parent c52317054a
commit 57358149cb
2 changed files with 16 additions and 1 deletions

View File

@ -0,0 +1,5 @@
#lang typed/racket
(: f (Pair 'bad 'worse))
(define f
(letrec ((y y)) y))

View File

@ -256,6 +256,15 @@
t))]
[else (tc-error/expr #:return (ret (Un)) #:stx stx (syntax-e msg))]))
;; check that `expr` doesn't evaluate any references
;; to `name` that aren't under `lambda`
;; value-restriction? : syntax identifier -> boolean
(define (value-restriction? expr name)
(syntax-parse expr
[((~literal #%plain-lambda) . _) #true]
[((~literal case-lambda) . _) #true]
[_ #false]))
;; tc-expr/check : syntax tc-results -> tc-results
(define/cond-contract (tc-expr/check/internal form expected)
(--> syntax? tc-results? tc-results?)
@ -356,7 +365,8 @@
[(let-values ([(name ...) expr] ...) . body)
(tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)]
[(letrec-values ([(name) expr]) name*)
#:when (and (identifier? #'name*) (free-identifier=? #'name #'name*))
#:when (and (identifier? #'name*) (free-identifier=? #'name #'name*)
(value-restriction? #'expr #'name))
(match expected
[(tc-result1: t)
(with-lexical-env/extend (list #'name) (list t) (tc-expr/check #'expr expected))]