From 98e88d615c6a3c38c87e71e7521275d238ea44cb Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Sat, 13 Sep 2014 10:47:36 -0400 Subject: [PATCH] Fix the TR fix in efd482c30ff80f My fix had just patched over a contract violation in a different function. This commit fixes the root of the problem. --- .../typed-racket-lib/typed-racket/private/type-annotation.rkt | 2 +- .../typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt | 3 +-- .../typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt | 3 +-- 3 files changed, 3 insertions(+), 5 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt index d9882460ff..26bf6053b0 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-annotation.rkt @@ -93,7 +93,7 @@ (tc-result -Bottom))] [(tc-results: tys fs os) (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" (length stxs) (length tys) (stringify tys)) (for/list ([stx (in-list stxs)] [ty (in-list tys)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index 4b6014c97f..b47e7e8646 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -218,8 +218,7 @@ (cond [(null? clauses) (k)] [else (match-define (lr-clause names expr) (car clauses)) - (match-define (or (tc-results: (list ts ...) _ (list os ...)) - (list (tc-result: ts _ os) ...)) + (match-define (list (tc-result: ts fs os) ...) (get-type/infer names expr (lambda (e) (tc-expr/maybe-expected/t e names)) tc-expr/check)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index cb1f0f5349..431ed3c0e6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -174,8 +174,7 @@ ;; the module (hence we haven't synthesized a type for yet). [_ (match (get-type/infer vars #'expr tc-expr tc-expr/check) - [(or (list (tc-result: ts) ...) - (tc-results: (list ts ...))) + [(list (tc-result: ts) ...) (for/list ([i (in-list vars)] [t (in-list ts)]) (register-type i t) (free-id-table-set! unann-defs i #t)