[MLton-commit] r7375

[Matthew Fluet]

Wrap diagnosing and profiling a pass in pass trace.
----------------------------------------------------------------------

U   mlton/trunk/mlton/control/control.sml

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/control/control.sml
===================================================================
--- mlton/trunk/mlton/control/control.sml	2009-12-10 03:08:36 UTC (rev 7374)
+++ mlton/trunk/mlton/control/control.sml	2009-12-10 03:08:39 UTC (rev 7375)
@@ -305,6 +305,47 @@
       then ()
    else saveToFile ({suffix = concat [name, ".", suffix]}, style, a, d)
 
+(* Code for diagnosing a pass. *)
+val wrapDiagnosing =
+   fn {name: string,
+       thunk: unit -> 'a} =>
+   if not (List.exists (!diagPasses, fn re =>
+                        Regexp.Compiled.matchesAll (re, name)))
+      then thunk
+   else fn () =>
+        let
+           val result = ref NONE
+           val _ =
+              saveToFile
+              ({suffix = concat [name, ".diagnostic"]}, No, (),
+               Layouts (fn ((), disp) =>
+                        (diagnosticWriter := SOME disp
+                         ; result := SOME (thunk ())
+                         ; diagnosticWriter := NONE)))
+        in
+           valOf (!result)
+        end
+
+(* Code for profiling a pass. *)
+val wrapProfiling =
+   fn {name: string,
+       thunk: unit -> 'a} =>
+   if MLton.Profile.isOn
+      then if not (List.exists (!profPasses, fn re =>
+                                Regexp.Compiled.matchesAll (re, name)))
+              then thunk
+           else fn () =>
+                let
+                   open MLton.Profile
+                   val d = Data.malloc ()
+                in
+                   Exn.finally
+                   (fn () => withData (d, thunk),
+                    fn () => (Data.write (d, concat [!inputFile, ".", name, ".mlmon"])
+                              ; Data.free d))
+                end
+   else thunk
+
 fun pass {display: 'a display,
           name: string,
           suffix: string,
@@ -312,23 +353,9 @@
           style: style,
           thunk: unit -> 'a}: 'a =
    let
-      val result = 
-         if not (List.exists (!diagPasses, fn re =>
-                              Regexp.Compiled.matchesAll (re, name)))
-            then trace (Pass, name) thunk ()
-         else
-            let
-               val result = ref NONE
-               val _ =
-                  saveToFile
-                  ({suffix = concat [name, ".diagnostic"]}, No, (),
-                   Layouts (fn ((), disp) =>
-                            (diagnosticWriter := SOME disp
-                             ; result := SOME (trace (Pass, name) thunk ())
-                             ; diagnosticWriter := NONE)))
-            in
-               valOf (!result)
-            end
+      val thunk = wrapDiagnosing {name = name, thunk = thunk}
+      val thunk = wrapProfiling {name = name, thunk = thunk}
+      val result = trace (Pass, name) thunk ()
       val verb = Detail
       val _ = message (verb, fn () => Layout.str (concat [name, " stats"]))
       val _ = indent ()
@@ -344,24 +371,6 @@
       result
    end
 
-(* Code for profiling a pass. *)
-val pass =
-   fn z as {name, ...} =>
-   if MLton.Profile.isOn
-      then if not (List.exists (!profPasses, fn re =>
-                                Regexp.Compiled.matchesAll (re, name)))
-              then pass z
-           else let
-                   open MLton.Profile
-                   val d = Data.malloc ()
-                in
-                   Exn.finally
-                   (fn () => withData (d, fn () => pass z),
-                    fn () => (Data.write (d, concat [!inputFile, ".", name, ".mlmon"])
-                              ; Data.free d))
-                end
-   else pass z
-
 fun passTypeCheck {display: 'a display,
                    name: string,
                    stats: 'a -> Layout.t,