Skip to content

Commit 5097e63

Browse files
Int64# was added in GHC 9.4.x
1 parent e5439d2 commit 5097e63

File tree

2 files changed

+75
-27
lines changed

2 files changed

+75
-27
lines changed

Data/Atomic.hs

Lines changed: 19 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -43,37 +43,51 @@ import Data.IORef
4343
-- 64-bit machine, Int ~ Int64, do it the fast way:
4444
#if SIZEOF_HSINT == 8
4545

46+
#if MIN_VERSION_base(4,17,0)
47+
int64ToInt :: Int64# -> Int#
48+
int64ToInt = int64ToInt#
49+
50+
intToInt64 :: Int# -> Int64#
51+
intToInt64 = intToInt64#
52+
#else
53+
int64ToInt :: Int# -> Int#
54+
int64ToInt i = i
55+
56+
intToInt64 :: Int# -> Int#
57+
intToInt64 i = i
58+
#endif
59+
4660
-- | A mutable, atomic integer.
4761
data Atomic = C (MutableByteArray# RealWorld)
4862

4963
-- | Create a new, zero initialized, atomic.
5064
new :: Int64 -> IO Atomic
5165
new (I64# n64) = IO $ \s ->
5266
case newByteArray# SIZEOF_HSINT# s of { (# s1, mba #) ->
53-
case atomicWriteIntArray# mba 0# (int64ToInt# n64) s1 of { s2 ->
67+
case atomicWriteIntArray# mba 0# (int64ToInt n64) s1 of { s2 ->
5468
(# s2, C mba #) }}
5569

5670
read :: Atomic -> IO Int64
5771
read (C mba) = IO $ \s ->
5872
case atomicReadIntArray# mba 0# s of { (# s1, n #) ->
59-
(# s1, I64# (intToInt64# n) #)}
73+
(# s1, I64# (intToInt64 n) #)}
6074

6175
-- | Set the atomic to the given value.
6276
write :: Atomic -> Int64 -> IO ()
6377
write (C mba) (I64# n64) = IO $ \s ->
64-
case atomicWriteIntArray# mba 0# (int64ToInt# n64) s of { s1 ->
78+
case atomicWriteIntArray# mba 0# (int64ToInt n64) s of { s1 ->
6579
(# s1, () #) }
6680

6781
-- | Increase the atomic by the given amount.
6882
add :: Atomic -> Int64 -> IO ()
6983
add (C mba) (I64# n64) = IO $ \s ->
70-
case fetchAddIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
84+
case fetchAddIntArray# mba 0# (int64ToInt n64) s of { (# s1, _ #) ->
7185
(# s1, () #) }
7286

7387
-- | Decrease the atomic by the given amount.
7488
subtract :: Atomic -> Int64 -> IO ()
7589
subtract (C mba) (I64# n64) = IO $ \s ->
76-
case fetchSubIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
90+
case fetchSubIntArray# mba 0# (int64ToInt n64) s of { (# s1, _ #) ->
7791
(# s1, () #) }
7892

7993
#else

System/Metrics/Distribution.hsc

Lines changed: 56 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -36,14 +36,59 @@ import Prelude hiding (max, min, read, sum)
3636
import Foreign.Storable (sizeOf)
3737

3838
import GHC.Float
39-
import GHC.Int
39+
import GHC.Int (Int(..), Int64(..))
4040
import GHC.IO
4141
import GHC.Prim
4242

4343
import Data.Array
4444
import System.Metrics.Distribution.Internal (Stats(..))
4545
import System.Metrics.ThreadId
4646

47+
-- 64-bit machine, Int ~ Int64, do it the fast way:
48+
#if SIZEOF_HSINT == 8
49+
50+
#if MIN_VERSION_base(4,17,0)
51+
int64ToDouble :: Int64## -> Double##
52+
int64ToDouble i = int2Double## (int64ToInt## i)
53+
54+
intToInt64 :: Int## -> Int64##
55+
intToInt64 = intToInt64##
56+
57+
plusInt64 :: Int64## -> Int64## -> Int64##
58+
plusInt64 = plusInt64##
59+
60+
eqInt64 :: Int64## -> Int64## -> Int##
61+
eqInt64 = eqInt64##
62+
63+
readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int64## ##)
64+
readInt64Array = readInt64Array##
65+
66+
writeInt64Array :: MutableByteArray## d -> Int## -> Int64## -> State## d -> State## d
67+
writeInt64Array = writeInt64Array##
68+
69+
#else
70+
intToInt64 :: Int## -> Int##
71+
intToInt64 i = i
72+
73+
plusInt64 :: Int## -> Int## -> Int##
74+
plusInt64 a b = a +## b
75+
76+
eqInt64 :: Int## -> Int## -> Int##
77+
eqInt64 a b = a ==## b
78+
79+
readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int## ##)
80+
readInt64Array = readIntArray##
81+
82+
writeInt64Array :: MutableByteArray## d -> Int## -> Int## -> State## d -> State## d
83+
writeInt64Array = writeIntArray##
84+
#endif
85+
86+
#else
87+
-- I don't know a better way on 32-bit machines...
88+
int64ToDouble i =
89+
case fromIntegral (I64## i) of (D## d) -> d
90+
#endif
91+
4792
-- | An metric for tracking events.
4893
newtype Distribution = Distribution { unD :: Array Stripe }
4994

@@ -90,7 +135,7 @@ newDistrib = IO $ \s ->
90135
-- probably unecessary
91136
case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
92137
case countPos of { (I## countPos') ->
93-
case writeInt64Array## mba countPos' (intToInt64## 0##) s2 of { s3 ->
138+
case writeInt64Array mba countPos' (intToInt64 0##) s2 of { s3 ->
94139
case meanPos of { (I## meanPos') ->
95140
case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
96141
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -148,17 +193,6 @@ spinUnlock mba = \s ->
148193
case writeIntArray## mba lockPos' 0## s of { s2 ->
149194
s2 }}
150195

151-
int64ToDouble :: Int64## -> Double##
152-
-- 64-bit machine, Int ~ Int64, do it the fast way:
153-
#if SIZEOF_HSINT == 8
154-
int64ToDouble i = int2Double## (int64ToInt## i)
155-
#else
156-
-- I don't know a better way on 32-bit machines...
157-
int64ToDouble i =
158-
case fromIntegral (I64## i) of (D## d) -> d
159-
#endif
160-
161-
{-# INLINE int64ToDouble #-}
162196

163197
-- | Add the same value to the distribution N times.
164198
-- Mean and variance are computed according to
@@ -169,7 +203,7 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
169203
case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
170204
case spinLock mba s1 of { s2 ->
171205
case countPos of { (I## countPos') ->
172-
case readInt64Array## mba countPos' s2 of { (## s3, count ##) ->
206+
case readInt64Array mba countPos' s2 of { (## s3, count ##) ->
173207
case meanPos of { (I## meanPos') ->
174208
case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
175209
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -180,11 +214,11 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
180214
case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
181215
case maxPos of { (I## maxPos') ->
182216
case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
183-
case plusInt64## count n of { count' ->
217+
case plusInt64 count n of { count' ->
184218
case val -#### mean of { delta ->
185219
case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
186220
case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
187-
case writeInt64Array## mba countPos' count' s8 of { s9 ->
221+
case writeInt64Array mba countPos' count' s8 of { s9 ->
188222
case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
189223
case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
190224
case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
@@ -204,9 +238,9 @@ combine :: Distrib -> Distrib -> IO ()
204238
combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
205239
case spinLock bMBA s of { s1 ->
206240
case countPos of { (I## countPos') ->
207-
case readInt64Array## aMBA countPos' s1 of { (## s2, aCount ##) ->
208-
case readInt64Array## bMBA countPos' s2 of { (## s3, bCount ##) ->
209-
case plusInt64## aCount bCount of { count' ->
241+
case readInt64Array aMBA countPos' s1 of { (## s2, aCount ##) ->
242+
case readInt64Array bMBA countPos' s2 of { (## s3, bCount ##) ->
243+
case plusInt64 aCount bCount of { count' ->
210244
case meanPos of { (I## meanPos' ) ->
211245
case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
212246
case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
@@ -226,8 +260,8 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
226260
)
227261
)
228262
) of { sumSqDelta' ->
229-
case writeInt64Array## aMBA countPos' count' s7 of { s8 ->
230-
case (case eqInt64## count' (intToInt64## 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
263+
case writeInt64Array aMBA countPos' count' s7 of { s8 ->
264+
case (case eqInt64 count' (intToInt64 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
231265
case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
232266
case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
233267
case sumPos of { (I## sumPos') ->
@@ -258,7 +292,7 @@ read distrib = do
258292
case sumPos of { (I## sumPos') ->
259293
case minPos of { (I## minPos') ->
260294
case maxPos of { (I## maxPos') ->
261-
case readInt64Array## mba countPos' s of { (## s1, count ##) ->
295+
case readInt64Array mba countPos' s of { (## s1, count ##) ->
262296
case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
263297
case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
264298
case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->

0 commit comments

Comments
 (0)