(module union mzscheme
  (require "" "" ""
           "" ""
  (require (lib "") (lib "") (lib ""))
  (provide Un #;(rename *Un Un))
  (define (make-union* set)
    (match set
      [(list t) t]
      [_ (make-Union set)]))
  (define empty-union (make-Union null))
  (define Un
      [() empty-union]
       (define (flat t) 
         (match t
           [(Union: es) es]
           [_ (list t)]))    
       (define (Values-types t) (match t [(Values: ts) ts]))
       (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))])))
       ;; a is a Type (not a union type)
       ;; b is a List[Type]
       (define (union2 a b)     
         (define b* (make-union* b))
           [(subtype a b*) (list b*)]
           [(subtype b* a) (list a)]            
           [else (cons a b)]))
       (let ([types (remove-dups (sort (apply append (map flat args)) type<?))])
           [(null? types) (make-union* null)]
           [(andmap Values? types)
            (make-Values (apply map Un (map Values-types types)))]
           [(ormap Values? types)
            (int-err "Un: should not take the union of multiple values with some other type: ~a" types)]
           [else (make-union* #;(remove-subtypes types) (foldr union2 null types))]))]))
  #;(defintern (Un-intern args) (lambda (_ args) (apply Un args)) args)
  #;(define (*Un . args) (Un-intern args))
  ;(trace Un)
  (define (u-maker args) (apply Un args))
  ;(trace u-maker)
  (set-union-maker! u-maker)