Mercurial > urweb

comparison src/mono_reduce.sml @ 2226:e10881cd92da

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Ziv Scully <ziv@mit.edu>
date Fri, 27 Mar 2015 11:26:06 -0400
parents ec1614fb97bb
children 25874084bf1f
comparison
equal deleted inserted replaced
2225:6262dabc08d6 2226:e10881cd92da
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
816 e 819 e
817 else 820 else
818 search pes 821 search pes
819 end 822 end
820 823
821 | EField ((ERecord xes, _), x) => 824 | EField (e1, x) =>
822 (case List.find (fn (x', _, _) => x' = x) xes of 825 let
823 SOME (_, e, _) => #1 e 826 fun yankLets (e : exp) =
824 | NONE => e) 827 case #1 e of
828 ELet (x, t, e1, e2) => (ELet (x, t, e1, yankLets e2), #2 e)
829 | ERecord xes =>
830 (case List.find (fn (x', _, _) => x' = x) xes of
831 SOME (_, e, _) => e
832 | NONE => (EField (e, x), #2 e))
833 | _ => (EField (e, x), #2 e)
834 in
835 #1 (yankLets e1)
836 end
825 837
826 | ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) => 838 | ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) =>
827 let 839 let
828 val e' = (ELet (x2, t2, e1, 840 val e' = (ELet (x2, t2, e1,
829 (ELet (x1, t1, b1, 841 (ELet (x1, t1, b1,
883 d) 895 d)
884 in 896 in
885 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
886 end 898 end
887 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
888 end 912 end