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

Fix special case for expected unions of vectors.

Browse Source 
Closes PR 12845.

original commit: ccf79943ab6af0655adcb3f05d13f8f131651c4a
This commit is contained in:
Sam Tobin-Hochstadt 2012-07-14 21:47:23 -04:00
parent 57358149cb
commit 4a2fb49431
2 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-racket/succeed/vector-union.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang typed/racket
(: v (U (Vector String) (Vector Symbol)))
;(define v (vector "hello"))
(define v (vector 'hello))

38
collects/typed-racket/typecheck/tc-app.rkt
View File

@ -477,22 +477,34 @@
expected]
[(tc-result1: (? needs-resolving? e) f o)
(loop (ret (resolve-once e) f o))]
[(tc-result1: (and T (Union: (app (λ (ts)
(for/list ([t ts]
#:when (let ([k (Type-key t)])
(eq? 'vector k)))
t))
ts))))
(if (null? ts)
(let ([arg-tys (map single-value (syntax->list #'(args ...)))])
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected))
(check-below (for/first ([t ts]) (loop (ret t)))
expected))]
;; If the expected type is a union, then we examine just the parts
;; of the union that are vectors. If there's only one of those,
;; we re-run this whole algorithm with that. Otherwise, we treat
;; it like any other expected type.
[(tc-result1: (Union: ts))
(define u-ts (for/list ([t (in-list ts)]
#:when (eq? 'vector (Type-key t)))
t))
(match u-ts
[(list)
(define arg-tys (map single-value (syntax->list #'(args ...))))
(tc/funapp #'op #'(args ...) (single-value #'op) arg-tys expected)]
[(list t0)
(check-below (loop (ret t0)) expected)]
[_
(check-below
(ret (make-HeterogenousVector (map (lambda (x) (generalize (tc-expr/t x)))
(syntax->list #'(args ...)))))
expected)])]
;; since vectors are mutable, if there is no expected type,
;; we want to generalize the element type
[(or #f (tc-result1: _))
(ret (make-HeterogenousVector (map (lambda (x) (generalize (tc-expr/t x)))
(syntax->list #'(args ...)))))]
((if expected
(lambda (t) (check-below t expected))
values)
(ret (make-HeterogenousVector (map (lambda (x) (generalize (tc-expr/t x)))
(syntax->list #'(args ...))))))]
[_ (int-err "bad expected: ~a" expected)]))]
;; since vectors are mutable, if there is no expected type,
;; we want to generalize the element type