Remove tc/app/check.

This commit is contained in:
Eric Dobson 2014-05-13 00:26:31 -07:00
parent d683ef2342
commit ff1a852caf
4 changed files with 5 additions and 17 deletions

View File

@ -40,8 +40,7 @@
(values full-tc-results/c full-tc-results/c))])) (values full-tc-results/c full-tc-results/c))]))
(define-signature tc-app^ (define-signature tc-app^
([cond-contracted tc/app (syntax? . -> . full-tc-results/c)] ([cond-contracted tc/app (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
[cond-contracted tc/app/check (syntax? tc-results/c . -> . full-tc-results/c)]
[cond-contracted tc/app-regular (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)])) [cond-contracted tc/app-regular (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]))
(define-signature tc-apply^ (define-signature tc-apply^

View File

@ -130,7 +130,7 @@
#:when (eq? 'vector (Type-key t))) #:when (eq? 'vector (Type-key t)))
t)) t))
(match u-ts (match u-ts
[(list t0) (tc/app/check #'(#%plain-app . form) (ret t0))] [(list t0) (tc/app #'(#%plain-app . form) (ret t0))]
[_ (continue)])] [_ (continue)])]
;; since vectors are mutable, if there is no expected type, we want to generalize the element type ;; since vectors are mutable, if there is no expected type, we want to generalize the element type
[(or #f (tc-any-results: _) (tc-result1: _)) [(or #f (tc-any-results: _) (tc-result1: _))

View File

@ -37,8 +37,8 @@
tc/app-regular*) tc/app-regular*)
;; the main dispatching function ;; the main dispatching function
;; syntax tc-results/c -> tc-results/c ;; syntax (or/c tc-results/c #f) -> tc-results/c
(define (tc/app/internal form expected) (define (tc/app form expected)
(syntax-parse form (syntax-parse form
[(#%plain-app . (~var v (tc/app-special-cases expected))) [(#%plain-app . (~var v (tc/app-special-cases expected)))
((attribute v.check))])) ((attribute v.check))]))
@ -95,11 +95,3 @@
(single-value a)))] (single-value a)))]
[_ (map single-value args*)])) [_ (map single-value args*)]))
(tc/funapp #'f #'args f-ty arg-tys expected))])) (tc/funapp #'f #'args f-ty arg-tys expected))]))
;(trace tc/app/internal)
;; syntax -> tc-results
(define (tc/app form) (tc/app/internal form #f))
;; syntax tc-results/c -> tc-results/c
(define (tc/app/check form expected) (tc/app/internal form expected))

View File

@ -142,10 +142,7 @@
;(tc-expr/check #'e3 expected) ;(tc-expr/check #'e3 expected)
(tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t)])] (tc-error/expr "with-continuation-mark requires a continuation-mark-key, but got ~a" key-t)])]
;; application ;; application
[(#%plain-app . _) [(#%plain-app . _) (tc/app form expected)]
(if expected
(tc/app/check form expected)
(tc/app form))]
;; #%expression ;; #%expression
[(#%expression e) (tc/#%expression form expected)] [(#%expression e) (tc/#%expression form expected)]
;; syntax ;; syntax