diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-11-01 21:19:43 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-01 21:19:43 -0400 |
commit | 047a2f193646e08db526768dca8376b7270eecb5 (patch) | |
tree | 2be405017cad5af57826b17c1715d9579eb06d1b /src/mono_opt.sml | |
parent | 9a22207b565607db64f95dda5fdc1c9e56224ec9 (diff) |
Almost have that nested save function compiling
Diffstat (limited to 'src/mono_opt.sml')
-rw-r--r-- | src/mono_opt.sml | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 3cf2bcd4..b22f053b 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -89,7 +89,7 @@ fun sqlifyFloat n = attrifyFloat n ^ "::float8" 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 @@ fun exp e = {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), _), |