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

when result type is dotted, pass it through tc-expr/check

Browse Source 
svn: r15737

original commit: 5174bbb5f062011c2edfe7a0403071055830f55f
This commit is contained in:
Sam Tobin-Hochstadt 2009-08-14 20:27:53 +00:00
parent 1d9468f30a
commit dec8803f27
3 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/typed-scheme/typecheck/tc-app.ss
View File

@ -172,7 +172,8 @@
(define (do-ret t)
(match t
[(Values: (list (Result: ts _ _) ...)) (ret ts)]
[(ValuesDots: (list (Result: ts _ _) ...) dty dbound) (ret ts (for/list ([t ts]) (-FS null null)) (for/list ([t ts]) (make-Empty)) dty dbound)]))
[(ValuesDots: (list (Result: ts _ _) ...) dty dbound) (ret ts (for/list ([t ts]) (-FS null null)) (for/list ([t ts]) (make-Empty)) dty dbound)]
[_ (int-err "do-ret fails: ~a" t)]))
(define f-ty (single-value f))
;; produces the first n-1 elements of the list, and the last element
(define (split l) (let-values ([(f r) (split-at l (sub1 (length l)))])

9
collects/typed-scheme/typecheck/tc-expr-unit.ss
View File

@ -190,7 +190,8 @@
[((? Type? t1) (? Type? t2))
(unless (subtype t1 t2)
(tc-error/expr "Expected ~a, but got ~a" t2 t1))
expected]))
expected]
[(a b) (int-err "unexpected input for check-below: ~a ~a" a b)]))
(define (tc-expr/check/type form expected)
#;(syntax? Type/c . -> . tc-results?)
@ -205,13 +206,13 @@
;; typecheck form
(let ([ty (cond [(type-ascription form) => (lambda (ann)
(let ([r (tc-expr/check/internal form ann)])
(check-below r expected)
#;expected))]
(check-below r expected)))]
[else (tc-expr/check/internal form expected)])])
(match ty
[(tc-results: ts fs os)
(let ([ts* (do-inst form ts)])
(ret ts* fs os))]))))
(ret ts* fs os))]
[_ ty]))))
;; tc-expr/check : syntax tc-results -> tc-results
(define (tc-expr/check/internal form expected)

7
collects/typed-scheme/typecheck/tc-lambda-unit.ss
View File

@ -66,8 +66,8 @@
(define (check-body)
(with-lexical-env/extend
arg-list arg-types
(make lam-result (map list arg-list arg-types) null rest-ty drest
(tc-exprs/check (syntax->list body) ret-ty))))
(make-lam-result (map list arg-list arg-types) null rest-ty drest
(tc-exprs/check (syntax->list body) ret-ty))))
(when (or (not (= arg-len tys-len))
(and (or rest-ty drest) (not rest)))
(tc-error/delayed (expected-str tys-len rest-ty drest arg-len rest)))
@ -221,7 +221,8 @@
[(tc-result1: (Function: _)) (tc/mono-lambda/type formals bodies expected)]
[(tc-result1: (or (Poly: _ _) (PolyDots: _ _)))
(tc/plambda form formals bodies expected)]
[(tc-result1: (Error:)) (tc/mono-lambda/type formals bodies #f)]))
[(tc-result1: (Error:)) (tc/mono-lambda/type formals bodies #f)]
[_ (int-err "expected not an appropriate tc-result: ~a" expected)]))
(match expected
[(tc-result1: (and t (Poly-names: ns expected*)))
(let* ([tvars (let ([p (syntax-property form 'typechecker:plambda)])