Push KUnit and CUnit through the phases

9 files changed, 23 insertions, 2 deletions

diff --git a/src/core.sml b/src/core.sml
index 78f0cce0..badb08ea 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -34,6 +34,7 @@ datatype kind' =
        | KArrow of kind * kind
        | KName
        | KRecord of kind
+       | KUnit
 
 withtype kind = kind' located
 
@@ -54,6 +55,8 @@ datatype con' =
        | CConcat of con * con
        | CFold of kind * kind
 
+       | CUnit
+
 withtype con = con' located
 
 datatype exp' =
diff --git a/src/core_print.sml b/src/core_print.sml
index b6e611f4..935cfbac 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -48,6 +48,7 @@ fun p_kind' par (k, _) =
                                              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 @@ fun p_con' par env (c, _) =
                                               space,
                                               p_con env c2])
       | CFold _ => string "fold"
+      | CUnit => string "()"
         
 and p_con env = p_con' false env
 
diff --git a/src/core_util.sml b/src/core_util.sml
index 8a174d9e..f0a37356 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -55,6 +55,8 @@ fun mapfold f =
                 S.map2 (mfk k,
                         fn k' =>
                            (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
     in
         mfk
     end
@@ -149,6 +151,8 @@ fun mapfoldB {kind = fk, con = fc, bind} =
                             S.map2 (mfk k2,
                                     fn k2' =>
                                        (CFold (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
     in
         mfc
     end
diff --git a/src/corify.sml b/src/corify.sml
index 5dfd0db6..baff8182 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -275,6 +275,7 @@ fun corifyKind (k, loc) =
       | 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 @@ fun corifyCon st (c, loc) =
         (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 --git a/src/expl.sml b/src/expl.sml
index 87ca990e..b3bcf96b 100644
--- a/src/expl.sml
+++ b/src/expl.sml
@@ -33,6 +33,7 @@ datatype kind' =
          KType
        | KArrow of kind * kind
        | KName
+       | KUnit
        | KRecord of kind
 
 withtype kind = kind' located
@@ -54,6 +55,8 @@ datatype con' =
        | CConcat of con * con
        | CFold of kind * kind
 
+       | CUnit
+
 withtype con = con' located
 
 datatype exp' =
diff --git a/src/expl_print.sml b/src/expl_print.sml
index ab8462b8..447845a2 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -48,6 +48,7 @@ fun p_kind' par (k, _) =
                                              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 @@ fun p_con' par env (c, _) =
                                               space,
                                               p_con env c2])
       | CFold _ => string "fold"
+      | CUnit => string "()"
         
 and p_con env = p_con' false env
 
diff --git a/src/expl_util.sml b/src/expl_util.sml
index aea9e4f5..57498fde 100644
--- a/src/expl_util.sml
+++ b/src/expl_util.sml
@@ -55,6 +55,8 @@ fun mapfold f =
                 S.map2 (mfk k,
                         fn k' =>
                            (KRecord k', loc))
+
+              | KUnit => S.return2 kAll
     in
         mfk
     end
@@ -144,6 +146,8 @@ fun mapfoldB {kind = fk, con = fc, bind} =
                             S.map2 (mfk k2,
                                     fn k2' =>
                                        (CFold (k1', k2'), loc)))
+
+              | CUnit => S.return2 cAll
     in
         mfc
     end
diff --git a/src/explify.sml b/src/explify.sml
index 0fa3698b..e0226213 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -38,7 +38,7 @@ fun explifyKind (k, loc) =
       | 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 @@ fun explifyCon (c, loc) =
       | 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 --git a/src/monoize.sml b/src/monoize.sml
index 16c128aa..335b93e6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -72,6 +72,7 @@ fun monoType env (all as (c, loc)) =
           | L.CRecord _ => poly ()
           | L.CConcat _ => poly ()
           | L.CFold _ => poly ()
+          | L.CUnit => poly ()
     end
 
 val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)