Mercurial > urweb

comparison src/mono_opt.sml @ 453:787d4931fb07

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
452:222cbc1da232 453:787d4931fb07
87 fun sqlifyFloat n = attrifyFloat n ^ "::float8" 87 fun sqlifyFloat n = attrifyFloat n ^ "::float8"
88 88
89 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" 89 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
90 | ch => str ch) 90 | ch => str ch)
91 (String.toString s) ^ "'::text" 91 (String.toString s) ^ "'::text"
92 92
93 fun exp e = 93 fun exp e =
94 case e of 94 case e of
95 EPrim (Prim.String s) => 95 EPrim (Prim.String s) =>
96 let 96 let
97 val (_, chs) = 97 val (_, chs) =
285 optExp (ECase (discE, 285 optExp (ECase (discE,
286 map (fn (p, e) => (p, (EWrite e, loc))) pes, 286 map (fn (p, e) => (p, (EWrite e, loc))) pes,
287 {disc = disc, 287 {disc = disc,
288 result = (TRecord [], loc)}), loc) 288 result = (TRecord [], loc)}), loc)
289 289
290 | EApp ((ECase (discE, pes, {disc, ...}), loc), arg as (ERecord [], _)) =>
291 let
292 fun doBody e =
293 case #1 e of
294 EAbs (_, _, _, body) => MonoReduce.subExpInExp (0, arg) body
295 | _ => (EApp (e, arg), loc)
296 in
297 optExp (ECase (discE,
298 map (fn (p, e) => (p, doBody e)) pes,
299 {disc = disc,
300 result = (TRecord [], loc)}), loc)
301 end
302
290 | EWrite (EQuery {exps, tables, state, query, 303 | EWrite (EQuery {exps, tables, state, query,
291 initial = (EPrim (Prim.String ""), _), 304 initial = (EPrim (Prim.String ""), _),
292 body = (EStrcat ((EPrim (Prim.String s), _), 305 body = (EStrcat ((EPrim (Prim.String s), _),
293 (EStrcat ((ERel 0, _), 306 (EStrcat ((ERel 0, _),
294 e'), _)), _)}, loc) => 307 e'), _)), _)}, loc) =>