Mercurial > urweb

comparison src/mono_reduce.sml @ 1107:52571ca9b777

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 b2311dfb3158
children 7a31e0cf25e9
comparison
equal deleted inserted replaced
1106:c9137606733a 1107:52571ca9b777
580 | ECase (e', pes, {disc, result}) => 580 | ECase (e', pes, {disc, result}) =>
581 let 581 let
582 fun push () = 582 fun push () =
583 case result of 583 case result of
584 (TFun (dom, result), loc) => 584 (TFun (dom, result), loc) =>
585 if List.all (fn (_, (EAbs _, _)) => true | _ => false) pes then 585 let
586 let 586 fun safe (e, _) =
587 val r = 587 case e of
588 EAbs ("y", dom, result, 588 EAbs _ => true
589 (ECase (liftExpInExp 0 e', 589 | _ => false
590 map (fn (p, (EAbs (_, _, _, e), _)) => 590 in
591 (p, swapExpVarsPat (0, patBinds p) e) 591 if List.all (safe o #2) pes then
592 | _ => raise Fail "MonoReduce ECase") pes, 592 EAbs ("y", dom, result,
593 {disc = disc, result = result}), loc)) 593 (ECase (liftExpInExp 0 e',
594 in 594 map (fn (p, (EAbs (_, _, _, e), _)) =>
595 (*Print.prefaces "Swapped" 595 (p, swapExpVarsPat (0, patBinds p) e)
596 [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), 596 | _ => raise Fail "MonoReduce ECase") pes,
597 ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*) 597 {disc = disc, result = result}), loc))
598 r 598 else
599 end 599 e
600 else 600 end
601 e
602 | _ => e 601 | _ => e
603 602
604 fun search pes = 603 fun search pes =
605 case pes of 604 case pes of
606 [] => push () 605 [] => push ()