Mercurial > urweb
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 |