lib/mlton/basic/time.sml

   1 (* Copyright (C) 2009 Matthew Fluet.
   2  * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure Time: TIME =
  10 struct
  11
  12 open Pervasive.LargeInt
  13 open Pervasive.Time
  14 structure LargeInt = Pervasive.LargeInt
  15
  16 type t = time
  17
  18 type times =
  19    {
  20     self: {utime: t, stime: t},
  21     children: {utime: t, stime: t},
  22     gc: {utime: t, stime: t}
  23     }
  24
  25 fun times (): times =
  26    let
  27      val {self, children, gc} = MLton.Rusage.rusage ()
  28      fun doit ({utime, stime, ...} : MLton.Rusage.t)
  29        = {utime = utime, stime = stime}
  30    in
  31      {self = doit self,
  32       children = doit children,
  33       gc = doit gc}
  34    end
  35
  36 val zero = fromReal 0.0
  37
  38 val equals = op =
  39
  40 val seconds = fromSeconds
  41
  42 fun minutes m = seconds (m * fromInt 60)
  43
  44 fun hours h = minutes (h * fromInt 60)
  45
  46 fun days d = hours (d * LargeInt.fromInt 24)
  47
  48 fun weeks w = days (w * LargeInt.fromInt 7)
  49
  50 fun years y = days (y * LargeInt.fromInt 365)
  51
  52 val {min, max, ...} = Relation.compare compare
  53
  54 val layout = Layout.str o toString
  55
  56 fun output (t, out) = Out.output (out, toString t)
  57
  58 fun timeThunk (th: unit -> unit): t =
  59    let
  60       val {self = {utime, stime}, ...} = times ()
  61       val t = utime + stime
  62       val _ = th ()
  63       val {self = {utime, stime}, ...} = times ()
  64       val t' = utime + stime
  65    in t' - t
  66    end
  67
  68 end