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

Fixed types of let loop lambdas.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-29 16:59:18 -04:00
parent 260de85a6e
commit 914f142f4f
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -195,7 +195,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; let loop ;; let loop
(define (let-loop-check form lp actuals args body expected) (define (let-loop-check form lam lp actuals args body expected)
(syntax-parse #`(#,args #,body #,actuals) (syntax-parse #`(#,args #,body #,actuals)
#:literals (#%plain-app if null? pair? null) #:literals (#%plain-app if null? pair? null)
[((val acc ...) [((val acc ...)
@ -216,7 +216,7 @@
[t ann-ts]) [t ann-ts])
(tc-expr/check a (ret t))) (tc-expr/check a (ret t)))
;; then check that the function typechecks with the inferred types ;; then check that the function typechecks with the inferred types
(tc/rec-lambda/check form args body lp ts expected) (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
expected)] expected)]
;; special case `for/list' ;; special case `for/list'
[((val acc ...) [((val acc ...)
@ -234,7 +234,7 @@
[(tc-result1: (and t (Listof: _))) t] [(tc-result1: (and t (Listof: _))) t]
[_ #f]) [_ #f])
(generalize (-val '())))]) (generalize (-val '())))])
(tc/rec-lambda/check form args body lp (cons acc-ty ts) expected) (add-typeof-expr lam (tc/rec-lambda/check form args body lp (cons acc-ty ts) expected))
expected)] expected)]
;; special case when argument needs inference ;; special case when argument needs inference
[(_ body* _) [(_ body* _)
@ -246,7 +246,7 @@
(begin (check-below (tc-expr/t ac) infer-t) (begin (check-below (tc-expr/t ac) infer-t)
infer-t) infer-t)
(generalize (tc-expr/t ac)))))]) (generalize (tc-expr/t ac)))))])
(tc/rec-lambda/check form args body lp ts expected) (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
expected)])) expected)]))
@ -569,8 +569,7 @@
#:fail-unless expected #f #:fail-unless expected #f
#:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f #:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f
#:fail-unless (free-identifier=? #'lp #'lp*) #f #:fail-unless (free-identifier=? #'lp #'lp*) #f
(add-typeof-expr #'lam expected) (let-loop-check form #'lam #'lp #'actuals #'args #'body expected)]
(let-loop-check form #'lp #'actuals #'args #'body expected)]
;; special cases for classes ;; special cases for classes
[(#%plain-app make-object cl . args) [(#%plain-app make-object cl . args)
(check-do-make-object #'cl #'args #'() #'())] (check-do-make-object #'cl #'args #'() #'())]