fix union collapsing (#9)

turnstile/examples/stlc+union.rkt

@@ -58,7 +58,7 @@
      #:with ((~or (~U* ty1- ...) ty2-) ...) (stx-map (current-type-eval) #'tys)
      #:with tys- (prune+sort #'(ty1- ... ... ty2- ...))
      (if (= 1 (stx-length #'tys-))
-         (stx-car #'tys)
+         (stx-car #'tys-)
          #'(U* . tys-))]))
 (define-syntax Bool
   (make-variable-like-transformer

turnstile/examples/tests/stlc+union+case.rkt

@@ -37,6 +37,14 @@
 (define-type-alias NNN (U (U Nat Nat) (U (U Nat Nat Nat) (U Nat Nat))))
 (check-type ((λ ([x : NNN]) x) 1) : Nat -> 1)
 
+; check that pruning and collapsing don't throw away types when the union
+; contains another empty union
+(typecheck-fail
+ (λ ([x : (U (U) String)])
+   (ann x : (U)))
+ #:with-msg
+ "expected \\(U\\), given \\(U \\(U\\) String\\)")
+
 
 ;; tests from stlc+sub ---------------------
 (check-type 1 : Num)

turnstile/examples/tests/stlc+union.rkt

@@ -27,6 +27,14 @@
 (define-type-alias NNN (U (U Nat Nat) (U (U Nat Nat Nat) (U Nat Nat))))
 (check-type ((λ ([x : NNN]) x) 1) : Nat -> 1)
 
+; check that pruning and collapsing don't throw away types when the union
+; contains another empty union
+(typecheck-fail
+ (λ ([x : (U (U) String)])
+   (ann x : (U)))
+ #:with-msg
+ "expected \\(U\\), given \\(U \\(U\\) String\\)")
+
 
 ;; tests from stlc+sub ---------------------
 (check-type 1 : Num)