diff src/monoize.sml @ 178:eb3f9913bf31

First part of getting cases through monoize
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 09:26:49 -0400
parents 5d030ee143e2
children 3bbed533fbd2
line wrap: on
line diff
--- a/src/monoize.sml	Sat Aug 02 11:15:32 2008 -0400
+++ b/src/monoize.sml	Sun Aug 03 09:26:49 2008 -0400
@@ -160,6 +160,19 @@
 
 end
 
+fun monoPatCon pc =
+    case pc of
+        L.PConVar n => L'.PConVar n
+      | L.PConFfi mx => L'.PConFfi mx
+
+fun monoPat (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 (monoPatCon pc, Option.map monoPat po), loc)
+      | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, monoPat p)) xps), loc)
+
 fun monoExp (env, st) (all as (e, loc)) =
     let
         fun poly () =
@@ -171,7 +184,7 @@
             L.EPrim p => (L'.EPrim p, loc)
           | L.ERel n => (L'.ERel n, loc)
           | L.ENamed n => (L'.ENamed n, loc)
-          | L.ECon _ => raise Fail "Monoize ECon"
+          | L.ECon (n, eo) => (L'.ECon (n, Option.map (monoExp (env, st)) eo), loc)
           | L.EFfi mx => (L'.EFfi mx, loc)
           | L.EFfiApp (m, x, es) => (L'.EFfiApp (m, x, map (monoExp (env, st)) es), loc)
 
@@ -450,7 +463,9 @@
           | L.ECut _ => poly ()
           | L.EFold _ => poly ()
 
-          | L.ECase _ => raise Fail "Monoize ECase"
+          | L.ECase (e, pes, t) => (L'.ECase (monoExp (env, st) e,
+                                              map (fn (p, e) => (monoPat p, monoExp (env, st) e)) pes,
+                                              monoType env t), loc)
 
           | L.EWrite e => (L'.EWrite (monoExp (env, st) e), loc)