[commit: packages/time] format-widths, ghc, master, posix-perf, tasty: Change type of POSIX time for performance improvement (827c26c)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:55:22 UTC 2017


Repository : ssh://git@git.haskell.org/time

On branches: format-widths,ghc,master,posix-perf,tasty
Link       : http://git.haskell.org/packages/time.git/commitdiff/827c26c27a03dbbb9f91ed5fb7b45a1c6b36fc9d

>---------------------------------------------------------------

commit 827c26c27a03dbbb9f91ed5fb7b45a1c6b36fc9d
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Mon Dec 5 22:46:51 2016 -0800

    Change type of POSIX time for performance improvement


>---------------------------------------------------------------

827c26c27a03dbbb9f91ed5fb7b45a1c6b36fc9d
 lib/Data/Time/Clock/POSIX.hs        | 141 ++++++++++++++++++------------------
 lib/Data/Time/LocalTime/TimeZone.hs |   2 +-
 2 files changed, 73 insertions(+), 70 deletions(-)

diff --git a/lib/Data/Time/Clock/POSIX.hs b/lib/Data/Time/Clock/POSIX.hs
index ca8f364..68516cd 100644
--- a/lib/Data/Time/Clock/POSIX.hs
+++ b/lib/Data/Time/Clock/POSIX.hs
@@ -2,20 +2,20 @@
 -- Most people won't need this module.
 module Data.Time.Clock.POSIX
 (
-    posixDayLength,POSIXTime,posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime
+    posixDayLength,POSIXTime(..),posixSecondsToUTCTime,utcTimeToPOSIXSeconds,getPOSIXTime,getCurrentTime
 ) where
 
 import Data.Time.Clock.UTC
 import Data.Time.Clock.Scale (picosecondsToDiffTime)
 import Data.Time.Calendar.Days
-import Data.Fixed
-import Control.Monad
-import Data.Int    (Int64)
+import Data.Int (Int64)
+import Data.Fixed (divMod')
+import Control.DeepSeq
 
 #include "HsTimeConfig.h"
 
 #ifdef mingw32_HOST_OS
-import Data.Word    (Word64)
+import Data.Word (Word64)
 import System.Win32.Time
 #elif HAVE_CLOCK_GETTIME
 import Data.Time.Clock.CTimespec
@@ -25,35 +25,52 @@ import Data.Time.Clock.CTimeval
 import Foreign.C.Types (CLong(..))
 #endif
 
--- | 86400 nominal seconds in every day
-posixDayLength :: NominalDiffTime
-posixDayLength = 86400
-
--- | 86400 nominal seconds in every day
-posixDayLength_ :: Int64
-posixDayLength_ = 86400
+--------------------------------------------------------------------------------
 
 -- | POSIX time is the nominal time since 1970-01-01 00:00 UTC
 --
--- To convert from a 'Foreign.C.CTime' or 'System.Posix.EpochTime', use 'realToFrac'.
---
-type POSIXTime = NominalDiffTime
+data POSIXTime = POSIXTime
+    { ptSeconds ::     {-# UNPACK #-} !Int64
+    , ptNanoSeconds :: {-# UNPACK #-} !Int64
+    }
+
+normalizePosix :: POSIXTime -> POSIXTime
+normalizePosix raw@(POSIXTime xs xn)
+    | xn < 0 || xn >= 1000000000 = POSIXTime (xs + q)  r
+    | otherwise                  = raw
+  where (q, r) = xn `divMod` 1000000000
+
+instance Eq POSIXTime where
+    rawx == rawy =
+        let POSIXTime xs xn = normalizePosix rawx
+            POSIXTime ys yn = normalizePosix rawy
+        in xs == ys && xn == yn
+
+instance Ord POSIXTime where
+    rawx `compare` rawy =
+        let POSIXTime xs xn = normalizePosix rawx
+            POSIXTime ys yn = normalizePosix rawy
+            os = compare xs ys
+        in if os == EQ then xn `compare` yn else os
+
+instance NFData POSIXTime where
+    rnf a = a `seq` ()
+
+posixToUTCTime :: POSIXTime -> UTCTime
+posixToUTCTime raw =
+    let POSIXTime s ns = normalizePosix raw
+        (d, s') = s `divMod` posixDayLength
+        ps = s' * 1000000000000 + ns * 1000 -- 'Int64' can hold ps in one day
+    in UTCTime (addDays (fromIntegral d) unixEpochDay)
+               (picosecondsToDiffTime (fromIntegral ps))
+
+posixDayLength :: Int64
+posixDayLength = 86400
 
 unixEpochDay :: Day
 unixEpochDay = ModifiedJulianDay 40587
 
-posixSecondsToUTCTime :: POSIXTime -> UTCTime
-posixSecondsToUTCTime i = let
-    (d,t) = divMod' i posixDayLength
- in UTCTime (addDays d unixEpochDay) (realToFrac t)
-
-utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime
-utcTimeToPOSIXSeconds (UTCTime d t) =
- (fromInteger (diffDays d unixEpochDay) * posixDayLength) + min posixDayLength (realToFrac t)
-
--- | Get the current POSIX time from the system clock.
 getPOSIXTime :: IO POSIXTime
-
 #ifdef mingw32_HOST_OS
 -- On Windows, the equlvalent of POSIX time is "file time", defined as
 -- the number of 100-nanosecond intervals that have elapsed since
@@ -61,56 +78,42 @@ getPOSIXTime :: IO POSIXTime
 -- time by adjusting the offset to be relative to the POSIX epoch.
 
 getPOSIXTime = do
-  FILETIME ft <- System.Win32.Time.getSystemTimeAsFileTime
-  return (fromIntegral (ft - win32_epoch_adjust) / 10000000)
-
-win32_epoch_adjust :: Word64
-win32_epoch_adjust = 116444736000000000
-
-getCurrentTime = do
     FILETIME ft <- System.Win32.Time.getSystemTimeAsFileTime
     let (s, us) = (ft - win32_epoch_adjust) `divMod` 10000000
-        (d, s') = fromIntegral s `divMod` posixDayLength_
-        ps = s' * 1000000000000 + fromIntegral us * 1000000 -- 'Int64' can hold ps in one day
-    return
-        (UTCTime
-            (addDays (fromIntegral d) unixEpochDay)
-            (picosecondsToDiffTime (fromIntegral ps))
-        )
+    return (POSIXTime (fromIntegral s) (fromIntegral us * 1000))
+  where
+    win32_epoch_adjust :: Word64
+    win32_epoch_adjust = 116444736000000000
 
 #elif HAVE_CLOCK_GETTIME
+-- Use hi-res clock_gettime
 
--- Use hi-res POSIX time
-ctimespecToPosixSeconds :: CTimespec -> POSIXTime
-ctimespecToPosixSeconds (MkCTimespec (CTime s) ns) =
-    (fromIntegral s) + (fromIntegral ns) / 1000000000
-
-getPOSIXTime = liftM ctimespecToPosixSeconds getCTimespec
-
-getCurrentTime = do
+getPOSIXTime = do
     MkCTimespec (CTime s) (CLong ns) <- getCTimespec
-    let (d, s') = s `divMod` posixDayLength_
-        ps = s' * 1000000000000 + ns * 1000
-    return
-        (UTCTime
-            (addDays (fromIntegral d) unixEpochDay)
-            (picosecondsToDiffTime (fromIntegral ps))
-        )
+    return (POSIXTime (fromIntegral s) (fromIntegral ns))
+
 #else
+-- Use gettimeofday
+getPOSIXTime = do
+    MkCTimeval (CLong s) (CLong us) <- getCTimeval
+    return (POSIXTime (fromIntegral s) (fromIntegral us * 1000))
 
--- Use POSIX time
-ctimevalToPosixSeconds :: CTimeval -> POSIXTime
-ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (fromIntegral mus) / 1000000
+#endif
 
-getPOSIXTime = liftM ctimevalToPosixSeconds getCTimeval
+--------------------------------------------------------------------------------
 
-getCurrentTime = do
-    MkCTimeval (CLong s) (CLong us) <- getCTimeval
-    let (d, s') = s `divMod` posixDayLength_
-        ps = s' * 1000000000000 + us * 1000000
-    return
-        (UTCTime
-            (addDays (fromIntegral d) unixEpochDay)
-            (picosecondsToDiffTime (fromIntegral ps))
-        )
-#endif
+posixDayLength_ :: NominalDiffTime
+posixDayLength_ = 86400
+
+posixSecondsToUTCTime :: NominalDiffTime -> UTCTime
+posixSecondsToUTCTime i = let
+    (d,t) = divMod' i posixDayLength_
+ in UTCTime (addDays d unixEpochDay) (realToFrac t)
+
+utcTimeToPOSIXSeconds :: UTCTime -> NominalDiffTime
+utcTimeToPOSIXSeconds (UTCTime d t) =
+ (fromInteger (diffDays d unixEpochDay) * posixDayLength_) + min posixDayLength_ (realToFrac t)
+
+-- | Get the current 'UTCTime' from the system clock.
+getCurrentTime :: IO UTCTime
+getCurrentTime = posixToUTCTime `fmap` getPOSIXTime
diff --git a/lib/Data/Time/LocalTime/TimeZone.hs b/lib/Data/Time/LocalTime/TimeZone.hs
index 9381075..1b97643 100644
--- a/lib/Data/Time/LocalTime/TimeZone.hs
+++ b/lib/Data/Time/LocalTime/TimeZone.hs
@@ -79,7 +79,7 @@ utc = TimeZone 0 False "UTC"
 {-# CFILES cbits/HsTime.c #-}
 foreign import ccall unsafe "HsTime.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> Ptr CString -> IO CLong
 
-posixToCTime :: POSIXTime -> CTime
+posixToCTime :: NominalDiffTime -> CTime
 posixToCTime  = fromInteger . floor
 
 -- | Get the local time-zone for a given time (varying as per summertime adjustments)



More information about the ghc-commits mailing list