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

Fix the TR fix in efd482c30f

Browse Source 
My fix had just patched over a contract violation in a different
function. This commit fixes the root of the problem.
This commit is contained in:
Asumu Takikawa 2014-09-13 10:47:36 -04:00
parent 9810539a63
commit 98e88d615c
3 changed files with 3 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt
View File

@ -93,7 +93,7 @@
(tc-result -Bottom))] (tc-result -Bottom))]
[(tc-results: tys fs os) [(tc-results: tys fs os)
(if (not (= (length stxs) (length tys))) (if (not (= (length stxs) (length tys)))
(tc-error/expr #:return (ret (map (lambda _ (Un)) stxs)) (tc-error/expr #:return (map (lambda _ (tc-result (Un))) stxs)
"Expression should produce ~a values, but produces ~a values of types ~a" "Expression should produce ~a values, but produces ~a values of types ~a"
(length stxs) (length tys) (stringify tys)) (length stxs) (length tys) (stringify tys))
(for/list ([stx (in-list stxs)] [ty (in-list tys)] (for/list ([stx (in-list stxs)] [ty (in-list tys)]

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

@ -218,8 +218,7 @@
(cond [(null? clauses) (k)] (cond [(null? clauses) (k)]
[else [else
(match-define (lr-clause names expr) (car clauses)) (match-define (lr-clause names expr) (car clauses))
(match-define (or (tc-results: (list ts ...) _ (list os ...)) (match-define (list (tc-result: ts fs os) ...)
(list (tc-result: ts _ os) ...))
(get-type/infer names expr (get-type/infer names expr
(lambda (e) (tc-expr/maybe-expected/t e names)) (lambda (e) (tc-expr/maybe-expected/t e names))
tc-expr/check)) tc-expr/check))

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -174,8 +174,7 @@
;; the module (hence we haven't synthesized a type for yet). ;; the module (hence we haven't synthesized a type for yet).
[_ [_
(match (get-type/infer vars #'expr tc-expr tc-expr/check) (match (get-type/infer vars #'expr tc-expr tc-expr/check)
[(or (list (tc-result: ts) ...) [(list (tc-result: ts) ...)
(tc-results: (list ts ...)))
(for/list ([i (in-list vars)] [t (in-list ts)]) (for/list ([i (in-list vars)] [t (in-list ts)])
(register-type i t) (register-type i t)
(free-id-table-set! unann-defs i #t) (free-id-table-set! unann-defs i #t)