summaryrefslogtreecommitdiff
path: root/src/explify.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-31 16:28:55 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-31 16:28:55 -0400
commit16d3d1c3a6d1e78faab91076c20b76fdcb90edb9 (patch)
treeef54b557b346fa95b4322478bf5fbec431944f18 /src/explify.sml
parentd668886a45158cf3a292fdef3fa81498efd77652 (diff)
Case through explify
Diffstat (limited to 'src/explify.sml')
-rw-r--r--src/explify.sml17
1 files changed, 16 insertions, 1 deletions
diff --git a/src/explify.sml b/src/explify.sml
index da94ba94..7c23c2f5 100644
--- a/src/explify.sml
+++ b/src/explify.sml
@@ -71,6 +71,19 @@ fun explifyCon (c, loc) =
| L.CUnif (_, _, _, ref (SOME c)) => explifyCon c
| L.CUnif _ => raise Fail ("explifyCon: CUnif at " ^ EM.spanToString loc)
+fun explifyPatCon pc =
+ case pc of
+ L.PConVar n => L'.PConVar n
+ | L.PConProj x => L'.PConProj x
+
+fun explifyPat (p, loc) =
+ case p of
+ L.PWild => (L'.PWild, loc)
+ | L.PVar x => (L'.PVar x, loc)
+ | L.PPrim p => (L'.PPrim p, loc)
+ | L.PCon (pc, po) => (L'.PCon (explifyPatCon pc, Option.map explifyPat po), loc)
+ | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, explifyPat p)) xps), loc)
+
fun explifyExp (e, loc) =
case e of
L.EPrim p => (L'.EPrim p, loc)
@@ -89,7 +102,9 @@ fun explifyExp (e, loc) =
{field = explifyCon field, rest = explifyCon rest}), loc)
| L.EFold k => (L'.EFold (explifyKind k), loc)
- | L.ECase _ => raise Fail "Explify ECase"
+ | L.ECase (e, pes, t) => (L'.ECase (explifyExp e,
+ map (fn (p, e) => (explifyPat p, explifyExp e)) pes,
+ explifyCon t), loc)
| L.EError => raise Fail ("explifyExp: EError at " ^ EM.spanToString loc)