[commit: packages/time] format-widths, ghc, master, posix-perf, tasty: add bench, improve getCurrentTime (9008175)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:55:16 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/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