From 39eca53d555746b65aeaf7e616f8de2f637a4b6b Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 22 May 2009 21:19:46 +0000 Subject: [PATCH] Use tc-result1: instead of tc-result: in object handling. Use tc-results->values instead of bogus version. svn: r14937 original commit: 0feb99f6bc08fdff518cf9587438ab4e46493166 --- collects/typed-scheme/typecheck/check-subforms-unit.ss | 5 ++--- collects/typed-scheme/typecheck/tc-expr-unit.ss | 8 ++++---- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.ss b/collects/typed-scheme/typecheck/check-subforms-unit.ss index 3ab084dc..f31aa592 100644 --- a/collects/typed-scheme/typecheck/check-subforms-unit.ss +++ b/collects/typed-scheme/typecheck/check-subforms-unit.ss @@ -3,7 +3,7 @@ (require (except-in "../utils/utils.ss" extend)) (require syntax/kerncase scheme/match - "signatures.ss" + "signatures.ss" "tc-metafunctions.ss" (types utils convenience union subtype) (utils tc-utils) (rep type-rep)) @@ -61,8 +61,7 @@ [stx ;; this is a hander function (syntax-property form 'typechecker:exn-handler) - (tc-expr/check form (match expected - [(tc-result1: e) (ret (-> (Un) e))]))] + (tc-expr/check form (ret (-> (Un) (tc-results->values expected))))] [stx ;; this is the body of the with-handlers (syntax-property form 'typechecker:exn-body) diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index 576f21cd..d1bd665c 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -355,17 +355,17 @@ (define (tc/send rcvr method args [expected #f]) (match (tc-expr rcvr) - [(tc-result: (Instance: (and c (Class: _ _ methods)))) + [(tc-result1: (Instance: (and c (Class: _ _ methods)))) (match (tc-expr method) - [(tc-result: (Value: (? symbol? s))) + [(tc-result1: (Value: (? symbol? s))) (let* ([ftype (cond [(assq s methods) => cadr] [else (tc-error/expr "send: method ~a not understood by class ~a" s c)])] [ret-ty (tc/funapp rcvr args (ret ftype) (map tc-expr (syntax->list args)) expected)]) (if expected (begin (check-below ret-ty expected) (ret expected)) ret-ty))] - [(tc-result: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])] - [(tc-result: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)])) + [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])] + [(tc-result1: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)])) (define (single-value form [expected #f]) (define t (if expected (tc-expr/check form expected) (tc-expr form)))