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

Fix name escape in tc/rec-lambda/check.

Browse Source 
original commit: 684bde6c6e3e5922d6c3779384df3e06032f8c9c
This commit is contained in:
Eric Dobson 2014-05-22 09:37:27 -07:00
parent 3d04add5d4
commit f48adc31a3
2 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
View File

@ -4,9 +4,11 @@
racket/dict racket/list syntax/parse racket/syntax syntax/stx
racket/match syntax/id-table racket/set
(contract-req)
(except-in (rep type-rep) make-arr)
(rename-in (except-in (types abbrev utils union) -> ->* one-of/c)
[make-arr* make-arr])
(rep type-rep)
(rename-in (types abbrev utils union)
[-> t:->]
[->* t:->*]
[one-of/c t:one-of/c])
(private type-annotation syntax-properties)
(types type-table)
(typecheck signatures tc-metafunctions tc-subst)
@ -30,7 +32,7 @@
(if rest (list (first rest)) null)
(if drest (list (first drest)) null)
kw-id)])
(make-arr
(make-arr*
arg-tys
(abstract-results body arg-names)
#:kws (map make-Keyword kw kw-ty req?)
@ -532,11 +534,9 @@
;; Returns both the tc-results of the function and of the body
(define (tc/rec-lambda/check formals* body name args return)
(define formals (syntax->list formals*))
(define ft (t:->* args (tc-results->values return)))
(with-lexical-env/extend
formals args
(let* ([ft (->* args (tc-results->values return))]
(with-lexical-env/extend
(list name) (list ft)
(values
(replace-names (map (λ (f) (list f -empty-obj)) formals) (ret ft))
(replace-names (map (λ (f) (list f -empty-obj)) formals) (tc-body/check body return)))))))
(cons name formals) (cons ft args)
(values
(replace-names (map (λ (f) (list f -empty-obj)) (cons name formals)) (ret ft))
(replace-names (map (λ (f) (list f -empty-obj)) (cons name formals)) (tc-body/check body return)))))

5
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -2987,7 +2987,12 @@
#:ret (ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))
#:expected (ret (-polydots (a ...) (->... (list) ((-val #f) a) (-val #f))))]
[tc-e
((letrec ([lp (lambda (x) lp)]) lp) 'y)
#:ret (ret (t:-> -Symbol Univ))
#:expected (ret (t:-> -Symbol Univ) -no-filter -no-obj)]
)
(test-suite
"tc-literal tests"
(tc-l 5 -PosByte)