comparison src/monoize.sml @ 1107:52571ca9b777

Eta-expand bodies of transaction functions in Monoization, to enable later optimization
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Dec 2009 18:07:53 -0500
parents 72670131dace
children 631a3597c065
comparison
equal deleted inserted replaced
1106:c9137606733a 1107:52571ca9b777
3438 fm, 3438 fm,
3439 [(L'.DVal (x, n, monoType env t, e, s), loc)]) 3439 [(L'.DVal (x, n, monoType env t, e, s), loc)])
3440 end 3440 end
3441 | L.DValRec vis => 3441 | L.DValRec vis =>
3442 let 3442 let
3443 val vis = map (fn (x, n, t, e, s) =>
3444 let
3445 fun maybeTransaction (t, e) =
3446 case (#1 t, #1 e) of
3447 (L.CApp ((L.CFfi ("Basis", "transaction"), _), _), _) =>
3448 SOME (L.EAbs ("_",
3449 (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc),
3450 t,
3451 (L.EApp (CoreEnv.liftExpInExp 0 e,
3452 (L.ERecord [], loc)), loc)), loc)
3453 | (L.TFun (dom, ran), L.EAbs (x, _, _, e)) =>
3454 (case maybeTransaction (ran, e) of
3455 NONE => NONE
3456 | SOME e => SOME (L.EAbs (x, dom, ran, e), loc))
3457 | _ => NONE
3458 in
3459 (x, n, t,
3460 case maybeTransaction (t, e) of
3461 NONE => e
3462 | SOME e => e,
3463 s)
3464 end) vis
3465
3443 val env = foldl (fn ((x, n, t, e, s), env) => Env.pushENamed env x n t NONE s) env vis 3466 val env = foldl (fn ((x, n, t, e, s), env) => Env.pushENamed env x n t NONE s) env vis
3444 3467
3445 val (vis, fm) = ListUtil.foldlMap 3468 val (vis, fm) = ListUtil.foldlMap
3446 (fn ((x, n, t, e, s), fm) => 3469 (fn ((x, n, t, e, s), fm) =>
3447 let 3470 let