← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/base/System/Event/Clock.hsc

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/base/System/Event/Clock.hsc
 
1
{-# LANGUAGE ForeignFunctionInterface #-}
 
2
 
 
3
module System.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