GHC/Event/Clock.hsc

   1 {-# LANGUAGE NoImplicitPrelude, BangPatterns, ForeignFunctionInterface #-}
   2
   3 module GHC.Event.Clock (getCurrentTime) where
   4
   5 #include <sys/time.h>
   6
   7 import Foreign (Ptr, Storable(..), nullPtr, with)
   8 import Foreign.C.Error (throwErrnoIfMinus1_)
   9 import Foreign.C.Types (CInt, CLong)
  10 import GHC.Base
  11 import GHC.Err
  12 import GHC.Num
  13 import GHC.Real
  14
  15 -- TODO: Implement this for Windows.
  16
  17 -- | Return the current time, in seconds since Jan. 1, 1970.
  18 getCurrentTime :: IO Double
  19 getCurrentTime = do
  20     tv <- with (CTimeval 0 0) $ \tvptr -> do
  21         throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)
  22         peek tvptr
  23     let !t = fromIntegral (sec tv) + fromIntegral (usec tv) / 1000000.0
  24     return t
  25
  26 ------------------------------------------------------------------------
  27 -- FFI binding
  28
  29 data CTimeval = CTimeval
  30     { sec  :: {-# UNPACK #-} !CLong
  31     , usec :: {-# UNPACK #-} !CLong
  32     }
  33
  34 instance Storable CTimeval where
  35     sizeOf _ = #size struct timeval
  36     alignment _ = alignment (undefined :: CLong)
  37
  38     peek ptr = do
  39         sec' <- #{peek struct timeval, tv_sec} ptr
  40         usec' <- #{peek struct timeval, tv_usec} ptr
  41         return $ CTimeval sec' usec'
  42
  43     poke ptr tv = do
  44         #{poke struct timeval, tv_sec} ptr (sec tv)
  45         #{poke struct timeval, tv_usec} ptr (usec tv)
  46
  47 foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday
  48     :: Ptr CTimeval -> Ptr () -> IO CInt