From cd0c71d923db3aea4a47e96d55bf38b18857b806 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 11 May 2010 15:00:33 -0400 Subject: [PATCH] Finish het vectors original commit: ec14f2c0b81ee4e5052555cbdabfd0a53c821bec --- collects/tests/typed-scheme/succeed/het-vec.ss | 4 ++-- collects/typed-scheme/typecheck/tc-app.rkt | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/collects/tests/typed-scheme/succeed/het-vec.ss b/collects/tests/typed-scheme/succeed/het-vec.ss index 97e4cf65..e261c092 100644 --- a/collects/tests/typed-scheme/succeed/het-vec.ss +++ b/collects/tests/typed-scheme/succeed/het-vec.ss @@ -1,10 +1,10 @@ #lang typed/scheme -(ann (vector-ref #(1 'foo 3) 0) Integer) +(ann (vector-ref #(1 foo 3) 0) Integer) (define: x : (Vector Number String Symbol) (vector 1 "foo" 'bar)) (define: y : 2 2) (ann (vector-ref x 1) String) -(ann (vector-ref x y) Symbol) \ No newline at end of file +(ann (vector-ref x y) Symbol) diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt index bc429eca..c95f0a6a 100644 --- a/collects/typed-scheme/typecheck/tc-app.rkt +++ b/collects/typed-scheme/typecheck/tc-app.rkt @@ -435,15 +435,15 @@ (let ([e-t (single-value #'e)]) (match (single-value #'v) [(tc-result1: (and t (HeterogenousVector: es))) - (let ([ival (or (and (number? (syntax-e #'i)) (syntax-e #'i)) + (let ([ival (or (syntax-parse #'e [((~literal quote) i:number) (syntax-e #'i)] [_ #f]) (match e-t [(tc-result1: (Value: (? number? i))) i] [_ #f]))]) (cond [(not ival) (check-below e-t -Nat) (if expected - (check-below (apply Un es) expected) - (apply (Un es)))] + (check-below (ret (apply Un es)) expected) + (ret (apply (Un es))))] [(and (integer? ival) (exact? ival) (<= 0 ival (sub1 (length es)))) (if expected (check-below (ret (list-ref es ival)) expected) @@ -463,7 +463,7 @@ (ret (make-HeterogenousVector (map tc-expr/t (syntax->list #'(args ...)))))] [(tc-result1: (Vector: t)) (for ([e (in-list (syntax->list #'(args ...)))]) - (tc-expr/check e t)) + (tc-expr/check e (ret t))) expected] [(tc-result1: (HeterogenousVector: ts)) (unless (= (length ts) (length (syntax->list #'(args ...)))) @@ -472,7 +472,7 @@ (make-HeterogenousVector (map tc-expr/t (syntax->list #'(args ...)))))) (for ([e (in-list (syntax->list #'(args ...)))] [t (in-list ts)]) - (tc-expr/check e t)) + (tc-expr/check e (ret t))) expected] [(tc-result1: t) (tc-error/expr "expected ~a, but got ~a" t (make-HeterogenousVector (map tc-expr/t (syntax->list #'(args ...)))))