@@ -0,0 +1,156 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
4+#if __GLASGOW_HASKELL__ >= 800
5+{-# OPTIONS_GHC -Wno-identities #-}
6+#endif
7+
8+#ifndef __GHCJS__
9+#include "config.h"
10+#endif
11+
12+#include "config-clock.h"
13+
14+-- |
15+-- Module : Streamly.Internal.Data.Time.TimeSpec
16+-- Copyright : (c) 2019 Composewell Technologies
17+-- License : BSD3
18+-- Maintainer : streamly@composewell.com
19+-- Stability : experimental
20+-- Portability : GHC
21+
22+module Streamly.Internal.Data.Time.TimeSpec
23+ (
24+ TimeSpec(..)
25+ )
26+where
27+
28+import Data.Int (Int64)
29+import Foreign.Storable (Storable(..), peek)
30+
31+#ifdef HS_CLOCK_GHCJS
32+import Foreign.C (CTime(..), CLong(..))
33+#endif
34+
35+-------------------------------------------------------------------------------
36+-- Some constants
37+-------------------------------------------------------------------------------
38+
39+{-# INLINE tenPower9 #-}
40+tenPower9 :: Int64
41+tenPower9 = 1000000000
42+
43+-------------------------------------------------------------------------------
44+-- TimeSpec representation
45+-------------------------------------------------------------------------------
46+
47+-- A structure storing seconds and nanoseconds as 'Int64' is the simplest and
48+-- fastest way to store practically large quantities of time with efficient
49+-- arithmetic operations. If we store nanoseconds using 'Integer' it can store
50+-- practically unbounded quantities but it may not be as efficient to
51+-- manipulate in performance critical applications. XXX need to measure the
52+-- performance.
53+--
54+-- | Data type to represent practically large quantities of time efficiently.
55+-- It can represent time up to ~292 billion years at nanosecond resolution.
56+data TimeSpec = TimeSpec
57+ { sec :: {-# UNPACK #-} !Int64 -- ^ seconds
58+ , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds
59+ } deriving (Eq, Read, Show)
60+
61+-- We assume that nsec is always less than 10^9. When TimeSpec is negative then
62+-- both sec and nsec are negative.
63+instance Ord TimeSpec where
64+ compare (TimeSpec s1 ns1) (TimeSpec s2 ns2) =
65+ if s1 == s2
66+ then compare ns1 ns2
67+ else compare s1 s2
68+
69+-- make sure nsec is less than 10^9
70+{-# INLINE addWithOverflow #-}
71+addWithOverflow :: TimeSpec -> TimeSpec -> TimeSpec
72+addWithOverflow (TimeSpec s1 ns1) (TimeSpec s2 ns2) =
73+ let nsum = ns1 + ns2
74+ (s', ns) = if nsum > tenPower9 || nsum < negate tenPower9
75+ then nsum `divMod` tenPower9
76+ else (0, nsum)
77+ in TimeSpec (s1 + s2 + s') ns
78+
79+-- make sure both sec and nsec have the same sign
80+{-# INLINE adjustSign #-}
81+adjustSign :: TimeSpec -> TimeSpec
82+adjustSign t@(TimeSpec s ns)
83+ | s > 0 && ns < 0 = TimeSpec (s - 1) (ns + tenPower9)
84+ | s < 0 && ns > 0 = TimeSpec (s + 1) (ns - tenPower9)
85+ | otherwise = t
86+
87+{-# INLINE timeSpecToInteger #-}
88+timeSpecToInteger :: TimeSpec -> Integer
89+timeSpecToInteger (TimeSpec s ns) = toInteger $ s * tenPower9 + ns
90+
91+instance Num TimeSpec where
92+ {-# INLINE (+) #-}
93+ t1 + t2 = adjustSign (addWithOverflow t1 t2)
94+
95+ -- XXX will this be more optimal if imlemented without "negate"?
96+ {-# INLINE (-) #-}
97+ t1 - t2 = t1 + negate t2
98+ t1 * t2 = fromInteger $ timeSpecToInteger t1 * timeSpecToInteger t2
99+
100+ {-# INLINE negate #-}
101+ negate (TimeSpec s ns) = TimeSpec (negate s) (negate ns)
102+ {-# INLINE abs #-}
103+ abs (TimeSpec s ns) = TimeSpec (abs s) (abs ns)
104+ {-# INLINE signum #-}
105+ signum (TimeSpec s ns) | s == 0 = TimeSpec (signum ns) 0
106+ | otherwise = TimeSpec (signum s) 0
107+ -- This is fromNanoSecond64 Integer
108+ {-# INLINE fromInteger #-}
109+ fromInteger nanosec = TimeSpec (fromInteger s) (fromInteger ns)
110+ where (s, ns) = nanosec `divMod` toInteger tenPower9
111+
112+#if HS_CLOCK_POSIX
113+#include <time.h>
114+#endif
115+
116+#if __GLASGOW_HASKELL__ < 800
117+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)
118+#endif
119+
120+#ifdef HS_CLOCK_GHCJS
121+instance Storable TimeSpec where
122+ sizeOf _ = 8
123+ alignment _ = 4
124+ peek p = do
125+ CTime s <- peekByteOff p 0
126+ CLong ns <- peekByteOff p 4
127+ return (TimeSpec (fromIntegral s) (fromIntegral ns))
128+ poke p (TimeSpec s ns) = do
129+ pokeByteOff p 0 ((fromIntegral s) :: CTime)
130+ pokeByteOff p 4 ((fromIntegral ns) :: CLong)
131+
132+#elif HS_CLOCK_WINDOWS
133+instance Storable TimeSpec where
134+ sizeOf _ = sizeOf (undefined :: Int64) * 2
135+ alignment _ = alignment (undefined :: Int64)
136+ peek ptr = do
137+ s <- peekByteOff ptr 0
138+ ns <- peekByteOff ptr (sizeOf (undefined :: Int64))
139+ return (TimeSpec s ns)
140+ poke ptr ts = do
141+ pokeByteOff ptr 0 (sec ts)
142+ pokeByteOff ptr (sizeOf (undefined :: Int64)) (nsec ts)
143+#else
144+instance Storable TimeSpec where
145+ sizeOf _ = #{size struct timespec}
146+ alignment _ = #{alignment struct timespec}
147+ peek ptr = do
148+ s :: #{type time_t} <- #{peek struct timespec, tv_sec} ptr
149+ ns :: #{type long} <- #{peek struct timespec, tv_nsec} ptr
150+ return $ TimeSpec (fromIntegral s) (fromIntegral ns)
151+ poke ptr ts = do
152+ let s :: #{type time_t} = fromIntegral $ sec ts
153+ ns :: #{type long} = fromIntegral $ nsec ts
154+ #{poke struct timespec, tv_sec} ptr (s)
155+ #{poke struct timespec, tv_nsec} ptr (ns)
156+#endif