From ddd166c7995d0ed0a181c8c8ecf0f408ebe13f47 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 6 Jan 2011 15:42:35 -0500
Subject: [PATCH] Make bare union constructor smarter.

original commit: 78c4809177e6781a42dd29dd9b0bb96c77fa0e01
---
 collects/typed-scheme/types/abbrev.rkt | 13 ++++++++++++-
 collects/typed-scheme/types/union.rkt  |  9 ++-------
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index c76aa1ce..fb089202 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -30,9 +30,20 @@
 (define -future make-Future)
 (define (-seq . args) (make-Sequence args))
 
+
+(define (flat t)
+  (match t
+    [(Union: es) es]
+    [(Values: (list (Result: (Union: es) _ _))) es]
+    [(Values: (list (Result: t _ _))) (list t)]
+    [_ (list t)]))
+
+;; Simple union constructor.
+;; Flattens nested unions and sorts types, but does not check for
+;; overlapping subtypes.
 (define-syntax *Un
   (syntax-rules ()
-    [(_ . args) (make-Union (list . args))]))
+    [(_ . args) (make-Union (remove-dups (sort (apply append (map flat (list . args))) type<?)))]))
 
 
 (define (make-Listof elem) (-mu list-rec (*Un (-val null) (-pair elem list-rec))))
diff --git a/collects/typed-scheme/types/union.rkt b/collects/typed-scheme/types/union.rkt
index e61c03c3..35a81a51 100644
--- a/collects/typed-scheme/types/union.rkt
+++ b/collects/typed-scheme/types/union.rkt
@@ -15,19 +15,14 @@
 
 (define empty-union (make-Union null))
 
-(define (flat t)
-  (match t
-    [(Union: es) es]
-    [(Values: (list (Result: (Union: es) _ _))) es]
-    [(Values: (list (Result: t _ _))) (list t)]
-    [_ (list t)]))
-
 (define (remove-subtypes ts)
   (let loop ([ts* ts] [result '()])
     (cond [(null? ts*) (reverse result)]
           [(ormap (lambda (t) (subtype (car ts*) t)) result) (loop (cdr ts*) result)]
           [else (loop (cdr ts*) (cons (car ts*) result))])))
 
+;; Union constructor
+;; Normalizes representation by sorting types.
 (define Un
   (case-lambda 
     [() empty-union]