summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-01 13:23:46 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-01 13:23:46 -0400
commit73b8b2cf8afd5cc8969b3bd4d2c238d9c453e8fd (patch)
treec082faa41b174478cadc17f84b65635593ca97af
parenta0b2a6145f200885f5dd7b365d2ffad51851795e (diff)
Push KUnit and CUnit through the phases
-rw-r--r--src/core.sml3
-rw-r--r--src/core_print.sml2
-rw-r--r--src/core_util.sml4
-rw-r--r--src/corify.sml2
-rw-r--r--src/expl.sml3
-rw-r--r--src/expl_print.sml2
-rw-r--r--src/expl_util.sml4
-rw-r--r--src/explify.sml4
-rw-r--r--src/monoize.sml1
-rw-r--r--tests/disjoint.lac2
10 files changed, 25 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)
diff --git a/tests/disjoint.lac b/tests/disjoint.lac
index 28b14423..26278014 100644
--- a/tests/disjoint.lac
+++ b/tests/disjoint.lac
@@ -31,3 +31,5 @@ val vt6 = v2 [#A] [[B = float, C = string]] {A = 8, B = 8.0, C = "8"}
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