Mercurial > urweb
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), _),