Remove tc-body, and 0 arg case in tc-body/check.

This commit is contained in:
Eric Dobson 2014-05-13 00:21:09 -07:00
parent 32db0e2ff7
commit d683ef2342
3 changed files with 9 additions and 12 deletions

View File

@ -9,7 +9,6 @@
([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)] ([cond-contracted tc-expr (syntax? . -> . full-tc-results/c)]
[cond-contracted tc-expr/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)] [cond-contracted tc-expr/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
[cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)] [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)]
[cond-contracted tc-body (syntax? . -> . full-tc-results/c)]
[cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)] [cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
[cond-contracted tc-expr/t (syntax? . -> . Type/c)] [cond-contracted tc-expr/t (syntax? . -> . Type/c)]
[cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)])) [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))

View File

@ -155,6 +155,8 @@
;; begin ;; begin
[(begin . es) [(begin . es)
(tc-body/check #'es expected)] (tc-body/check #'es expected)]
[(begin0 e)
(tc-expr/check #'e expected)]
[(begin0 e . es) [(begin0 e . es)
(begin0 (begin0
(tc-expr/check #'e expected) (tc-expr/check #'e expected)
@ -265,15 +267,11 @@
(with-lexical-env/extend-props props (with-lexical-env/extend-props props
(k))) (k)))
;; type-check a body of exprs, producing the type of the last one. ;; tc-body/check: syntax? tc-results? -> tc-results?
;; if the body is empty, the type is Void. ;; Body must be a non empty sequence of expressions to typecheck.
;; syntax[list[expr]] -> tc-results/c ;; The final one will be checked against expected.
(define (tc-body body)
(tc-body/check body #f))
(define (tc-body/check body expected) (define (tc-body/check body expected)
(match (syntax->list body) (match (syntax->list body)
[(list) (cond-check-below (ret -Void) expected)]
[(list es ... e-final) [(list es ... e-final)
(define ((continue es)) (define ((continue es))
(if (empty? es) (if (empty? es)

View File

@ -179,7 +179,7 @@
null null
#f #f
#f #f
(tc-body body))))) (tc-body/check body #f)))))
@ -218,7 +218,7 @@
null null
#f #f
(list rest-id (cons rest-type bound)) (list rest-id (cons rest-type bound))
(tc-body body)))))] (tc-body/check body #f)))))]
;; Lambda with regular rest argument ;; Lambda with regular rest argument
[rest-id [rest-id
(let ([rest-type (get-type rest-id #:default Univ)]) (let ([rest-type (get-type rest-id #:default Univ)])
@ -230,7 +230,7 @@
null null
(list rest-id rest-type) (list rest-id rest-type)
#f #f
(tc-body body))))] (tc-body/check body #f))))]
;; Lambda with no rest argument ;; Lambda with no rest argument
[else [else
(with-lexical-env/extend (with-lexical-env/extend
@ -240,7 +240,7 @@
null null
#f #f
#f #f
(tc-body body)))]))])) (tc-body/check body #f)))]))]))
;; positional: natural? - the number of positional arguments ;; positional: natural? - the number of positional arguments
;; rest: boolean? - if there is a positional argument ;; rest: boolean? - if there is a positional argument