Mercurial > urweb

changeset 87:275aaeb73f1f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Push KUnit and CUnit through the phases
author Adam Chlipala <adamc@hcoop.net>
date Tue, 01 Jul 2008 13:23:46 -0400
parents 7f9bcc8bfa1e
children 7bab29834cd6
files src/core.sml src/core_print.sml src/core_util.sml src/corify.sml src/expl.sml src/expl_print.sml src/expl_util.sml src/explify.sml src/monoize.sml tests/disjoint.lac
diffstat 10 files changed, 25 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- 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' =
--- 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
 
--- 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
--- 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
--- 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' =
--- 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
 
--- 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
--- 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
--- 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)
--- 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