Skip to content

Commit 4ae9273

Browse files
Int64# was added in GHC 9.4.x
1 parent e5439d2 commit 4ae9273

File tree

2 files changed

+68
-26
lines changed

2 files changed

+68
-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: 49 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,45 @@ 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+
readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int64## ##)
61+
readInt64Array = readInt64Array##
62+
63+
writeInt64Array :: MutableByteArray## d -> Int## -> Int64## -> State## d -> State## d
64+
writeInt64Array = writeInt64Array##
65+
#else
66+
67+
intToInt64 :: Int## -> Int##
68+
intToInt64 i = i
69+
70+
plusInt64 :: Int## -> Int## -> Int##
71+
plusInt64 = (+##)
72+
73+
readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int## ##)
74+
readInt64Array = readIntArray##
75+
76+
writeInt64Array :: MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
77+
writeInt64Array = writeIntArray##
78+
#endif
79+
80+
#else
81+
-- I don't know a better way on 32-bit machines...
82+
int64ToDouble i =
83+
case fromIntegral (I64## i) of (D## d) -> d
84+
#endif
85+
4786
-- | An metric for tracking events.
4887
newtype Distribution = Distribution { unD :: Array Stripe }
4988

@@ -90,7 +129,7 @@ newDistrib = IO $ \s ->
90129
-- probably unecessary
91130
case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
92131
case countPos of { (I## countPos') ->
93-
case writeInt64Array## mba countPos' (intToInt64## 0##) s2 of { s3 ->
132+
case writeInt64Array mba countPos' (intToInt64 0##) s2 of { s3 ->
94133
case meanPos of { (I## meanPos') ->
95134
case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
96135
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -148,17 +187,6 @@ spinUnlock mba = \s ->
148187
case writeIntArray## mba lockPos' 0## s of { s2 ->
149188
s2 }}
150189

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

163191
-- | Add the same value to the distribution N times.
164192
-- Mean and variance are computed according to
@@ -169,7 +197,7 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
169197
case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
170198
case spinLock mba s1 of { s2 ->
171199
case countPos of { (I## countPos') ->
172-
case readInt64Array## mba countPos' s2 of { (## s3, count ##) ->
200+
case readInt64Array mba countPos' s2 of { (## s3, count ##) ->
173201
case meanPos of { (I## meanPos') ->
174202
case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
175203
case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -180,11 +208,11 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
180208
case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
181209
case maxPos of { (I## maxPos') ->
182210
case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
183-
case plusInt64## count n of { count' ->
211+
case plusInt64 count n of { count' ->
184212
case val -#### mean of { delta ->
185213
case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
186214
case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
187-
case writeInt64Array## mba countPos' count' s8 of { s9 ->
215+
case writeInt64Array mba countPos' count' s8 of { s9 ->
188216
case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
189217
case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
190218
case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
@@ -204,9 +232,9 @@ combine :: Distrib -> Distrib -> IO ()
204232
combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
205233
case spinLock bMBA s of { s1 ->
206234
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' ->
235+
case readInt64Array aMBA countPos' s1 of { (## s2, aCount ##) ->
236+
case readInt64Array bMBA countPos' s2 of { (## s3, bCount ##) ->
237+
case plusInt64 aCount bCount of { count' ->
210238
case meanPos of { (I## meanPos' ) ->
211239
case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
212240
case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
@@ -226,8 +254,8 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
226254
)
227255
)
228256
) 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 ->
257+
case writeInt64Array aMBA countPos' count' s7 of { s8 ->
258+
case (case eqInt64## count' (intToInt64 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
231259
case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
232260
case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
233261
case sumPos of { (I## sumPos') ->
@@ -258,7 +286,7 @@ read distrib = do
258286
case sumPos of { (I## sumPos') ->
259287
case minPos of { (I## minPos') ->
260288
case maxPos of { (I## maxPos') ->
261-
case readInt64Array## mba countPos' s of { (## s1, count ##) ->
289+
case readInt64Array mba countPos' s of { (## s1, count ##) ->
262290
case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
263291
case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
264292
case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->

0 commit comments

Comments
 (0)