diff src/cjrize.sml @ 182:d11754ffe252

Compiled pattern matching to C
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 12:43:20 -0400
parents 31dfab1d4050
children 19ee24bffbc0
line wrap: on
line diff
--- a/src/cjrize.sml	Sun Aug 03 11:17:33 2008 -0400
+++ b/src/cjrize.sml	Sun Aug 03 12:43:20 2008 -0400
@@ -108,13 +108,35 @@
         L.PConVar n => L'.PConVar n
       | L.PConFfi mx => L'.PConFfi mx
 
-fun cifyPat (p, loc) =
+fun cifyPat ((p, loc), sm) =
     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 (cifyPatCon pc, Option.map cifyPat po), loc)
-      | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, cifyPat p)) xps), loc)
+        L.PWild => ((L'.PWild, loc), sm)
+      | L.PVar (x, t) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+        in
+            ((L'.PVar (x, t), loc), sm)
+        end
+      | L.PPrim p => ((L'.PPrim p, loc), sm)
+      | L.PCon (pc, NONE) => ((L'.PCon (cifyPatCon pc, NONE), loc), sm)
+      | L.PCon (pc, SOME p) =>
+        let
+            val (p, sm) = cifyPat (p, sm)
+        in
+            ((L'.PCon (cifyPatCon pc, SOME p), loc), sm)
+        end
+      | L.PRecord xps =>
+        let
+            val (xps, sm) = ListUtil.foldlMap (fn ((x, p, t), sm) =>
+                                                  let
+                                                      val (p, sm) = cifyPat (p, sm)
+                                                      val (t, sm) = cifyTyp (t, sm)
+                                                  in
+                                                      ((x, p, t), sm)
+                                                  end) sm xps
+        in
+            ((L'.PRecord xps, loc), sm)
+        end
 
 fun cifyExp ((e, loc), sm) =
     case e of
@@ -179,19 +201,21 @@
             ((L'.EField (e, x), loc), sm)
         end
 
-      | L.ECase (e, pes, t) =>
+      | L.ECase (e, pes, {disc, result}) =>
         let
                 val (e, sm) = cifyExp (e, sm)
                 val (pes, sm) = ListUtil.foldlMap
                                     (fn ((p, e), sm) =>
                                         let
                                             val (e, sm) = cifyExp (e, sm)
+                                            val (p, sm) = cifyPat (p, sm)
                                         in
-                                            ((cifyPat p, e), sm)
+                                            ((p, e), sm)
                                         end) sm pes
-                val (t, sm) = cifyTyp (t, sm)
+                val (disc, sm) = cifyTyp (disc, sm)
+                val (result, sm) = cifyTyp (result, sm)
             in
-                ((L'.ECase (e, pes, t), loc), sm)
+                ((L'.ECase (e, pes, {disc = disc, result = result}), loc), sm)
             end
 
       | L.EStrcat (e1, e2) =>