From 4a2fb49431f3f8edabe85034f19b18d5584b580d Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sat, 14 Jul 2012 21:47:23 -0400
Subject: [PATCH] Fix special case for expected unions of vectors.

Closes PR 12845.

original commit: ccf79943ab6af0655adcb3f05d13f8f131651c4a
---
 .../typed-racket/succeed/vector-union.rkt     |  6 +++
 collects/typed-racket/typecheck/tc-app.rkt    | 38 ++++++++++++-------
 2 files changed, 31 insertions(+), 13 deletions(-)
 create mode 100644 collects/tests/typed-racket/succeed/vector-union.rkt

diff --git a/collects/tests/typed-racket/succeed/vector-union.rkt b/collects/tests/typed-racket/succeed/vector-union.rkt
new file mode 100644
index 00000000..27a3bd06
--- /dev/null
+++ b/collects/tests/typed-racket/succeed/vector-union.rkt
@@ -0,0 +1,6 @@
+#lang typed/racket
+
+
+(: v (U (Vector String) (Vector Symbol)))
+;(define v (vector "hello"))
+(define v (vector 'hello))
diff --git a/collects/typed-racket/typecheck/tc-app.rkt b/collects/typed-racket/typecheck/tc-app.rkt
index c0d9baf4..c3ceb05c 100644
--- a/collects/typed-racket/typecheck/tc-app.rkt
+++ b/collects/typed-racket/typecheck/tc-app.rkt
@@ -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