[commit: packages/time] format-widths, master, posix-perf, tasty: add bench, improve getCurrentTime (9008175)
git at git.haskell.org
git at git.haskell.org
Mon Feb 20 21:18:55 UTC 2017
Repository : ssh://git@git.haskell.org/time
On branches: format-widths,master,posix-perf,tasty
Link : http://git.haskell.org/packages/time.git/commitdiff/900817565e44152e1083d5dd2d0f7e07683c830a
>---------------------------------------------------------------
commit 900817565e44152e1083d5dd2d0f7e07683c830a
Author: winterland1989 <winterland1989 at gmail.com>
Date: Tue Nov 29 01:59:32 2016 +0800
add bench, improve getCurrentTime
>---------------------------------------------------------------
900817565e44152e1083d5dd2d0f7e07683c830a
benchmark/Main.hs | 19 +++++++++++++
lib/Data/Time/Clock/POSIX.hs | 43 +++++++++++++++++++++++++-----
time.cabal | 63 ++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 119 insertions(+), 6 deletions(-)
diff --git a/benchmark/Main.hs b/benchmark/Main.hs
new file mode 100644
index 0000000..e64a3cf
--- /dev/null
+++ b/benchmark/Main.hs
@@ -0,0 +1,19 @@
+module Main where
+
+-------------------------------------------------------------------------------
+
+import Criterion.Main
+import Data.Time.Clock.POSIX
+import Data.Time
+
+main :: IO ()
+main = do
+ getCurrentTime >>= print
+ getPOSIXTime >>= print . posixSecondsToUTCTime
+ defaultMain
+ [ bgroup "time"
+ [ bench "UTCTime" $ whnfIO getCurrentTime
+ , bench "POSIXTime" $ whnfIO getPOSIXTime
+ ]
+ ]
+
diff --git a/lib/Data/Time/Clock/POSIX.hs b/lib/Data/Time/Clock/POSIX.hs
index a7a3737..1aa1901 100644
--- a/lib/Data/Time/Clock/POSIX.hs
+++ b/lib/Data/Time/Clock/POSIX.hs
@@ -6,18 +6,20 @@ module Data.Time.Clock.POSIX
) 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)
#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
-import Foreign.C.Types (CTime(..))
+import Foreign.C.Types (CTime(..), CLong(..))
#else
import Data.Time.Clock.CTimeval
#endif
@@ -26,6 +28,10 @@ import Data.Time.Clock.CTimeval
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'.
@@ -60,6 +66,17 @@ getPOSIXTime = do
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))
+ )
+
#elif HAVE_CLOCK_GETTIME
-- Use hi-res POSIX time
@@ -69,6 +86,15 @@ ctimespecToPosixSeconds (MkCTimespec (CTime s) ns) =
getPOSIXTime = liftM ctimespecToPosixSeconds getCTimespec
+getCurrentTime = 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))
+ )
#else
-- Use POSIX time
@@ -77,8 +103,13 @@ ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (fromIntegral mus
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
-
--- | Get the current UTC time from the system clock.
-getCurrentTime :: IO UTCTime
-getCurrentTime = liftM posixSecondsToUTCTime getPOSIXTime
diff --git a/time.cabal b/time.cabal
index 99ed765..8f791e8 100644
--- a/time.cabal
+++ b/time.cabal
@@ -151,3 +151,66 @@ test-suite tests
Test.AddDays
Test.AddDaysRef
Test.TestUtil
+
+benchmark bench
+ hs-source-dirs: lib, benchmark
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ if impl(ghc)
+ default-extensions:
+ Rank2Types
+ DeriveDataTypeable
+ StandaloneDeriving
+ cpp-options: -DLANGUAGE_Rank2Types -DLANGUAGE_DeriveDataTypeable -DLANGUAGE_StandaloneDeriving
+ else
+ if impl(hugs)
+ default-extensions: Rank2Types
+ cpp-options: -DLANGUAGE_Rank2Types
+ ghc-options: -Wall -fwarn-tabs
+ build-depends:
+ base >= 4.7 && < 5
+ , deepseq >= 1.1
+ , criterion >= 1.0.2.0
+ , time
+
+ if os(windows)
+ build-depends: Win32
+ other-modules:
+ Data.Time.Calendar,
+ Data.Time.Calendar.MonthDay,
+ Data.Time.Calendar.OrdinalDate,
+ Data.Time.Calendar.WeekDate,
+ Data.Time.Calendar.Julian,
+ Data.Time.Calendar.Easter,
+ Data.Time.Clock,
+ Data.Time.Clock.POSIX,
+ Data.Time.Clock.TAI,
+ Data.Time.LocalTime,
+ Data.Time.Format,
+ Data.Time
+ default-extensions: CPP
+ c-sources: lib/cbits/HsTime.c
+ other-modules:
+ Data.Time.Calendar.Private,
+ Data.Time.Calendar.Days,
+ Data.Time.Calendar.Gregorian,
+ Data.Time.Calendar.JulianYearDay,
+ Data.Time.Clock.Scale,
+ Data.Time.Clock.UTC,
+ Data.Time.Clock.CTimeval,
+ Data.Time.Clock.CTimespec,
+ Data.Time.Clock.UTCDiff,
+ Data.Time.LocalTime.TimeZone,
+ Data.Time.LocalTime.TimeOfDay,
+ Data.Time.LocalTime.LocalTime,
+ Data.Time.Format.Parse
+ Data.Time.Format.Locale
+ include-dirs: lib/include
+ if os(windows)
+ install-includes:
+ HsTime.h
+ else
+ install-includes:
+ HsTime.h
+ HsTimeConfig.h
More information about the ghc-commits
mailing list