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

Finish het vectors

Browse Source 
original commit: ec14f2c0b81ee4e5052555cbdabfd0a53c821bec
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-11 15:00:33 -04:00
parent 094d75b4e6
commit cd0c71d923
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-scheme/succeed/het-vec.ss
View File

@ -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)
(ann (vector-ref x y) Symbol)

10
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -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 ...)))))