From ab1c9819c0991f6e660d3f54d7f7f213f815e608 Mon Sep 17 00:00:00 2001 From: Mathnerd314 Date: Wed, 12 May 2021 13:20:30 -0600 Subject: [PATCH 1/2] fix Num multiplication, add Real, Enum, Integral instances These instances are based on using the nanosecond as the underlying unit, i.e. the value of a TimeSpec is the integer s * 1e9 + ns. Before it was based on representing the rational s + (ns / 1e9). But the integer valuation satisfies the ring laws and provides much more intuitive behavior, e.g. (2 :: TimeSpec)*(2 :: TimeSpec) = (4 :: TimeSpec) Before, this gave 0. --- System/Clock.hsc | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/System/Clock.hsc b/System/Clock.hsc index 13815e3..85bf7aa 100644 --- a/System/Clock.hsc +++ b/System/Clock.hsc @@ -22,6 +22,7 @@ module System.Clock import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word +import Data.Ratio import Data.Typeable (Typeable) import Foreign.C import Foreign.Ptr @@ -44,7 +45,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 +228,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 +236,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 From 27a111164b3922ecb6662f8610acd2ab43c6de48 Mon Sep 17 00:00:00 2001 From: Mathnerd314 Date: Wed, 12 May 2021 15:57:48 -0600 Subject: [PATCH 2/2] add Seconds newtype --- System/Clock.hsc | 32 ++++++++++++++++++++++++++++++++ clock.cabal | 1 + 2 files changed, 33 insertions(+) diff --git a/System/Clock.hsc b/System/Clock.hsc index 85bf7aa..d5d2a5b 100644 --- a/System/Clock.hsc +++ b/System/Clock.hsc @@ -20,6 +20,7 @@ module System.Clock ) where import Control.Applicative ((<$>), (<*>)) +import Data.Coerce import Data.Int import Data.Word import Data.Ratio @@ -283,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