{-# LINE 1 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}
{-# LANGUAGE CPP, CApiFFI, NumDecimals #-}




module System.CPUTime.Posix.Times
    ( getCPUTime
    , getCpuTimePrecision
    ) where

import Data.Ratio
import Foreign
import Foreign.C
import System.CPUTime.Utils

-- for struct tms

{-# LINE 18 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}


{-# LINE 20 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}

getCPUTime :: IO Integer
getCPUTime :: IO Integer
getCPUTime = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) forall a b. (a -> b) -> a -> b
$ \ Ptr CTms
p_tms -> do
{-# LINE 23 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}
    _ <- times p_tms
    u_ticks  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p_tms :: IO CClock
{-# LINE 25 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}
    s_ticks  <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p_tms :: IO CClock
{-# LINE 26 "libraries/base/System/CPUTime/Posix/Times.hsc" #-}
    return (( (cClockToInteger u_ticks + cClockToInteger s_ticks) * 1e12)
                        `div` fromIntegral clockTicks)

type CTms = ()
foreign import ccall unsafe times :: Ptr CTms -> IO CClock

getCpuTimePrecision :: IO Integer
getCpuTimePrecision :: IO Integer
getCpuTimePrecision =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round ((Integer
1e12::Integer) forall a. Integral a => a -> a -> Ratio a
% Integer
clockTicks)

foreign import ccall unsafe clk_tck :: CLong

clockTicks :: Integer
clockTicks :: Integer
clockTicks = forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
clk_tck