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

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

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