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

Change tc-exprs to tc-body.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-27 00:48:46 -07:00
parent 418ecc87e0
commit 19eaf47d10
4 changed files with 36 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/signatures.rkt
View File

@ -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)]))

46
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -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)]))

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

@ -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))))))

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt
View File

@ -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