Mercurial > urweb
comparison src/mono_reduce.sml @ 2126:ec1614fb97bb
Change MonoReduce to do fixed-pointing, since it sometimes enables more optimizations for itself (e.g., yanking lambdas out of [case]s)
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Fri, 06 Mar 2015 09:46:21 -0500 |
parents | 9e9c915f554c |
children | 25874084bf1f |
comparison
equal
deleted
inserted
replaced
2125:15d46eb02570 | 2126:ec1614fb97bb |
---|---|
328 bind = fn (n, b) => | 328 bind = fn (n, b) => |
329 case b of | 329 case b of |
330 U.Exp.RelE _ => n + 1 | 330 U.Exp.RelE _ => n + 1 |
331 | _ => n} 0 | 331 | _ => n} 0 |
332 | 332 |
333 fun reduce (file : file) = | 333 val yankedCase = ref false |
334 | |
335 fun reduce' (file : file) = | |
334 let | 336 let |
335 val (timpures, impures, absCounts) = | 337 val (timpures, impures, absCounts) = |
336 foldl (fn ((d, _), (timpures, impures, absCounts)) => | 338 foldl (fn ((d, _), (timpures, impures, absCounts)) => |
337 let | 339 let |
338 fun countAbs env e = | 340 fun countAbs env e = |
768 fun p_events' es = Print.box [Print.PD.string "{", | 770 fun p_events' es = Print.box [Print.PD.string "{", |
769 p_events es, | 771 p_events es, |
770 Print.PD.string "}"] | 772 Print.PD.string "}"] |
771 in | 773 in |
772 if List.all (safe o #2) pes then | 774 if List.all (safe o #2) pes then |
773 EAbs ("y", dom, result, | 775 (yankedCase := true; |
774 (ECase (liftExpInExp 0 e', | 776 EAbs ("y", dom, result, |
775 map (fn (p, (EAbs (_, _, _, e), _)) => | 777 (ECase (liftExpInExp 0 e', |
776 (p, swapExpVarsPat (0, patBinds p) e) | 778 map (fn (p, (EAbs (_, _, _, e), _)) => |
777 | (p, (EError (e, (TFun (_, t), _)), loc)) => | 779 (p, swapExpVarsPat (0, patBinds p) e) |
778 (p, (EError (liftExpInExp (patBinds p) e, t), loc)) | 780 | (p, (EError (e, (TFun (_, t), _)), loc)) => |
779 | (p, e) => | 781 (p, (EError (liftExpInExp (patBinds p) e, t), loc)) |
780 (p, (EApp (liftExpInExp (patBinds p) e, | 782 | (p, e) => |
781 (ERel (patBinds p), loc)), loc))) | 783 (p, (EApp (liftExpInExp (patBinds p) e, |
782 pes, | 784 (ERel (patBinds p), loc)), loc))) |
783 {disc = disc, result = result}), loc)) | 785 pes, |
786 {disc = disc, result = result}), loc))) | |
784 else | 787 else |
785 e | 788 e |
786 end | 789 end |
787 | _ => e | 790 | _ => e |
788 | 791 |
892 d) | 895 d) |
893 in | 896 in |
894 U.File.mapB {typ = typ, exp = exp, decl = decl, bind = bind} E.empty file | 897 U.File.mapB {typ = typ, exp = exp, decl = decl, bind = bind} E.empty file |
895 end | 898 end |
896 | 899 |
900 fun reduce file = | |
901 let | |
902 val () = yankedCase := false | |
903 val file' = reduce' file | |
904 in | |
905 if !yankedCase then | |
906 reduce file' | |
907 else | |
908 file' | |
909 end | |
910 | |
911 | |
897 end | 912 end |