diff --git a/System/Clock.hsc b/System/Clock.hsc index 13815e3..d5d2a5b 100644 --- a/System/Clock.hsc +++ b/System/Clock.hsc @@ -20,8 +20,10 @@ module System.Clock ) where import Control.Applicative ((<$>), (<*>)) +import Data.Coerce import Data.Int import Data.Word +import Data.Ratio import Data.Typeable (Typeable) import Foreign.C import Foreign.Ptr @@ -44,7 +46,7 @@ import GHC.Generics (Generic) -- | Clock types. A clock may be system-wide (that is, visible to all processes) -- or per-process (measuring time that is meaningful only within a process). --- All implementations shall support 'Realtime'. +-- All implementations shall support 'Realtime'. data Clock -- | The identifier for the system-wide monotonic clock, which is defined as @@ -227,14 +229,7 @@ normalize (TimeSpec xs xn) | xn < 0 || xn >= s2ns = TimeSpec (xs + q) r instance Num TimeSpec where (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $! TimeSpec (xs + ys) (xn + yn) (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $! TimeSpec (xs - ys) (xn - yn) - (TimeSpec xs xn) * (TimeSpec ys yn) = normalize $! TimeSpec (xsi_ysi) (xni_yni) - where xsi_ysi = fromInteger $! xsi*ysi - xni_yni = fromInteger $! (xni*yni + (xni*ysi + xsi*yni) * s2ns) `div` s2ns - xsi = toInteger xs - ysi = toInteger ys - xni = toInteger xn - yni = toInteger yn - + (toInteger-> t1) * (toInteger-> t2) = fromInteger $! t1 * t2 negate (TimeSpec xs xn) = normalize $! TimeSpec (negate xs) (negate xn) abs (normalize -> TimeSpec xs xn) | xs == 0 = normalize $! TimeSpec 0 xn | otherwise = normalize $! TimeSpec (abs xs) (signum xs * xn) @@ -242,6 +237,26 @@ instance Num TimeSpec where | otherwise = TimeSpec (signum xs) 0 fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns +instance Enum TimeSpec where + succ x = x + 1 + pred x = x - 1 + toEnum x = normalize $ TimeSpec 0 (fromIntegral x) + fromEnum = fromEnum . toInteger + +instance Real TimeSpec where + toRational x = toInteger x % 1 + +instance Integral TimeSpec where + toInteger = toNanoSecs + quot (toInteger-> t1) (toInteger-> t2) = fromInteger $! quot t1 t2 + rem (toInteger-> t1) (toInteger-> t2) = fromInteger $! rem t1 t2 + div (toInteger-> t1) (toInteger-> t2) = fromInteger $! div t1 t2 + mod (toInteger-> t1) (toInteger-> t2) = fromInteger $! mod t1 t2 + divMod (toInteger-> t1) (toInteger-> t2) = + let (q,r)=divMod t1 t2 in (fromInteger $! q, fromInteger $! r) + quotRem (toInteger-> t1) (toInteger-> t2) = + let (q,r)=quotRem t1 t2 in (fromInteger $! q, fromInteger $! r) + instance Eq TimeSpec where (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn | otherwise = es @@ -269,3 +284,34 @@ diffTimeSpec ts1 ts2 = abs (ts1 - ts2) -- | TimeSpec as nano seconds. timeSpecAsNanoSecs :: TimeSpec -> Integer timeSpecAsNanoSecs (TimeSpec s n) = toInteger s * s2ns + toInteger n + +newtype Seconds = Seconds TimeSpec + deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable) + +instance Num Seconds where + fromInteger n = Seconds $ TimeSpec (fromInteger n) 0 + Seconds a * Seconds b = Seconds $ a * b `div` s2ns + (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec) + (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec) + negate = coerce (negate :: TimeSpec -> TimeSpec) + abs = coerce (abs :: TimeSpec -> TimeSpec) + signum = coerce (signum :: TimeSpec -> TimeSpec) + +instance Enum Seconds where + succ x = x + 1 + pred x = x - 1 + toEnum x = Seconds . normalize $ TimeSpec (fromIntegral x) 0 + fromEnum (Seconds (TimeSpec s _)) = fromEnum s + +instance Real Seconds where + toRational (Seconds x) = toInteger x % s2ns + +instance Fractional Seconds where + fromRational x = Seconds . fromInteger $ floor (x * s2ns) + Seconds a / Seconds b = Seconds $ a * s2ns `div` b + recip (Seconds a) = Seconds $ s2ns * s2ns `div` a + +instance RealFrac Seconds where + properFraction (Seconds (TimeSpec s ns)) + | s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns) + | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns) diff --git a/clock.cabal b/clock.cabal index 2530335..322041e 100644 --- a/clock.cabal +++ b/clock.cabal @@ -76,6 +76,7 @@ library ForeignFunctionInterface ScopedTypeVariables ViewPatterns + GeneralizedNewtypeDeriving if os(windows) c-sources: cbits/hs_clock_win32.c include-dirs: cbits