[commit: packages/time] format-widths, improve-leapseconds, master, posix-perf, tasty, wip/travis: RULES for realToFrac, for speed, contributed by Liyang HU <haskell.org at liyang.hu> (8eee78e)

[git at git.haskell.org]

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

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/8eee78e5d4de47651bb837adb28f3550e0611a52

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

commit 8eee78e5d4de47651bb837adb28f3550e0611a52
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sun Oct 30 17:38:00 2011 -0700

    RULES for realToFrac, for speed, contributed by Liyang HU <haskell.org at liyang.hu>
    
    Ignore-this: c277f94b61ec0c6eab64c1770478220b
    
    darcs-hash:20111031003800-ac6dd-affc63c79ba1478a0ebe610bdd42772a7fd85d86


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

8eee78e5d4de47651bb837adb28f3550e0611a52
 Data/Time/Clock/Scale.hs    |  6 ++++++
 Data/Time/Clock/UTC.hs      |  9 +++++++++
 test/Makefile               | 10 +++++++---
 test/RealToFracBenchmark.hs | 22 ++++++++++++++++++++++
 time.cabal                  |  2 +-
 5 files changed, 45 insertions(+), 4 deletions(-)

diff --git a/Data/Time/Clock/Scale.hs b/Data/Time/Clock/Scale.hs
index 37c3f32..ffa52a2 100644
--- a/Data/Time/Clock/Scale.hs
+++ b/Data/Time/Clock/Scale.hs
@@ -106,3 +106,9 @@ secondsToDiffTime = fromInteger
 -- | Create a 'DiffTime' from a number of picoseconds.
 picosecondsToDiffTime :: Integer -> DiffTime
 picosecondsToDiffTime x = fromRational (x % 1000000000000)
+
+{-# RULES
+"realToFrac/DiffTime->Pico"              realToFrac = \ (MkDiffTime ps) -> ps
+"realToFrac/Pico->DiffTime"              realToFrac = MkDiffTime
+  #-}
+
diff --git a/Data/Time/Clock/UTC.hs b/Data/Time/Clock/UTC.hs
index e172b15..4f3c23a 100644
--- a/Data/Time/Clock/UTC.hs
+++ b/Data/Time/Clock/UTC.hs
@@ -118,3 +118,12 @@ instance RealFrac NominalDiffTime where
 	round (MkNominalDiffTime a) = round a
 	ceiling (MkNominalDiffTime a) = ceiling a
 	floor (MkNominalDiffTime a) = floor a
+
+{-# RULES
+"realToFrac/DiffTime->NominalDiffTime"   realToFrac = \ dt -> MkNominalDiffTime (realToFrac dt)
+"realToFrac/NominalDiffTime->DiffTime"   realToFrac = \ (MkNominalDiffTime ps) -> realToFrac ps
+
+"realToFrac/NominalDiffTime->Pico"       realToFrac = \ (MkNominalDiffTime ps) -> ps
+"realToFrac/Pico->NominalDiffTime"       realToFrac = MkNominalDiffTime
+  #-}
+
diff --git a/test/Makefile b/test/Makefile
index f8ef07d..ca57f7d 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -52,6 +52,9 @@ TimeZone.ref: FORCE
 TestParseTime: TestParseTime.o
 	$(GHC) $(GHCFLAGS) $^ -o $@
 
+RealToFracBenchmark: RealToFracBenchmark.o
+	$(GHC) $(GHCFLAGS) $^ -o $@
+
 test:	\
 	TestMonthDay.diff	\
 	ConvertBack.diff0	\
@@ -64,13 +67,14 @@ test:	\
 	TestFormat.diff0	\
 	TestParseDAT.diff	\
 	TestEaster.diff	\
-	TestParseTime.run \
-	UseCases.o
+	TestParseTime.run	\
+	UseCases.o	\
+	RealToFracBenchmark.run
 	@echo "Success!"
 
 clean:
 	rm -rf TestMonthDay ConvertBack TestCalendars TestTime LongWeekYears ClipDates	\
-	AddDays TestFormat TestParseDAT TestEaster CurrentTime ShowDST TimeZone TimeZone.ref TestParseTime \
+	AddDays TestFormat TestParseDAT TestEaster CurrentTime ShowDST TimeZone TimeZone.ref TestParseTime RealToFracBenchmark \
         *.out *.run *.o *.hi Makefile.bak
 
 %.diff: %.ref %.out
diff --git a/test/RealToFracBenchmark.hs b/test/RealToFracBenchmark.hs
new file mode 100644
index 0000000..be4eae2
--- /dev/null
+++ b/test/RealToFracBenchmark.hs
@@ -0,0 +1,22 @@
+{- Contributed by Liyang HU <haskell.org at liyang.hu> -}
+module Main where
+
+import Prelude
+import Control.Applicative
+import Control.Monad
+import Control.DeepSeq
+import Data.Time
+import Data.Time.Clock.POSIX
+import System.Random
+
+main :: IO ()
+main = do
+    ts <- replicateM 100000 $ do
+        t <- posixSecondsToUTCTime . realToFrac <$>
+            ( (*) . fromInteger <$> randomRIO (-15*10^21, 15*10^21) <*>
+                randomIO :: IO Double ) :: IO UTCTime
+        rnf t `seq` return t
+    now <- getCurrentTime
+    print . sum $ map (diffUTCTime now) ts
+    print =<< flip diffUTCTime now <$> getCurrentTime
+
diff --git a/time.cabal b/time.cabal
index 7acb243..cadeea7 100644
--- a/time.cabal
+++ b/time.cabal
@@ -1,5 +1,5 @@
 name:           time
-version:        1.4
+version:        1.4.0.1
 stability:      stable
 license:        BSD3
 license-file:   LICENSE