clarified modules;
authorwenzelm
Mon, 07 Jun 2021 16:40:26 +0200
changeset 73834 364bac6691de
parent 73831 5153fad491f3
child 73835 5dae03d50db1
clarified modules;
src/Pure/General/output.ML
src/Pure/ML/ml_profiling.ML
src/Pure/ROOT.ML
--- a/src/Pure/General/output.ML	Mon Jun 07 15:13:34 2021 +0200
+++ b/src/Pure/General/output.ML	Mon Jun 07 16:40:26 2021 +0200
@@ -10,9 +10,6 @@
   val tracing: string -> unit
   val warning: string -> unit
   val legacy_feature: string -> unit
-  val profile_time: ('a -> 'b) -> 'a -> 'b
-  val profile_time_thread: ('a -> 'b) -> 'a -> 'b
-  val profile_allocations: ('a -> 'b) -> 'a -> 'b
 end;
 
 signature OUTPUT =
@@ -158,40 +155,6 @@
 fun protocol_message props body = ! protocol_message_fn props body;
 fun try_protocol_message props body = protocol_message props body handle Protocol_Message _ => ();
 
-
-(* profiling *)
-
-local
-
-fun output_profile title entries =
-  let
-    val body = entries
-      |> sort (int_ord o apply2 fst)
-      |> map (fn (count, name) =>
-          let
-            val c = string_of_int count;
-            val prefix = replicate_string (Int.max (0, 10 - size c)) " ";
-          in prefix ^ c ^ " " ^ name end);
-    val total = fold (curry (op +) o fst) entries 0;
-  in
-    if total = 0 then ()
-    else warning (cat_lines (title :: (body @ ["total: " ^ string_of_int total])))
-  end;
-
-in
-
-fun profile_time f x =
-  ML_Profiling.profile_time (output_profile "time profile:") f x;
-
-fun profile_time_thread f x =
-  ML_Profiling.profile_time_thread (output_profile "time profile (this thread):") f x;
-
-fun profile_allocations f x =
-  ML_Profiling.profile_allocations (output_profile "allocations profile:") f x;
-
-end;
-
-
 end;
 
 structure Output: OUTPUT = Private_Output;
--- a/src/Pure/ML/ml_profiling.ML	Mon Jun 07 15:13:34 2021 +0200
+++ b/src/Pure/ML/ml_profiling.ML	Mon Jun 07 16:40:26 2021 +0200
@@ -6,21 +6,39 @@
 
 signature ML_PROFILING =
 sig
-  val profile_time: ((int * string) list -> unit) -> ('a -> 'b) -> 'a -> 'b
-  val profile_time_thread: ((int * string) list -> unit) -> ('a -> 'b) -> 'a -> 'b
-  val profile_allocations: ((int * string) list -> unit) -> ('a -> 'b) -> 'a -> 'b
+  val profile_time: ('a -> 'b) -> 'a -> 'b
+  val profile_time_thread: ('a -> 'b) -> 'a -> 'b
+  val profile_allocations: ('a -> 'b) -> 'a -> 'b
 end;
 
 structure ML_Profiling: ML_PROFILING =
 struct
 
-fun profile_time pr f x =
-  PolyML.Profiling.profileStream pr PolyML.Profiling.ProfileTime f x;
+fun profile mode title =
+  mode |> PolyML.Profiling.profileStream (fn entries =>
+    let
+      val body = entries
+        |> sort (int_ord o apply2 fst)
+        |> map (fn (count, name) =>
+            let
+              val c = string_of_int count;
+              val prefix = replicate_string (Int.max (0, 10 - size c)) " ";
+            in prefix ^ c ^ " " ^ name end);
+      val total = fold (curry (op +) o fst) entries 0;
+    in
+      if total = 0 then ()
+      else warning (cat_lines (title :: (body @ ["total: " ^ string_of_int total])))
+    end);
 
-fun profile_time_thread pr f x =
-  PolyML.Profiling.profileStream pr PolyML.Profiling.ProfileTimeThisThread f x;
+fun profile_time f =
+  profile PolyML.Profiling.ProfileTime "time profile:" f;
 
-fun profile_allocations pr f x =
-  PolyML.Profiling.profileStream pr PolyML.Profiling.ProfileAllocations f x;
+fun profile_time_thread f =
+  profile PolyML.Profiling.ProfileTimeThisThread "time profile (this thread):" f;
+
+fun profile_allocations f =
+  profile PolyML.Profiling.ProfileAllocations "allocations profile:" f;
 
 end;
+
+open ML_Profiling;
--- a/src/Pure/ROOT.ML	Mon Jun 07 15:13:34 2021 +0200
+++ b/src/Pure/ROOT.ML	Mon Jun 07 16:40:26 2021 +0200
@@ -27,7 +27,6 @@
 ML_file "Concurrent/counter.ML";
 
 ML_file "ML/ml_heap.ML";
-ML_file "ML/ml_profiling.ML";
 ML_file "ML/ml_print_depth0.ML";
 ML_file "ML/ml_pretty.ML";
 ML_file "ML/ml_compiler0.ML";
@@ -47,6 +46,7 @@
 ML_file "General/properties.ML";
 ML_file "General/output.ML";
 ML_file "PIDE/markup.ML";
+ML_file "ML/ml_profiling.ML";
 ML_file "General/utf8.ML";
 ML_file "General/scan.ML";
 ML_file "General/source.ML";