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

Add annotation to test.

Browse Source 
Fix default case for `vector-set!'

original commit: 21b5c25c90a323d443b9611d9c0d30d30afb7dea
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-14 10:58:55 -04:00
parent 479db80e36
commit 7b401c4e80
2 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,6 @@
#lang typed/scheme
(ann (vector-ref #(1 foo 3) 0) Integer)
(ann (vector-ref (ann #(1 foo 3) (Vector Integer Symbol Any)) 0) Integer)
(define: x : (Vector Number String Symbol) (vector 1 "foo" 'bar))

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

@ -456,7 +456,7 @@
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))]
[v-ty
(let ([arg-tys (list v-ty e-t)])
(tc/funapp #'op #'args (single-value #'op) arg-tys expected))]))]
(tc/funapp #'op #'(v e) (single-value #'op) arg-tys expected))]))]
[(#%plain-app (~and op (~literal vector-set!)) v e:expr val:expr)
(let ([e-t (single-value #'e)])
(match (single-value #'v)
@ -475,14 +475,17 @@
(check-below (ret -Void) expected)
(ret -Void))]
[(not (and (integer? ival) (exact? ival)))
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "expected exact integer for vector index, but got ~a" ival)]
[(< ival 0)
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too small for vector ~a" ival t)]
[(not (<= ival (sub1 (length es))))
(single-value #'val)
(tc-error/expr #:stx #'e #:return (or expected (ret (Un))) "index ~a too large for vector ~a" ival t)]))]
[v-ty
(let ([arg-tys (list v-ty e-t)])
(tc/funapp #'op #'args (single-value #'op) arg-tys expected))]))]
(let ([arg-tys (list v-ty e-t (single-value #'val))])
(tc/funapp #'op #'(v e val) (single-value #'op) arg-tys expected))]))]
[(#%plain-app (~and op (~literal vector)) args:expr ...)
(match expected
[(tc-result1: (Vector: t))