diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt index d51e501c60..3efa697bed 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt @@ -9,8 +9,8 @@ ([cond-contracted tc-expr (syntax? . -> . tc-results/c)] [cond-contracted tc-expr/check (syntax? tc-results/c . -> . tc-results/c)] [cond-contracted tc-expr/check/t (syntax? tc-results/c . -> . Type/c)] - [cond-contracted tc-exprs ((listof syntax?) . -> . tc-results/c)] - [cond-contracted tc-exprs/check ((listof syntax?) tc-results/c . -> . tc-results/c)] + [cond-contracted tc-body (syntax? . -> . tc-results/c)] + [cond-contracted tc-body/check (syntax? tc-results/c . -> . tc-results/c)] [cond-contracted tc-expr/t (syntax? . -> . Type/c)] [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . tc-results/c)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt index 97ddceca9a..e14e5ee156 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt @@ -246,10 +246,11 @@ [(letrec-syntaxes+values stxs vals . body) (tc-expr/check (syntax/loc form (letrec-values vals . body)) expected)] ;; begin - [(begin e . es) (tc-exprs/check (syntax->list #'(e . es)) expected)] + [(begin . es) (tc-body/check #'es expected)] [(begin0 e . es) - (tc-exprs/check (syntax->list #'es) tc-any-results) - (tc-expr/check #'e expected)] + (begin0 + (tc-expr/check #'e expected) + (tc-body/check #'es tc-any-results))] ;; if [(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)] ;; lambda @@ -288,7 +289,7 @@ (tc-expr/check/type #'fun conv-type) (tc-expr #'fun))) (with-lexical-env/extend (list #'f) (list returned-fun-type) - (tc-exprs/check (syntax->list #'body) expected))] + (tc-body/check #'body expected))] ;; let [(let-values ([(name ...) expr] ...) . body) (tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)] @@ -399,10 +400,11 @@ (tc-expr (syntax/loc form (letrec-values vals . body)))] ;; begin - [(begin e . es) (tc-exprs (syntax->list #'(e . es)))] + [(begin . es) (tc-body #'es)] [(begin0 e . es) - (begin (tc-exprs (syntax->list #'es)) - (tc-expr #'e))] + (begin0 + (tc-expr #'e) + (tc-body #'es))] ;; other [_ (int-err "cannot typecheck unknown form : ~a" (syntax->datum form))])) @@ -435,17 +437,21 @@ #:return (or expected (ret (Un))) "expected single value, got multiple (or zero) values")])) -;; type-check a list of exprs, producing the type of the last one. -;; if the list is empty, the type is Void. -;; list[syntax[expr]] -> tc-result -(define (tc-exprs exprs) - (cond [(null? exprs) (ret -Void)] - [(null? (cdr exprs)) (tc-expr (car exprs))] - [else (tc-expr/check (car exprs) tc-any-results) - (tc-exprs (cdr exprs))])) +;; type-check a body of exprs, producing the type of the last one. +;; if the body is empty, the type is Void. +;; syntax[list[expr]] -> tc-results/c +(define (tc-body body) + (match (syntax->list body) + [(list) (ret -Void)] + [(list es ... e-final) + (for ((e es)) + (tc-expr/check e tc-any-results)) + (tc-expr e-final)])) -(define (tc-exprs/check exprs expected) - (cond [(null? exprs) (check-below (ret -Void) expected)] - [(null? (cdr exprs)) (tc-expr/check (car exprs) expected)] - [else (tc-expr/check (car exprs) tc-any-results) - (tc-exprs/check (cdr exprs) expected)])) +(define (tc-body/check body expected) + (match (syntax->list body) + [(list) (check-below (ret -Void) expected)] + [(list es ... e-final) + (for ((e es)) + (tc-expr/check e tc-any-results)) + (tc-expr/check e-final expected)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt index ad2e94104c..0ba7429090 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt @@ -94,7 +94,7 @@ null (and rest-ty (list (or rest (generate-temporary)) rest-ty)) (and drest (list (or rest (generate-temporary)) drest)) - (tc-exprs/check (syntax->list body) ret-ty)))) + (tc-body/check body ret-ty)))) ;; Check that the number of formal arguments is valid for the expected type. ;; Thus it must be able to accept the number of arguments that the expected ;; type has. So we check for two cases: if the function doesn't accept @@ -178,7 +178,7 @@ null #f #f - (tc-exprs (syntax->list body)))))) + (tc-body body))))) @@ -217,7 +217,7 @@ null #f (list rest-id (cons rest-type bound)) - (tc-exprs (syntax->list body))))))] + (tc-body body)))))] ;; Lambda with regular rest argument [rest-id (let ([rest-type (get-type rest-id #:default Univ)]) @@ -229,7 +229,7 @@ null (list rest-id rest-type) #f - (tc-exprs (syntax->list body)))))] + (tc-body body))))] ;; Lambda with no rest argument [else (with-lexical-env/extend @@ -239,7 +239,7 @@ null #f #f - (tc-exprs (syntax->list body))))]))])) + (tc-body body)))]))])) ;; positional: natural? - the number of positional arguments ;; rest: boolean? - if there is a positional argument @@ -512,4 +512,4 @@ [ft (make-Function (list t))]) (with-lexical-env/extend (list name) (list ft) - (begin (tc-exprs/check (syntax->list body) return) (ret ft)))))) + (begin (tc-body/check body return) (ret ft)))))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index 3a02293992..f5f8e10c69 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -84,8 +84,8 @@ ;; typecheck the body (run (if expected - (tc-exprs/check (syntax->list body) (erase-filter expected)) - (tc-exprs (syntax->list body)))))))) + (tc-body/check body (erase-filter expected)) + (tc-body body))))))) (define (tc-expr/maybe-expected/t e name) (define expecteds