# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1214933026 14400
# Node ID 275aaeb73f1fe714fbdace81c5bd5ad4ef98ab44
# Parent  7f9bcc8bfa1e041a5745e620d58d8b196a7dd424
Push KUnit and CUnit through the phases

diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/core.sml
--- a/src/core.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/core.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -34,6 +34,7 @@
        | KArrow of kind * kind
        | KName
        | KRecord of kind
+       | KUnit
 
 withtype kind = kind' located
 
@@ -54,6 +55,8 @@
        | CConcat of con * con
        | CFold of kind * kind
 
+       | CUnit
+
 withtype con = con' located
 
 datatype exp' =
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/core_print.sml
--- a/src/core_print.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/core_print.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -48,6 +48,7 @@
                                              p_kind k2])
       | KName => string "Name"
       | KRecord k => box [string "{", p_kind k, string "}"]
+      | KUnit => string "Unit"
 
 and p_kind k = p_kind' false k
 
@@ -135,6 +136,7 @@
                                               space,
                                               p_con env c2])
       | CFold _ => string "fold"
+      | CUnit => string "()"
         
 and p_con env = p_con' false env
 
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/core_util.sml
--- a/src/core_util.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/core_util.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -55,6 +55,8 @@
                 S.map2 (mfk k,
                         fn k' =>
                            (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
     in
         mfk
     end
@@ -149,6 +151,8 @@
                             S.map2 (mfk k2,
                                     fn k2' =>
                                        (CFold (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
     in
         mfc
     end
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/corify.sml
--- a/src/corify.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/corify.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -275,6 +275,7 @@
       | L.KArrow (k1, k2) => (L'.KArrow (corifyKind k1, corifyKind k2), loc)
       | L.KName => (L'.KName, loc)
       | L.KRecord k => (L'.KRecord (corifyKind k), loc)
+      | L.KUnit => (L'.KUnit, loc)
 
 fun corifyCon st (c, loc) =
     case c of
@@ -306,6 +307,7 @@
         (L'.CRecord (corifyKind k, map (fn (c1, c2) => (corifyCon st c1, corifyCon st c2)) xcs), loc)
       | L.CConcat (c1, c2) => (L'.CConcat (corifyCon st c1, corifyCon st c2), loc)
       | L.CFold (k1, k2) => (L'.CFold (corifyKind k1, corifyKind k2), loc)
+      | L.CUnit => (L'.CUnit, loc)
 
 fun corifyExp st (e, loc) =
     case e of
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/expl.sml
--- a/src/expl.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/expl.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -33,6 +33,7 @@
          KType
        | KArrow of kind * kind
        | KName
+       | KUnit
        | KRecord of kind
 
 withtype kind = kind' located
@@ -54,6 +55,8 @@
        | CConcat of con * con
        | CFold of kind * kind
 
+       | CUnit
+
 withtype con = con' located
 
 datatype exp' =
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/expl_print.sml
--- a/src/expl_print.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/expl_print.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -48,6 +48,7 @@
                                              p_kind k2])
       | KName => string "Name"
       | KRecord k => box [string "{", p_kind k, string "}"]
+      | KUnit => string "Unit"
 
 and p_kind k = p_kind' false k
 
@@ -144,6 +145,7 @@
                                               space,
                                               p_con env c2])
       | CFold _ => string "fold"
+      | CUnit => string "()"
         
 and p_con env = p_con' false env
 
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/expl_util.sml
--- a/src/expl_util.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/expl_util.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -55,6 +55,8 @@
                 S.map2 (mfk k,
                         fn k' =>
                            (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
     in
         mfk
     end
@@ -144,6 +146,8 @@
                             S.map2 (mfk k2,
                                     fn k2' =>
                                        (CFold (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
     in
         mfc
     end
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/explify.sml
--- a/src/explify.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/explify.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -38,7 +38,7 @@
       | L.KName => (L'.KName, loc)
       | L.KRecord k => (L'.KRecord (explifyKind k), loc)
 
-      | L.KUnit => raise Fail "Explify KUnit"
+      | L.KUnit => (L'.KUnit, loc)
 
       | L.KError => raise Fail ("explifyKind: KError at " ^ EM.spanToString loc)
       | L.KUnif (_, _, ref (SOME k)) => explifyKind k
@@ -65,7 +65,7 @@
       | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc)
       | L.CFold (dom, ran) => (L'.CFold (explifyKind dom, explifyKind ran), loc)
 
-      | L.CUnit => raise Fail "Explify CUnit"
+      | L.CUnit => (L'.CUnit, loc)
 
       | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc)
       | L.CUnif (_, _, _, ref (SOME c)) => explifyCon c
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f src/monoize.sml
--- a/src/monoize.sml	Tue Jul 01 13:19:14 2008 -0400
+++ b/src/monoize.sml	Tue Jul 01 13:23:46 2008 -0400
@@ -72,6 +72,7 @@
           | L.CRecord _ => poly ()
           | L.CConcat _ => poly ()
           | L.CFold _ => poly ()
+          | L.CUnit => poly ()
     end
 
 val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
diff -r 7f9bcc8bfa1e -r 275aaeb73f1f tests/disjoint.lac
--- a/tests/disjoint.lac	Tue Jul 01 13:19:14 2008 -0400
+++ b/tests/disjoint.lac	Tue Jul 01 13:23:46 2008 -0400
@@ -31,3 +31,5 @@
 val vtX = v2 [#A] [[B = float, B = string]] {A = 8, B = 8.0, B = "8"}
 val vtX = v2 [#A] [[A = float, B = string]] {A = 8, A = 8.0, B = "8"}
 *)
+
+val main = vt6