changeset 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 (2015-03-06)
parents 15d46eb02570
children 8beeb4f761b5
files src/mono_reduce.sml
diffstat 1 files changed, 27 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/src/mono_reduce.sml	Thu Mar 05 15:05:53 2015 -0500
+++ b/src/mono_reduce.sml	Fri Mar 06 09:46:21 2015 -0500
@@ -330,7 +330,9 @@
                                              U.Exp.RelE _ => n + 1
                                            | _ => n} 0
 
-fun reduce (file : file) =
+val yankedCase = ref false
+
+fun reduce' (file : file) =
     let
         val (timpures, impures, absCounts) =
             foldl (fn ((d, _), (timpures, impures, absCounts)) =>
@@ -770,17 +772,18 @@
                                                                       Print.PD.string "}"]
                                     in
                                         if List.all (safe o #2) pes then
-                                            EAbs ("y", dom, result,
-                                                  (ECase (liftExpInExp 0 e',
-                                                          map (fn (p, (EAbs (_, _, _, e), _)) =>
-                                                                  (p, swapExpVarsPat (0, patBinds p) e)
-                                                                | (p, (EError (e, (TFun (_, t), _)), loc)) =>
-                                                                  (p, (EError (liftExpInExp (patBinds p) e, t), loc))
-                                                                | (p, e) =>
-                                                                  (p, (EApp (liftExpInExp (patBinds p) e,
-                                                                             (ERel (patBinds p), loc)), loc)))
-                                                              pes,
-                                                          {disc = disc, result = result}), loc))
+                                            (yankedCase := true;
+                                             EAbs ("y", dom, result,
+                                                   (ECase (liftExpInExp 0 e',
+                                                           map (fn (p, (EAbs (_, _, _, e), _)) =>
+                                                                   (p, swapExpVarsPat (0, patBinds p) e)
+                                                               | (p, (EError (e, (TFun (_, t), _)), loc)) =>
+                                                                 (p, (EError (liftExpInExp (patBinds p) e, t), loc))
+                                                               | (p, e) =>
+                                                                 (p, (EApp (liftExpInExp (patBinds p) e,
+                                                                            (ERel (patBinds p), loc)), loc)))
+                                                               pes,
+                                                           {disc = disc, result = result}), loc)))
                                         else
                                             e
                                     end
@@ -894,4 +897,16 @@
         U.File.mapB {typ = typ, exp = exp, decl = decl, bind = bind} E.empty file
     end
 
+fun reduce file =
+    let
+        val () = yankedCase := false
+        val file' = reduce' file
+    in
+        if !yankedCase then
+            reduce file'
+        else
+            file'
+    end
+
+
 end