Mercurial > urweb

comparison src/mono_opt.sml @ 1176:51e596feec37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tone down Reduce and compensate with a new push-lambda-inside-case rule in MonoOpt; expand more Basis synonyms in Monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Mar 2010 16:00:48 -0500
parents 217eb87dde31
children 83b1853d1e58
comparison
equal deleted inserted replaced
1175:79f487f51d9f 1176:51e596feec37
346 map (fn (p, e) => (p, doBody e)) pes, 346 map (fn (p, e) => (p, doBody e)) pes,
347 {disc = disc, 347 {disc = disc,
348 result = ran}), loc) 348 result = ran}), loc)
349 end 349 end
350 350
351 | ECase (discE, pes, {disc, result = (TFun (dom, ran), loc)}) =>
352 let
353 fun doBody (p, e) =
354 let
355 val pb = MonoEnv.patBindsN p
356 in
357 (EApp (MonoEnv.liftExpInExp pb e, (ERel pb, loc)), loc)
358 end
359 in
360 EAbs ("x", dom, ran,
361 (optExp (ECase (MonoEnv.liftExpInExp 0 discE,
362 map (fn (p, e) => (p, doBody (p, e))) pes,
363 {disc = disc,
364 result = ran}), loc), loc))
365 end
366
351 | EWrite (EQuery {exps, tables, state, query, 367 | EWrite (EQuery {exps, tables, state, query,
352 initial = (EPrim (Prim.String ""), _), 368 initial = (EPrim (Prim.String ""), _),
353 body = (EStrcat ((EPrim (Prim.String s), _), 369 body = (EStrcat ((EPrim (Prim.String s), _),
354 (EStrcat ((ERel 0, _), 370 (EStrcat ((ERel 0, _),
355 e'), _)), _)}, loc) => 371 e'), _)), _)}, loc) =>