diff src/mono_opt.sml @ 453:787d4931fb07

Almost have that nested save function compiling
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 21:19:43 -0400
parents 1bd575eb2d1e
children 3f1b9231a37b
line wrap: on
line diff
--- a/src/mono_opt.sml	Sat Nov 01 17:19:12 2008 -0400
+++ b/src/mono_opt.sml	Sat Nov 01 21:19:43 2008 -0400
@@ -89,7 +89,7 @@
 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
                                                | ch => str ch)
                                              (String.toString s) ^ "'::text"
-        
+
 fun exp e =
     case e of
         EPrim (Prim.String s) =>
@@ -287,6 +287,19 @@
                        {disc = disc,
                         result = (TRecord [], loc)}), loc)
 
+      | EApp ((ECase (discE, pes, {disc, ...}), loc), arg as (ERecord [], _)) =>
+        let
+            fun doBody e =
+                case #1 e of
+                    EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body
+                  | _ => (EApp (e, arg), loc)
+        in
+            optExp (ECase (discE,
+                           map (fn (p, e) => (p, doBody e)) pes,
+                           {disc = disc,
+                            result = (TRecord [], loc)}), loc)
+        end
+
       | EWrite (EQuery {exps, tables, state, query,
                         initial = (EPrim (Prim.String ""), _),
                         body = (EStrcat ((EPrim (Prim.String s), _),