From 19e8efec0f960fbbe31b8468fb512ac3521189ac Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Mon, 9 May 2016 17:21:54 -0400
Subject: [PATCH] Avoid internal error on mismatched values

Fixes issue #342
---
 .../typed-racket/types/type-table.rkt         | 23 +++----------------
 typed-racket-test/fail/gh-issue-342.rkt       |  7 ++++++
 2 files changed, 10 insertions(+), 20 deletions(-)
 create mode 100644 typed-racket-test/fail/gh-issue-342.rkt

diff --git a/typed-racket-lib/typed-racket/types/type-table.rkt b/typed-racket-lib/typed-racket/types/type-table.rkt
index 036bddef..da997f39 100644
--- a/typed-racket-lib/typed-racket/types/type-table.rkt
+++ b/typed-racket-lib/typed-racket/types/type-table.rkt
@@ -11,7 +11,7 @@
          (contract-req)
          (rep type-rep)
          (types utils union printer)
-         (typecheck possible-domains)
+         (typecheck possible-domains tc-metafunctions)
          (utils tc-utils)
          (for-template racket/base))
 
@@ -65,28 +65,11 @@
            ;; the car should be the latest stx for the location
            (if (equal? e (car seen))
                ;; combine types seen at the latest
-               (tooltip seen ((combine t) results))
+               (tooltip seen (merge-tc-results (list t results)))
                old)
            (tooltip (cons e seen) t)))
      (tooltip (list e) t)))
-  (hash-update! type-table e (combine t) t))
-
-;; when typechecking a case-> type, types get added for
-;; the same subexpression multiple times, combine them
-(define ((combine new) old)
-  (match* (old new)
-    [((tc-result1: old-t) (tc-result1: t-t))
-     (ret (Un old-t t-t))]
-    [((tc-results: old-ts) (tc-results: t-ts))
-     ;; props don't matter at this point, since only
-     ;; the optimizer reads this table
-     ;;  -- "I think [the above] comment is no longer true" -samth
-     (unless (= (length old-ts) (length t-ts))
-       (int-err
-        "type table: number of values don't agree ~a ~a"
-        old-ts t-ts))
-     (ret (map Un old-ts t-ts))]
-    [(_ _) new])) ; irrelevant to the optimizer, just clobber
+  (hash-update! type-table e (λ (res) (merge-tc-results (list t res))) t))
 
 (define (type-of e)
   (hash-ref type-table e
diff --git a/typed-racket-test/fail/gh-issue-342.rkt b/typed-racket-test/fail/gh-issue-342.rkt
new file mode 100644
index 00000000..a802afc8
--- /dev/null
+++ b/typed-racket-test/fail/gh-issue-342.rkt
@@ -0,0 +1,7 @@
+#;
+(exn-pred 2)
+#lang typed/racket
+
+(: f (case→ (→ (→ (Values Any Any)) Any)
+            (→ 'sym Any)))
+(define (f g) (g))