Change tc-exprs to tc-body.
This commit is contained in:
parent
418ecc87e0
commit
19eaf47d10
|
@ -9,8 +9,8 @@
|
||||||
([cond-contracted tc-expr (syntax? . -> . tc-results/c)]
|
([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 (syntax? tc-results/c . -> . 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-exprs ((listof syntax?) . -> . tc-results/c)]
|
[cond-contracted tc-body (syntax? . -> . tc-results/c)]
|
||||||
[cond-contracted tc-exprs/check ((listof syntax?) tc-results/c . -> . 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 tc-expr/t (syntax? . -> . Type/c)]
|
||||||
[cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . tc-results/c)]))
|
[cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . tc-results/c)]))
|
||||||
|
|
||||||
|
|
|
@ -246,10 +246,11 @@
|
||||||
[(letrec-syntaxes+values stxs vals . body)
|
[(letrec-syntaxes+values stxs vals . body)
|
||||||
(tc-expr/check (syntax/loc form (letrec-values vals . body)) expected)]
|
(tc-expr/check (syntax/loc form (letrec-values vals . body)) expected)]
|
||||||
;; begin
|
;; begin
|
||||||
[(begin e . es) (tc-exprs/check (syntax->list #'(e . es)) expected)]
|
[(begin . es) (tc-body/check #'es expected)]
|
||||||
[(begin0 e . es)
|
[(begin0 e . es)
|
||||||
(tc-exprs/check (syntax->list #'es) tc-any-results)
|
(begin0
|
||||||
(tc-expr/check #'e expected)]
|
(tc-expr/check #'e expected)
|
||||||
|
(tc-body/check #'es tc-any-results))]
|
||||||
;; if
|
;; if
|
||||||
[(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]
|
[(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]
|
||||||
;; lambda
|
;; lambda
|
||||||
|
@ -288,7 +289,7 @@
|
||||||
(tc-expr/check/type #'fun conv-type)
|
(tc-expr/check/type #'fun conv-type)
|
||||||
(tc-expr #'fun)))
|
(tc-expr #'fun)))
|
||||||
(with-lexical-env/extend (list #'f) (list returned-fun-type)
|
(with-lexical-env/extend (list #'f) (list returned-fun-type)
|
||||||
(tc-exprs/check (syntax->list #'body) expected))]
|
(tc-body/check #'body expected))]
|
||||||
;; let
|
;; let
|
||||||
[(let-values ([(name ...) expr] ...) . body)
|
[(let-values ([(name ...) expr] ...) . body)
|
||||||
(tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)]
|
(tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)]
|
||||||
|
@ -399,10 +400,11 @@
|
||||||
(tc-expr (syntax/loc form (letrec-values vals . body)))]
|
(tc-expr (syntax/loc form (letrec-values vals . body)))]
|
||||||
|
|
||||||
;; begin
|
;; begin
|
||||||
[(begin e . es) (tc-exprs (syntax->list #'(e . es)))]
|
[(begin . es) (tc-body #'es)]
|
||||||
[(begin0 e . es)
|
[(begin0 e . es)
|
||||||
(begin (tc-exprs (syntax->list #'es))
|
(begin0
|
||||||
(tc-expr #'e))]
|
(tc-expr #'e)
|
||||||
|
(tc-body #'es))]
|
||||||
;; other
|
;; other
|
||||||
[_ (int-err "cannot typecheck unknown form : ~a" (syntax->datum form))]))
|
[_ (int-err "cannot typecheck unknown form : ~a" (syntax->datum form))]))
|
||||||
|
|
||||||
|
@ -435,17 +437,21 @@
|
||||||
#:return (or expected (ret (Un)))
|
#:return (or expected (ret (Un)))
|
||||||
"expected single value, got multiple (or zero) values")]))
|
"expected single value, got multiple (or zero) values")]))
|
||||||
|
|
||||||
;; type-check a list of exprs, producing the type of the last one.
|
;; type-check a body of exprs, producing the type of the last one.
|
||||||
;; if the list is empty, the type is Void.
|
;; if the body is empty, the type is Void.
|
||||||
;; list[syntax[expr]] -> tc-result
|
;; syntax[list[expr]] -> tc-results/c
|
||||||
(define (tc-exprs exprs)
|
(define (tc-body body)
|
||||||
(cond [(null? exprs) (ret -Void)]
|
(match (syntax->list body)
|
||||||
[(null? (cdr exprs)) (tc-expr (car exprs))]
|
[(list) (ret -Void)]
|
||||||
[else (tc-expr/check (car exprs) tc-any-results)
|
[(list es ... e-final)
|
||||||
(tc-exprs (cdr exprs))]))
|
(for ((e es))
|
||||||
|
(tc-expr/check e tc-any-results))
|
||||||
|
(tc-expr e-final)]))
|
||||||
|
|
||||||
(define (tc-exprs/check exprs expected)
|
(define (tc-body/check body expected)
|
||||||
(cond [(null? exprs) (check-below (ret -Void) expected)]
|
(match (syntax->list body)
|
||||||
[(null? (cdr exprs)) (tc-expr/check (car exprs) expected)]
|
[(list) (check-below (ret -Void) expected)]
|
||||||
[else (tc-expr/check (car exprs) tc-any-results)
|
[(list es ... e-final)
|
||||||
(tc-exprs/check (cdr exprs) expected)]))
|
(for ((e es))
|
||||||
|
(tc-expr/check e tc-any-results))
|
||||||
|
(tc-expr/check e-final expected)]))
|
||||||
|
|
|
@ -94,7 +94,7 @@
|
||||||
null
|
null
|
||||||
(and rest-ty (list (or rest (generate-temporary)) rest-ty))
|
(and rest-ty (list (or rest (generate-temporary)) rest-ty))
|
||||||
(and drest (list (or rest (generate-temporary)) drest))
|
(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.
|
;; 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
|
;; 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
|
;; type has. So we check for two cases: if the function doesn't accept
|
||||||
|
@ -178,7 +178,7 @@
|
||||||
null
|
null
|
||||||
#f
|
#f
|
||||||
#f
|
#f
|
||||||
(tc-exprs (syntax->list body))))))
|
(tc-body body)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -217,7 +217,7 @@
|
||||||
null
|
null
|
||||||
#f
|
#f
|
||||||
(list rest-id (cons rest-type bound))
|
(list rest-id (cons rest-type bound))
|
||||||
(tc-exprs (syntax->list body))))))]
|
(tc-body body)))))]
|
||||||
;; 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)])
|
||||||
|
@ -229,7 +229,7 @@
|
||||||
null
|
null
|
||||||
(list rest-id rest-type)
|
(list rest-id rest-type)
|
||||||
#f
|
#f
|
||||||
(tc-exprs (syntax->list body)))))]
|
(tc-body body))))]
|
||||||
;; Lambda with no rest argument
|
;; Lambda with no rest argument
|
||||||
[else
|
[else
|
||||||
(with-lexical-env/extend
|
(with-lexical-env/extend
|
||||||
|
@ -239,7 +239,7 @@
|
||||||
null
|
null
|
||||||
#f
|
#f
|
||||||
#f
|
#f
|
||||||
(tc-exprs (syntax->list body))))]))]))
|
(tc-body body)))]))]))
|
||||||
|
|
||||||
;; 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
|
||||||
|
@ -512,4 +512,4 @@
|
||||||
[ft (make-Function (list t))])
|
[ft (make-Function (list t))])
|
||||||
(with-lexical-env/extend
|
(with-lexical-env/extend
|
||||||
(list name) (list ft)
|
(list name) (list ft)
|
||||||
(begin (tc-exprs/check (syntax->list body) return) (ret ft))))))
|
(begin (tc-body/check body return) (ret ft))))))
|
||||||
|
|
|
@ -84,8 +84,8 @@
|
||||||
;; typecheck the body
|
;; typecheck the body
|
||||||
(run
|
(run
|
||||||
(if expected
|
(if expected
|
||||||
(tc-exprs/check (syntax->list body) (erase-filter expected))
|
(tc-body/check body (erase-filter expected))
|
||||||
(tc-exprs (syntax->list body))))))))
|
(tc-body body)))))))
|
||||||
|
|
||||||
(define (tc-expr/maybe-expected/t e name)
|
(define (tc-expr/maybe-expected/t e name)
|
||||||
(define expecteds
|
(define expecteds
|
||||||
|
|
Loading…
Reference in New Issue
Block a user