Skip to content

Commit 0c380e8

Browse files
Int64# was added in GHC 9.4.x
1 parent e5439d2 commit 0c380e8

File tree

2 files changed

+75
-26
lines changed

2 files changed

+75
-26
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 & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,52 @@ 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+
71+
intToInt64 :: Int## -> Int##
72+
intToInt64 i = i
73+
74+
plusInt64 :: Int## -> Int## -> Int##
75+
plusInt64 a b = a +## b
76+
77+
eqInt64 :: Int## -> Int## -> Int##
78+
eqInt64 a b = a ==## b
79+
80+
readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int## ##)
81+
readInt64Array = readIntArray##
82+
83+
writeInt64Array :: MutableByteArray## d -> Int## -> Int## -> State## d -> State## d
84+
writeInt64Array = writeIntArray##
85+
#endif
86+
87+
#else
88+
-- I don't know a better way on 32-bit machines...
89+
int64ToDouble i =
90+
case fromIntegral (I64## i) of (D## d) -> d
91+
#endif
92+
4793
-- | An metric for tracking events.
4894
newtype Distribution = Distribution { unD :: Array Stripe }
4995

@@ -90,7 +136,7 @@ newDistrib = IO $ \s ->
90136
-- probably unecessary
91137
case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
92138
case countPos of { (I## countPos') ->
93-
case writeInt64Array## mba countPos' (intToInt64## 0##) s2 of { s3 ->
139+
case writeInt64Array mba countPos' (intToInt64 0##) s2 of { s3 ->
94140
case meanPos of { (I## meanPos') ->
95141
case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
96142
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -148,17 +194,6 @@ spinUnlock mba = \s ->
148194
case writeIntArray## mba lockPos' 0## s of { s2 ->
149195
s2 }}
150196

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 #-}
162197

163198
-- | Add the same value to the distribution N times.
164199
-- Mean and variance are computed according to
@@ -169,7 +204,7 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
169204
case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
170205
case spinLock mba s1 of { s2 ->
171206
case countPos of { (I## countPos') ->
172-
case readInt64Array## mba countPos' s2 of { (## s3, count ##) ->
207+
case readInt64Array mba countPos' s2 of { (## s3, count ##) ->
173208
case meanPos of { (I## meanPos') ->
174209
case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
175210
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -180,11 +215,11 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
180215
case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
181216
case maxPos of { (I## maxPos') ->
182217
case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
183-
case plusInt64## count n of { count' ->
218+
case plusInt64 count n of { count' ->
184219
case val -#### mean of { delta ->
185220
case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
186221
case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
187-
case writeInt64Array## mba countPos' count' s8 of { s9 ->
222+
case writeInt64Array mba countPos' count' s8 of { s9 ->
188223
case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
189224
case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
190225
case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
@@ -204,9 +239,9 @@ combine :: Distrib -> Distrib -> IO ()
204239
combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
205240
case spinLock bMBA s of { s1 ->
206241
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' ->
242+
case readInt64Array aMBA countPos' s1 of { (## s2, aCount ##) ->
243+
case readInt64Array bMBA countPos' s2 of { (## s3, bCount ##) ->
244+
case plusInt64 aCount bCount of { count' ->
210245
case meanPos of { (I## meanPos' ) ->
211246
case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
212247
case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
@@ -226,8 +261,8 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
226261
)
227262
)
228263
) 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 ->
264+
case writeInt64Array aMBA countPos' count' s7 of { s8 ->
265+
case (case eqInt64 count' (intToInt64 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
231266
case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
232267
case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
233268
case sumPos of { (I## sumPos') ->
@@ -258,7 +293,7 @@ read distrib = do
258293
case sumPos of { (I## sumPos') ->
259294
case minPos of { (I## minPos') ->
260295
case maxPos of { (I## maxPos') ->
261-
case readInt64Array## mba countPos' s of { (## s1, count ##) ->
296+
case readInt64Array mba countPos' s of { (## s1, count ##) ->
262297
case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
263298
case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
264299
case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->

0 commit comments

Comments
 (0)