d2bc014caac2 — Chris Cannam 4 years ago
Initial commit of timing helpers
3 files changed, 72 insertions(+), 0 deletions(-)

A => timing.mlb
A => timing.sig
A => timing.sml
A => timing.mlb +7 -0
@@ 0,0 1,7 @@ 
+$(SML_LIB)/basis/basis.mlb
+../sml-smlnj-containers/sml-smlnj-containers.mlb
+../sml-log/log.mlb
+timing.sig
+timing.sml
+
+

          
A => timing.sig +12 -0
@@ 0,0 1,12 @@ 
+
+signature TIMING = sig
+
+    type tag = string
+                   
+    val timed : tag -> (unit -> 'a) -> 'a
+
+    val record : tag -> Time.time -> unit
+
+    val summarise : unit -> unit
+                                           
+end

          
A => timing.sml +53 -0
@@ 0,0 1,53 @@ 
+
+structure Timing : TIMING = struct
+
+    type tag = string
+
+    fun hashChar (c : char, h : Word32.word) : Word32.word =
+        Word32.<<(h, 0w5) + h + 0w720 + (Word32.fromInt (Char.ord c))
+
+    fun hashString s =
+        let fun hash (~1, h) = h
+              | hash (i, h) =
+                hash (i-1, hashChar (String.sub (s, i), h))
+        in
+            hash (String.size s - 1, 0w0)
+        end
+
+    structure H = HashTableFn (struct
+                                type hash_key = string
+                                val hashVal = hashString
+                                val sameKey = op=
+                                end)
+
+    exception InternalError
+                              
+    val aggregates : Time.time H.hash_table = H.mkTable (200, InternalError)
+
+    fun record tag t =
+        case H.find aggregates tag of
+            NONE => H.insert aggregates (tag, t)
+          | SOME t' => H.insert aggregates (tag, Time.+ (t, t'))
+                               
+    fun timed tag f =
+        let val start = Time.now ()
+            val result = f ()
+            val finish = Time.now ()
+            val elapsed = Time.- (finish, start)
+            val () = record tag elapsed
+            val () = Log.debug
+                         (fn () => ["%: % ms", tag,
+                                    Log.R (Time.toReal elapsed * 1000.0)])
+        in
+            result
+        end
+
+    fun summarise () =
+        (Log.info (fn () => ["Aggregate times:"]);
+         H.appi (fn (tag, elapsed) =>
+                    Log.info
+                        (fn () => ["%: % ms", tag,
+                                   Log.R (Time.toReal elapsed * 1000.0)]))
+                aggregates)
+            
+end