From 0433c5bb38c52f529882f506629d9d98fcf9b602 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Fri, 6 Mar 2020 13:31:27 -0800
Subject: [PATCH 01/19] Bump base constraint.

---
 ekg-core.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ekg-core.cabal b/ekg-core.cabal
index d8e7ba8..f9a3a38 100644
--- a/ekg-core.cabal
+++ b/ekg-core.cabal
@@ -34,7 +34,7 @@ library
 
   build-depends:
     ghc-prim < 0.6,
-    base >= 4.6 && < 4.13,
+    base >= 4.6 && < 4.14,
     containers >= 0.5 && < 0.7,
     text < 1.3,
     unordered-containers < 0.3

From 420f5591b45df3caf228e2f010500fb31a54a5d4 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 19 Jul 2020 00:30:35 -0700
Subject: [PATCH 02/19] Prototype atomic-memory-safe implementation.

---
 Data/Atomic.hs                          |  72 ++++---
 System/Metrics.hs                       |  41 ++--
 System/Metrics/Counter.hs               |   5 +-
 System/Metrics/Distribution.hsc         | 271 ++++++++++++++++--------
 System/Metrics/Distribution/Internal.hs |   4 +-
 System/Metrics/Gauge.hs                 |   9 +-
 cbits/distrib.h                         |  33 +--
 ekg-core.cabal                          |   6 +-
 8 files changed, 268 insertions(+), 173 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index 98a5501..008a9fd 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}
+{-# LANGUAGE BangPatterns
+           , CPP
+           , ForeignFunctionInterface
+           , MagicHash
+           , UnboxedTuples
+           #-}
 -- | An atomic integer value. All operations are thread safe.
 module Data.Atomic
     (
@@ -12,33 +17,41 @@ module Data.Atomic
     , subtract
     ) where
 
-import Data.Int (Int64)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
-import Foreign.Ptr (Ptr)
-import Foreign.Storable (poke)
 import Prelude hiding (read, subtract)
 
+import GHC.Int
+import GHC.IO
+import GHC.Prim
+
+#include "MachDeps.h"
+
+#if WORD_SIZE_IN_BYTES > 32
+#define ARRLEN 8
+#else
+#define ARRLEN 4
+#endif
+
 -- | A mutable, atomic integer.
-newtype Atomic = C (ForeignPtr Int64)
+--newtype Atomic = C (ForeignPtr Int64)
+data Atomic = C (MutableByteArray# RealWorld)
 
 -- | Create a new, zero initialized, atomic.
-new :: Int64 -> IO Atomic
-new n = do
-    fp <- mallocForeignPtr
-    withForeignPtr fp $ \ p -> poke p n
-    return $ C fp
+new :: Int -> IO Atomic
+new (I# n) = IO $ \s ->
+    case newByteArray# ARRLEN# s of { (# s1, mba #) ->
+    case atomicWriteIntArray# mba 0# n s1 of { s2 ->
+    (# s2, C mba #) }}
 
-read :: Atomic -> IO Int64
-read (C fp) = withForeignPtr fp cRead
-
-foreign import ccall unsafe "hs_atomic_read" cRead :: Ptr Int64 -> IO Int64
+read :: Atomic -> IO Int
+read (C mba) = IO $ \s ->
+    case atomicReadIntArray# mba 0# s of { (# s1, n #) ->
+    (# s1, I# n #)}
 
 -- | Set the atomic to the given value.
-write :: Atomic -> Int64 -> IO ()
-write (C fp) n = withForeignPtr fp $ \ p -> cWrite p n
-
-foreign import ccall unsafe "hs_atomic_write" cWrite
-    :: Ptr Int64 -> Int64 -> IO ()
+write :: Atomic -> Int -> IO ()
+write (C mba) (I# n) = IO $ \s ->
+    case atomicWriteIntArray# mba 0# n s of { s1 ->
+    (# s1, () #) }
 
 -- | Increase the atomic by one.
 inc :: Atomic -> IO ()
@@ -49,16 +62,13 @@ dec :: Atomic -> IO ()
 dec atomic = subtract atomic 1
 
 -- | Increase the atomic by the given amount.
-add :: Atomic -> Int64 -> IO ()
-add (C fp) n = withForeignPtr fp $ \ p -> cAdd p n
+add :: Atomic -> Int -> IO ()
+add (C mba) (I# n) = IO $ \s ->
+    case fetchAddIntArray# mba 0# n s of { (# s1, _ #) ->
+    (# s1, () #) }
 
 -- | Decrease the atomic by the given amount.
-subtract :: Atomic -> Int64 -> IO ()
-subtract (C fp) n = withForeignPtr fp $ \ p -> cSubtract p n
-
--- | Increase the atomic by the given amount.
-foreign import ccall unsafe "hs_atomic_add" cAdd :: Ptr Int64 -> Int64 -> IO ()
-
--- | Increase the atomic by the given amount.
-foreign import ccall unsafe "hs_atomic_subtract" cSubtract
-    :: Ptr Int64 -> Int64 -> IO ()
+subtract :: Atomic -> Int -> IO ()
+subtract (C mba) (I# n) = IO $ \s ->
+    case fetchSubIntArray# mba 0# n s of { (# s1, _ #) ->
+    (# s1, () #) }
diff --git a/System/Metrics.hs b/System/Metrics.hs
index bca8339..d64df28 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -70,7 +70,6 @@ module System.Metrics
 
 import Control.Applicative ((<$>))
 import Control.Monad (forM)
-import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef)
 import qualified Data.HashMap.Strict as M
@@ -133,8 +132,8 @@ data GroupSampler = forall a. GroupSampler
      }
 
 -- TODO: Rename this to Metric and Metric to SampledMetric.
-data MetricSampler = CounterS !(IO Int64)
-                   | GaugeS !(IO Int64)
+data MetricSampler = CounterS !(IO Int)
+                   | GaugeS !(IO Int)
                    | LabelS !(IO T.Text)
                    | DistributionS !(IO Distribution.Stats)
 
@@ -156,18 +155,18 @@ newStore = do
 -- | Register a non-negative, monotonically increasing, integer-valued
 -- metric. The provided action to read the value must be thread-safe.
 -- Also see 'createCounter'.
-registerCounter :: T.Text    -- ^ Counter name
-                -> IO Int64  -- ^ Action to read the current metric value
-                -> Store     -- ^ Metric store
+registerCounter :: T.Text  -- ^ Counter name
+                -> IO Int  -- ^ Action to read the current metric value
+                -> Store   -- ^ Metric store
                 -> IO ()
 registerCounter name sample store =
     register name (CounterS sample) store
 
 -- | Register an integer-valued metric. The provided action to read
 -- the value must be thread-safe. Also see 'createGauge'.
-registerGauge :: T.Text    -- ^ Gauge name
-              -> IO Int64  -- ^ Action to read the current metric value
-              -> Store     -- ^ Metric store
+registerGauge :: T.Text  -- ^ Gauge name
+              -> IO Int  -- ^ Action to read the current metric value
+              -> Store   -- ^ Metric store
               -> IO ()
 registerGauge name sample store =
     register name (GaugeS sample) store
@@ -333,11 +332,11 @@ createDistribution name store = do
 
 #if MIN_VERSION_base(4,10,0)
 -- | Convert nanoseconds to milliseconds.
-nsToMs :: Int64 -> Int64
+nsToMs :: Int -> Int
 nsToMs s = round (realToFrac s / (1000000.0 :: Double))
 #else
 -- | Convert seconds to milliseconds.
-sToMs :: Double -> Int64
+sToMs :: Double -> Int
 sToMs s = round (s * 1000.0)
 #endif
 
@@ -430,15 +429,15 @@ registerGcMetrics store =
      , ("rts.gc.cumulative_bytes_used"    , Counter . fromIntegral . Stats.cumulative_live_bytes)
      , ("rts.gc.bytes_copied"             , Counter . fromIntegral . Stats.copied_bytes)
 #if MIN_VERSION_base(4,12,0)
-     , ("rts.gc.init_cpu_ms"              , Counter . nsToMs . Stats.init_cpu_ns)
-     , ("rts.gc.init_wall_ms"             , Counter . nsToMs . Stats.init_elapsed_ns)
+     , ("rts.gc.init_cpu_ms"              , Counter . nsToMs . fromIntegral . Stats.init_cpu_ns)
+     , ("rts.gc.init_wall_ms"             , Counter . nsToMs . fromIntegral . Stats.init_elapsed_ns)
 #endif
-     , ("rts.gc.mutator_cpu_ms"           , Counter . nsToMs . Stats.mutator_cpu_ns)
-     , ("rts.gc.mutator_wall_ms"          , Counter . nsToMs . Stats.mutator_elapsed_ns)
-     , ("rts.gc.gc_cpu_ms"                , Counter . nsToMs . Stats.gc_cpu_ns)
-     , ("rts.gc.gc_wall_ms"               , Counter . nsToMs . Stats.gc_elapsed_ns)
-     , ("rts.gc.cpu_ms"                   , Counter . nsToMs . Stats.cpu_ns)
-     , ("rts.gc.wall_ms"                  , Counter . nsToMs . Stats.elapsed_ns)
+     , ("rts.gc.mutator_cpu_ms"           , Counter . nsToMs . fromIntegral . Stats.mutator_cpu_ns)
+     , ("rts.gc.mutator_wall_ms"          , Counter . nsToMs . fromIntegral . Stats.mutator_elapsed_ns)
+     , ("rts.gc.gc_cpu_ms"                , Counter . nsToMs . fromIntegral . Stats.gc_cpu_ns)
+     , ("rts.gc.gc_wall_ms"               , Counter . nsToMs . fromIntegral . Stats.gc_elapsed_ns)
+     , ("rts.gc.cpu_ms"                   , Counter . nsToMs . fromIntegral . Stats.cpu_ns)
+     , ("rts.gc.wall_ms"                  , Counter . nsToMs . fromIntegral . Stats.elapsed_ns)
      , ("rts.gc.max_bytes_used"           , Gauge . fromIntegral . Stats.max_live_bytes)
      , ("rts.gc.current_bytes_used"       , Gauge . fromIntegral . Stats.gcdetails_live_bytes . Stats.gc)
      , ("rts.gc.current_bytes_slop"       , Gauge . fromIntegral . Stats.gcdetails_slop_bytes . Stats.gc)
@@ -615,8 +614,8 @@ sampleGroups cbSamplers = concat `fmap` sequence (map runOne cbSamplers)
         return $! map (\ (n, f) -> (n, f a)) (M.toList groupSamplerMetrics)
 
 -- | The value of a sampled metric.
-data Value = Counter {-# UNPACK #-} !Int64
-           | Gauge {-# UNPACK #-} !Int64
+data Value = Counter {-# UNPACK #-} !Int
+           | Gauge {-# UNPACK #-} !Int
            | Label {-# UNPACK #-} !T.Text
            | Distribution !Distribution.Stats
            deriving (Eq, Show)
diff --git a/System/Metrics/Counter.hs b/System/Metrics/Counter.hs
index 847dc3f..55adc8f 100644
--- a/System/Metrics/Counter.hs
+++ b/System/Metrics/Counter.hs
@@ -12,7 +12,6 @@ module System.Metrics.Counter
     ) where
 
 import qualified Data.Atomic as Atomic
-import Data.Int (Int64)
 import Prelude hiding (read)
 
 -- | A mutable, integer-valued counter.
@@ -23,7 +22,7 @@ new :: IO Counter
 new = C `fmap` Atomic.new 0
 
 -- | Get the current value of the counter.
-read :: Counter -> IO Int64
+read :: Counter -> IO Int
 read = Atomic.read . unC
 
 -- | Increase the counter by one.
@@ -31,5 +30,5 @@ inc :: Counter -> IO ()
 inc counter = add counter 1
 
 -- | Add the argument to the counter.
-add :: Counter -> Int64 -> IO ()
+add :: Counter -> Int -> IO ()
 add counter = Atomic.add (unC counter)
diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 8e53e29..8bf557b 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -1,6 +1,8 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UnboxedTuples #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 
 #include "distrib.h"
@@ -28,14 +30,15 @@ module System.Metrics.Distribution
     ) where
 
 import Control.Monad (forM_, replicateM)
-import Data.Int (Int64)
-import Foreign.C.Types (CInt)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
-import Foreign.Ptr (Ptr)
-import Foreign.Storable (Storable(alignment, peek, poke, sizeOf), peekByteOff,
-                         pokeByteOff)
 import Prelude hiding (max, min, read, sum)
 
+import Foreign.Storable (sizeOf)
+
+import GHC.Float
+import GHC.Int
+import GHC.IO
+import GHC.Prim
+
 import Data.Array
 import System.Metrics.Distribution.Internal (Stats(..))
 import System.Metrics.ThreadId
@@ -43,70 +46,67 @@ import System.Metrics.ThreadId
 -- | An metric for tracking events.
 newtype Distribution = Distribution { unD :: Array Stripe }
 
-data Stripe = Stripe
-    { stripeFp    :: !(ForeignPtr CDistrib)
-    }
-
-data CDistrib = CDistrib
-    { cCount      :: !Int64
-    , cMean       :: !Double
-    , cSumSqDelta :: !Double
-    , cSum        :: !Double
-    , cMin        :: !Double
-    , cMax        :: !Double
-    , cLock       :: !Int64  -- ^ 0 - unlocked, 1 - locked
-    }
-
-instance Storable CDistrib where
-    sizeOf _ = (#size struct distrib)
-    alignment _ = alignment (undefined :: CInt)
-
-    peek p = do
-        cCount <- (#peek struct distrib, count) p
-        cMean <- (#peek struct distrib, mean) p
-        cSumSqDelta <- (#peek struct distrib, sum_sq_delta) p
-        cSum <- (#peek struct distrib, sum) p
-        cMin <- (#peek struct distrib, min) p
-        cMax <- (#peek struct distrib, max) p
-        cLock <- (#peek struct distrib, lock) p
-        return $! CDistrib
-            { cCount      = cCount
-            , cMean       = cMean
-            , cSumSqDelta = cSumSqDelta
-            , cSum        = cSum
-            , cMin        = cMin
-            , cMax        = cMax
-            , cLock       = cLock
-            }
-
-    poke p CDistrib{..} = do
-        (#poke struct distrib, count) p cCount
-        (#poke struct distrib, mean) p cMean
-        (#poke struct distrib, sum_sq_delta) p cSumSqDelta
-        (#poke struct distrib, sum) p cSum
-        (#poke struct distrib, min) p cMin
-        (#poke struct distrib, max) p cMax
-        (#poke struct distrib, lock) p cLock
-
-newCDistrib :: IO (ForeignPtr CDistrib)
-newCDistrib = do
-    fp <- mallocForeignPtr
-    withForeignPtr fp $ \ p -> poke p $ CDistrib
-        { cCount      = 0
-        , cMean       = 0.0
-        , cSumSqDelta = 0.0
-        , cSum        = 0.0
-        , cMin        = 0.0
-        , cMax        = 0.0
-        , cLock       = 0
-        }
-    return fp
+newtype Stripe = Stripe { stripeD :: Distrib }
+
+data Distrib = Distrib (MutableByteArray## RealWorld)
+
+distribLen :: Int
+distribLen = (#size struct distrib)
+
+lockPos :: Int
+lockPos = div (#offset struct distrib, lock)
+              (sizeOf (undefined :: Int))
+
+countPos :: Int
+countPos = div (#offset struct distrib, count)
+               (sizeOf (undefined :: Int))
+
+meanPos :: Int
+meanPos = div (#offset struct distrib, mean)
+              (sizeOf (undefined :: Double))
+
+sumSqDeltaPos :: Int
+sumSqDeltaPos = div (#offset struct distrib, sum_sq_delta)
+                    (sizeOf (undefined :: Double))
+
+sumPos :: Int
+sumPos = div (#offset struct distrib, sum)
+             (sizeOf (undefined :: Double))
+
+minPos :: Int
+minPos = div (#offset struct distrib, min)
+             (sizeOf (undefined :: Double))
+
+maxPos :: Int
+maxPos = div (#offset struct distrib, max)
+             (sizeOf (undefined :: Double))
+
+newDistrib :: IO Distrib
+newDistrib = IO $ \s ->
+    case distribLen of { (I## distribLen') ->
+    case newByteArray## distribLen' s of { (## s1, mba ##) ->
+    case lockPos of { (I## lockPos') ->
+    -- probably unecessary
+    case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
+    case countPos of { (I## countPos') ->
+    case writeIntArray## mba countPos' 0## s2 of { s3 ->
+    case meanPos of { (I## meanPos') ->
+    case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
+    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
+    case writeDoubleArray## mba sumSqDeltaPos' 0.0#### s4 of { s5 ->
+    case sumPos of { (I## sumPos') ->
+    case writeDoubleArray## mba sumPos' 0.0#### s5 of { s6 ->
+    case minPos of { (I## minPos') ->
+    case writeDoubleArray## mba minPos' 0.0#### s6 of { s7 ->
+    case maxPos of { (I## maxPos') ->
+    case writeDoubleArray## mba maxPos' 0.0#### s7 of { s8 ->
+    (## s8, Distrib mba ##) }}}}}}}}}}}}}}}}
 
 newStripe :: IO Stripe
 newStripe = do
-    fp <- newCDistrib
+    d <- newDistrib
     return $! Stripe
-        { stripeFp    = fp
+        { stripeD = d
         }
 
 -- | Number of lock stripes. Should be greater or equal to the number
@@ -132,34 +132,123 @@ new = (Distribution . fromList numStripes) `fmap`
 add :: Distribution -> Double -> IO ()
 add distrib val = addN distrib val 1
 
-foreign import ccall unsafe "hs_distrib_add_n" cDistribAddN
-    :: Ptr CDistrib -> Double -> Int64 -> IO ()
+{-# INLINE spinLock #-}
+spinLock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld
+spinLock mba = \s ->
+    case lockPos of { (I## lockPos') ->
+    case casIntArray## mba lockPos' 0## 1## s of { (## s1, r ##) ->
+    case r ==## 0## of { 0## ->
+    spinLock mba s1; _ -> s1 }}}
+
+{-# INLINE spinUnlock #-}
+spinUnlock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld
+spinUnlock mba = \s ->
+    case lockPos of { (I## lockPos') ->
+    case writeIntArray## mba lockPos' 0## s of { s2 ->
+    s2 }}
 
 -- | Add the same value to the distribution N times.
-addN :: Distribution -> Double -> Int64 -> IO ()
-addN distrib val n = do
-    stripe <- myStripe distrib
-    withForeignPtr (stripeFp stripe) $ \ p ->
-        cDistribAddN p val n
-
-foreign import ccall unsafe "hs_distrib_combine" combine
-    :: Ptr CDistrib -> Ptr CDistrib -> IO ()
+addN :: Distribution -> Double -> Int -> IO ()
+addN distribution (D## val) (I## n) = IO $ \s ->
+    case myStripe distribution of { (IO myStripe') ->
+    case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
+    case spinLock mba s1 of { s2 ->
+    case countPos of { (I## countPos') ->
+    case readIntArray## mba countPos' s2 of { (## s3, count ##) ->
+    case meanPos of { (I## meanPos') ->
+    case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
+    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
+    case readDoubleArray## mba sumSqDeltaPos' s4 of { (## s5, sumSqDelta ##) ->
+    case sumPos of { (I## sumPos') ->
+    case readDoubleArray## mba sumPos' s5 of { (## s6, dSum ##) ->
+    case minPos of { (I## minPos') ->
+    case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
+    case maxPos of { (I## maxPos') ->
+    case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
+    case count +## n of { count' ->
+    case val -#### mean of { delta ->
+    case mean +#### ((int2Double## n) *#### delta /#### (int2Double## count')) of { mean' ->
+    case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int2Double## n)) of { sumSqDelta' ->
+    case writeIntArray## mba countPos' count' s8 of { s9 ->
+    case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
+    case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
+    case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
+    case (case val <#### dMin of { 0## -> dMin; _ -> val }) of { dMin' ->
+    case (case val >#### dMax of { 0## -> dMax; _ -> val }) of { dMax' ->
+    case writeDoubleArray## mba minPos' dMin' s12 of { s13 ->
+    case writeDoubleArray## mba maxPos' dMax' s13 of { s14 ->
+    case spinUnlock mba s14 of { s15 ->
+    (## s15, () ##) }}}}}}}}}}}}}}}}}}}}}}}}}}}}
+
+combine :: Distrib -> Distrib -> IO ()
+combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
+    case spinLock bMBA s of { s1 ->
+    case countPos of { (I## countPos') ->
+    case readIntArray## aMBA countPos' s1 of { (## s2, aCount ##) ->
+    case readIntArray## bMBA countPos' s2 of { (## s3, bCount ##) ->
+    case aCount +## bCount of { count' ->
+    case meanPos of { (I## meanPos' ) ->
+    case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
+    case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
+    case bMean -#### aMean of { delta ->
+    case (   (((int2Double## aCount) *#### aMean) +#### ((int2Double## bCount) *#### bMean))
+         /#### (int2Double## count')
+         ) of { mean' ->
+    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
+    case readDoubleArray## aMBA sumSqDeltaPos' s5 of { (## s6, aSumSqDelta ##) ->
+    case readDoubleArray## bMBA sumSqDeltaPos' s6 of { (## s7, bSumSqDelta ##) ->
+    case (   aSumSqDelta 
+         +#### bSumSqDelta
+         +#### (   delta
+               *#### delta
+               *#### (   (int2Double## aCount) *#### (int2Double## bCount)
+                     /#### (int2Double## count')
+                     )
+               )
+         ) of { sumSqDelta' ->
+    case writeIntArray## aMBA countPos' count' s7 of { s8 ->
+    case (case count' ==## 0## of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
+    case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
+    case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
+    case sumPos of { (I## sumPos') ->
+    case readDoubleArray## aMBA sumPos' s10 of { (## s11, aSum ##) ->
+    case readDoubleArray## bMBA sumPos' s11 of { (## s12, bSum ##) ->
+    case writeDoubleArray## aMBA sumPos' (aSum +#### bSum) s12 of { s13 ->
+    case minPos of { (I## minPos') ->
+    case readDoubleArray## bMBA minPos' s13 of { (## s14, bMin ##) ->
+    case writeDoubleArray## aMBA minPos' bMin s14 of { s15 ->
+    case maxPos of { (I## maxPos') ->
+    case readDoubleArray## bMBA maxPos' s15 of { (## s16, bMax ##) ->
+    case writeDoubleArray## aMBA maxPos' bMax s16 of { s17 ->
+    case spinUnlock bMBA s17 of { s18 ->
+    (## s18, () ##) }}}}}}}}}}}}}}}}}}}}}}}}}}}}}
 
 -- | Get the current statistical summary for the event being tracked.
 read :: Distribution -> IO Stats
 read distrib = do
-    result <- newCDistrib
-    CDistrib{..} <- withForeignPtr result $ \ resultp -> do
-        forM_ (toList $ unD distrib) $ \ stripe ->
-            withForeignPtr (stripeFp stripe) $ \ p ->
-            combine p resultp
-        peek resultp
-    return $! Stats
-        { mean  = cMean
-        , variance = if cCount == 0 then 0.0
-                     else cSumSqDelta / fromIntegral cCount
-        , count = cCount
-        , sum   = cSum
-        , min   = cMin
-        , max   = cMax
-        }
+    result@(Distrib mba) <- newDistrib
+    forM_ (toList $ unD distrib) $ \(Stripe d) ->
+        combine d result
+    IO $ \s ->
+        case meanPos of { (I## meanPos') ->
+        case countPos of { (I## countPos') ->
+        case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
+        case sumPos of { (I## sumPos') ->
+        case minPos of { (I## minPos') ->
+        case maxPos of { (I## maxPos') ->
+        case readIntArray## mba countPos' s of { (## s1, count ##) ->
+        case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
+        case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
+        case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->
+        case readDoubleArray## mba minPos' s4 of { (## s5, dMin ##) ->
+        case readDoubleArray## mba maxPos' s5 of { (## s6, dMax ##) ->
+        (## s6
+        , Stats { mean = (D## mean)
+                , variance = if (I## count) == 0 then 0.0
+                             else (D## sumSqDelta) / (D## (int2Double## count))
+                , count = (I## count)
+                , sum = (D## dSum)
+                , min = (D## dMin)
+                , max = (D## dMax)
+                }
+        ##) }}}}}}}}}}}}
diff --git a/System/Metrics/Distribution/Internal.hs b/System/Metrics/Distribution/Internal.hs
index 3c59349..af01e99 100644
--- a/System/Metrics/Distribution/Internal.hs
+++ b/System/Metrics/Distribution/Internal.hs
@@ -6,13 +6,11 @@ module System.Metrics.Distribution.Internal
     ( Stats(..)
     ) where
 
-import Data.Int (Int64)
-
 -- | Distribution statistics
 data Stats = Stats
     { mean     :: !Double  -- ^ Sample mean
     , variance :: !Double  -- ^ Biased sample variance
-    , count    :: !Int64   -- ^ Event count
+    , count    :: !Int   -- ^ Event count
     , sum      :: !Double  -- ^ Sum of values
     , min      :: !Double  -- ^ Min value seen
     , max      :: !Double  -- ^ Max value seen
diff --git a/System/Metrics/Gauge.hs b/System/Metrics/Gauge.hs
index 0702ea9..b91fe4c 100644
--- a/System/Metrics/Gauge.hs
+++ b/System/Metrics/Gauge.hs
@@ -15,7 +15,6 @@ module System.Metrics.Gauge
     ) where
 
 import qualified Data.Atomic as Atomic
-import Data.Int (Int64)
 import Prelude hiding (subtract, read)
 
 -- | A mutable, integer-valued gauge.
@@ -26,7 +25,7 @@ new :: IO Gauge
 new = C `fmap` Atomic.new 0
 
 -- | Get the current value of the gauge.
-read :: Gauge -> IO Int64
+read :: Gauge -> IO Int
 read = Atomic.read . unC
 
 -- | Increase the gauge by one.
@@ -38,13 +37,13 @@ dec :: Gauge -> IO ()
 dec gauge = subtract gauge 1
 
 -- | Increase the gauge by the given amount.
-add :: Gauge -> Int64 -> IO ()
+add :: Gauge -> Int -> IO ()
 add gauge = Atomic.add (unC gauge)
 
 -- | Decrease the gauge by the given amount.
-subtract :: Gauge -> Int64 -> IO ()
+subtract :: Gauge -> Int -> IO ()
 subtract gauge = Atomic.subtract (unC gauge)
 
 -- | Set the gauge to the given value.
-set :: Gauge -> Int64 -> IO ()
+set :: Gauge -> Int -> IO ()
 set gauge = Atomic.write (unC gauge)
diff --git a/cbits/distrib.h b/cbits/distrib.h
index 6111b35..bd0f402 100644
--- a/cbits/distrib.h
+++ b/cbits/distrib.h
@@ -1,20 +1,21 @@
+#include "MachDeps.h"
+
 #include "HsFFI.h"
 
-struct distrib {
-  StgInt64 count;
-  StgDouble mean;
-  StgDouble sum_sq_delta;
-  StgDouble sum;
-  StgDouble min;
-  StgDouble max;
-  volatile StgInt64 lock;
-};
+#include <stdint.h>
 
-void hs_distrib_add_n(struct distrib* distrib, StgDouble val, StgInt64 n);
+#if WORD_SIZE_IN_BYTES > 32
+#define HSINTTYPE int32_t
+#else
+#define HSINTTYPE int64_t
+#endif
 
-/*
- * Combine 'b' with 'a', writing the result in 'a'. Takes the lock of
- * 'b' while combining, but doesn't otherwise modify 'b'. 'a' is
- * assumed to not be used concurrently.
- */
-void hs_distrib_combine(struct distrib* b, struct distrib* a);
+struct distrib {
+  HSINTTYPE lock;
+  HSINTTYPE count;
+  double mean;
+  double sum_sq_delta;
+  double sum;
+  double min;
+  double max;
+};
diff --git a/ekg-core.cabal b/ekg-core.cabal
index db69c3d..8093877 100644
--- a/ekg-core.cabal
+++ b/ekg-core.cabal
@@ -41,7 +41,7 @@ library
 
   default-language:    Haskell2010
 
-  ghc-options: -Wall
+  ghc-options: -Wall -O2
   if arch(i386)
     cc-options: -march=i686
   includes: distrib.h
@@ -57,7 +57,7 @@ benchmark counter
     ekg-core
   default-language: Haskell2010
   hs-source-dirs: benchmarks
-  ghc-options: -O2 -threaded -Wall
+  ghc-options: -O2 -threaded -Wall -rtsopts
 
 benchmark distribution
   main-is: Distribution.hs
@@ -67,7 +67,7 @@ benchmark distribution
     ekg-core
   default-language: Haskell2010
   hs-source-dirs: benchmarks
-  ghc-options: -O2 -threaded -Wall
+  ghc-options: -O2 -threaded -Wall -rtsopts
 
 source-repository head
   type:     git

From 2ac505c0e24adb6bb6ac90c8a48b409b20d950d0 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 24 Dec 2023 13:44:54 -0500
Subject: [PATCH 03/19] Dependency version bumps.

---
 ekg-core.cabal | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/ekg-core.cabal b/ekg-core.cabal
index 830874e..f0dac37 100644
--- a/ekg-core.cabal
+++ b/ekg-core.cabal
@@ -33,10 +33,10 @@ library
     System.Metrics.ThreadId
 
   build-depends:
-    ghc-prim < 0.8,
-    base >= 4.6 && < 4.16,
-    containers >= 0.5 && < 0.7,
-    text < 1.3,
+    ghc-prim < 0.12,
+    base >= 4.6 && < 4.20,
+    containers >= 0.5 && < 0.8,
+    text < 2.2,
     unordered-containers < 0.3
 
   default-language:    Haskell2010
@@ -57,7 +57,7 @@ benchmark counter
     ekg-core
   default-language: Haskell2010
   hs-source-dirs: benchmarks
-  ghc-options: -O2 -threaded -Wall
+  ghc-options: -O2 -threaded -rtsopts -Wall
 
 benchmark distribution
   main-is: Distribution.hs
@@ -67,7 +67,7 @@ benchmark distribution
     ekg-core
   default-language: Haskell2010
   hs-source-dirs: benchmarks
-  ghc-options: -O2 -threaded -Wall
+  ghc-options: -O2 -threaded -rtsopts -Wall
 
 source-repository head
   type:     git

From 74f223939f8b2634fe60d5db6f5d62b0e703e19c Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 24 Dec 2023 14:02:27 -0500
Subject: [PATCH 04/19] Update .gitignore

---
 .gitignore | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/.gitignore b/.gitignore
index 12b9885..7d5e2ee 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,3 +11,5 @@ cabal.config
 cabal.sandbox.config
 examples/Group
 *.sublime-*
+cabal.project.local*
+dist-newstyle

From 12ab6a7eb15739cda662a0c9c0397815c8b5e15c Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 24 Dec 2023 14:57:22 -0500
Subject: [PATCH 05/19] Fix CPP

---
 Data/Atomic.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index 008a9fd..8d2a65e 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -25,10 +25,14 @@ import GHC.Prim
 
 #include "MachDeps.h"
 
-#if WORD_SIZE_IN_BYTES > 32
+#ifndef WORD_SIZE_IN_BITS
+#error "WORD_SIZE_IN_BITS not defined"
+#elif WORD_SIZE_IN_BITS == 32
+#define ARRLEN 4
+#elif WORD_SIZE_IN_BITS == 64
 #define ARRLEN 8
 #else
-#define ARRLEN 4
+#error "WORD_SIZE_IN_BITS not 32 or 64"
 #endif
 
 -- | A mutable, atomic integer.

From 53d09862cf882867cf5e3edcfe21d4824c03f5cf Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 12:48:35 +0200
Subject: [PATCH 06/19] Clean up a bit.

---
 .gitignore            |  1 +
 System/Metrics.hs     | 17 ++++++-----------
 benchmarks/Counter.hs | 11 +++++++----
 cbits/atomic.c        | 17 -----------------
 cbits/distrib.c       | 44 -------------------------------------------
 cbits/distrib.h       |  1 +
 ekg-core.cabal        |  3 ---
 7 files changed, 15 insertions(+), 79 deletions(-)
 delete mode 100644 cbits/atomic.c
 delete mode 100644 cbits/distrib.c

diff --git a/.gitignore b/.gitignore
index a014a4b..cc7651d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,4 @@ cabal.sandbox.config
 examples/Group
 *.sublime-*
 dist-newstyle/
+cabal.project.local
diff --git a/System/Metrics.hs b/System/Metrics.hs
index 67643ce..286fa1e 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -68,7 +68,6 @@ module System.Metrics
     , Value(..)
     ) where
 
-import Control.Applicative ((<$>))
 import Control.Monad (forM)
 import qualified Data.IntMap.Strict as IM
 import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef)
@@ -470,20 +469,16 @@ registerGcMetrics =
 #if MIN_VERSION_base(4,11,0)
      , ("rts.gc.par_balanced_bytes_copied", Gauge . fromIntegral . Stats.cumulative_par_balanced_copied_bytes)
 #if MIN_VERSION_base(4,15,0)
-     , ("rts.gc.nm.sync_cpu_ms"           , Counter . nsToMs . Stats.nonmoving_gc_sync_cpu_ns)
-     , ("rts.gc.nm.sync_elapsed_ms"       , Counter . nsToMs . Stats.nonmoving_gc_sync_elapsed_ns)
-     , ("rts.gc.nm.sync_max_elapsed_ms"   , Counter . nsToMs . Stats.nonmoving_gc_sync_max_elapsed_ns)
-     , ("rts.gc.nm.cpu_ms"                , Counter . nsToMs . Stats.nonmoving_gc_cpu_ns)
-     , ("rts.gc.nm.elapsed_ms"            , Counter . nsToMs . Stats.nonmoving_gc_elapsed_ns)
-     , ("rts.gc.nm.max_elapsed_ms"        , Counter . nsToMs . Stats.nonmoving_gc_max_elapsed_ns)
+     , ("rts.gc.nm.sync_cpu_ms"           , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_cpu_ns)
+     , ("rts.gc.nm.sync_elapsed_ms"       , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_elapsed_ns)
+     , ("rts.gc.nm.sync_max_elapsed_ms"   , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_max_elapsed_ns)
+     , ("rts.gc.nm.cpu_ms"                , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_cpu_ns)
+     , ("rts.gc.nm.elapsed_ms"            , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_elapsed_ns)
+     , ("rts.gc.nm.max_elapsed_ms"        , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_max_elapsed_ns)
 # endif
 # endif
      ])
     getRTSStats
-    where
-    -- | Convert nanoseconds to milliseconds.
-    nsToMs :: Int64 -> Int64
-    nsToMs s = round (realToFrac s / (1000000.0 :: Double))
 #else
     (M.fromList
      [ ("rts.gc.bytes_allocated"          , Counter . Stats.bytesAllocated)
diff --git a/benchmarks/Counter.hs b/benchmarks/Counter.hs
index eea2785..53a68bb 100644
--- a/benchmarks/Counter.hs
+++ b/benchmarks/Counter.hs
@@ -5,18 +5,21 @@ module Main where
 
 import Control.Concurrent
 import Control.Monad
-import System.Metrics.Counter
+import qualified System.Metrics.Counter as C
 
 main :: IO ()
 main = do
-    counter <- new
+    counter <- C.new
     locks <- replicateM n newEmptyMVar
     mapM_ (forkIO . work counter iters) locks
     mapM_ takeMVar locks
+    fin <- C.read counter
+    when (fin /= (n * iters)) $
+        fail "Data.Atomic is broken!"
   where
     n = 100
     iters = 100000
 
-    work :: Counter -> Int -> MVar () -> IO ()
+    work :: C.Counter -> Int -> MVar () -> IO ()
     work !_ 0 !lock     = putMVar lock ()
-    work counter i lock = inc counter >> work counter (i - 1) lock
+    work counter i lock = C.inc counter >> work counter (i - 1) lock
diff --git a/cbits/atomic.c b/cbits/atomic.c
deleted file mode 100644
index e9f01da..0000000
--- a/cbits/atomic.c
+++ /dev/null
@@ -1,17 +0,0 @@
-#include "HsFFI.h"
-
-void hs_atomic_add(volatile StgInt64* atomic, StgInt64 n) {
-  __sync_fetch_and_add(atomic, n);
-}
-
-void hs_atomic_subtract(volatile StgInt64* atomic, StgInt64 n) {
-  __sync_fetch_and_sub(atomic, n);
-}
-
-StgInt64 hs_atomic_read(volatile const StgInt64* atomic) {
-  return *atomic;
-}
-
-void hs_atomic_write(volatile StgInt64* atomic, StgInt64 n) {
-  *atomic = n;
-}
diff --git a/cbits/distrib.c b/cbits/distrib.c
deleted file mode 100644
index ae2a824..0000000
--- a/cbits/distrib.c
+++ /dev/null
@@ -1,44 +0,0 @@
-#include "HsFFI.h"
-#include "distrib.h"
-
-static void hs_lock(volatile StgInt64* lock) {
-  while(!__sync_bool_compare_and_swap(lock, 0, 1));
-}
-
-static void hs_unlock(volatile StgInt64* lock) {
-  *lock = 0;
-}
-
-// Mean and variance are computed according to
-// http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Online_algorithm
-void hs_distrib_add_n(struct distrib* distrib, StgDouble val, StgInt64 n) {
-  hs_lock(&distrib->lock);
-  const StgInt64 count = distrib->count + n;
-  const StgDouble delta = val - distrib->mean;
-  const StgDouble mean = distrib->mean + n * delta / count;
-  const StgDouble sum_sq_delta = distrib->sum_sq_delta + delta * (val - mean) * n;
-  distrib->count = count;
-  distrib->mean = mean;
-  distrib->sum_sq_delta = sum_sq_delta;
-  distrib->sum += val;
-  distrib->min = val < distrib->min ? val : distrib->min;
-  distrib->max = val > distrib->max ? val : distrib->max;
-  hs_unlock(&distrib->lock);
-}
-
-// http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Parallel_algorithm
-void hs_distrib_combine(struct distrib* b, struct distrib* a) {
-  hs_lock(&b->lock);
-  const StgInt64 count = a->count + b->count;
-  const StgDouble delta = b->mean - a->mean;
-  const StgDouble mean = (a->count * a->mean + b->count * b->mean) / count;
-  const StgDouble sum_sq_delta = (a->sum_sq_delta + b->sum_sq_delta +
-                                  delta * delta * (a->count * b->count) / count);
-  a->count = count;
-  a->mean = (count == 0) ? 0.0 : mean; // divide-by-zero gives NaN
-  a->sum_sq_delta = sum_sq_delta;
-  a->sum = a->sum + b->sum;
-  a->min = b->min; // This is slightly hacky, but ok: see
-  a->max = b->max; // 813aa426be78e8abcf1c7cdd43433bcffa07828e
-  hs_unlock(&b->lock);
-}
diff --git a/cbits/distrib.h b/cbits/distrib.h
index bd0f402..77beb91 100644
--- a/cbits/distrib.h
+++ b/cbits/distrib.h
@@ -11,6 +11,7 @@
 #endif
 
 struct distrib {
+  // 0 -> unlocked; 1 -> locked
   HSINTTYPE lock;
   HSINTTYPE count;
   double mean;
diff --git a/ekg-core.cabal b/ekg-core.cabal
index cedcfa4..d7e7089 100644
--- a/ekg-core.cabal
+++ b/ekg-core.cabal
@@ -62,9 +62,6 @@ library
   includes:         distrib.h
   install-includes: distrib.h
   include-dirs:     cbits
-  c-sources:
-    cbits/atomic.c
-    cbits/distrib.c
 
 benchmark counter
   main-is:          Counter.hs

From d76fd8f7830f02b9bf534c403b51bf1eee150830 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 12:54:23 +0200
Subject: [PATCH 07/19] Fix ghc-prim constraint

---
 ekg-core.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ekg-core.cabal b/ekg-core.cabal
index d7e7089..2ff3ebf 100644
--- a/ekg-core.cabal
+++ b/ekg-core.cabal
@@ -48,7 +48,7 @@ library
   build-depends:
       base                  >=4.6 && <4.22
     , containers            >=0.5 && <0.9
-    , ghc-prim              >= 0.11 && < 0.14
+    , ghc-prim              >= 0.4 && < 0.14
     , text                  <2.2
     , unordered-containers  <0.3
 

From db37322741bcc405d954ade43ff24af20d34ed3f Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 13:02:55 +0200
Subject: [PATCH 08/19] Fix with 8.0.x

---
 Data/Atomic.hs    | 1 -
 System/Metrics.hs | 2 +-
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index 8d2a65e..eef5bc7 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -36,7 +36,6 @@ import GHC.Prim
 #endif
 
 -- | A mutable, atomic integer.
---newtype Atomic = C (ForeignPtr Int64)
 data Atomic = C (MutableByteArray# RealWorld)
 
 -- | Create a new, zero initialized, atomic.
diff --git a/System/Metrics.hs b/System/Metrics.hs
index 286fa1e..b5722f6 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -504,7 +504,7 @@ registerGcMetrics =
     getGcStats
     where
     -- | Convert seconds to milliseconds.
-    sToMs :: Double -> Int64
+    sToMs :: Double -> Int
     sToMs s = round (s * 1000.0)
 #endif
 

From 56ca464dcb657bf1ad05d7176b1f2630df10d641 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 13:17:57 +0200
Subject: [PATCH 09/19] fix it harder

---
 System/Metrics.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/System/Metrics.hs b/System/Metrics.hs
index b5722f6..968e01f 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -619,7 +619,7 @@ getGcStats = Stats.getGCStats
 # endif
 
 -- | Helper to work around rename in GHC.Stats in base-4.6.
-gcParTotBytesCopied :: Stats.GCStats -> Int64
+-- gcParTotBytesCopied :: Stats.GCStats -> Int64
 # if MIN_VERSION_base(4,6,0)
 gcParTotBytesCopied = Stats.parTotBytesCopied
 # else

From 0fc6787ac3d50590926240cbd091ea02ddee7671 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 13:24:42 +0200
Subject: [PATCH 10/19] fix it harder

---
 System/Metrics.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/System/Metrics.hs b/System/Metrics.hs
index 968e01f..e749cd1 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -481,11 +481,11 @@ registerGcMetrics =
     getRTSStats
 #else
     (M.fromList
-     [ ("rts.gc.bytes_allocated"          , Counter . Stats.bytesAllocated)
-     , ("rts.gc.num_gcs"                  , Counter . Stats.numGcs)
-     , ("rts.gc.num_bytes_usage_samples"  , Counter . Stats.numByteUsageSamples)
-     , ("rts.gc.cumulative_bytes_used"    , Counter . Stats.cumulativeBytesUsed)
-     , ("rts.gc.bytes_copied"             , Counter . Stats.bytesCopied)
+     [ ("rts.gc.bytes_allocated"          , Counter . fromIntegral . Stats.bytesAllocated)
+     , ("rts.gc.num_gcs"                  , Counter . fromIntegral . Stats.numGcs)
+     , ("rts.gc.num_bytes_usage_samples"  , Counter . fromIntegral . Stats.numByteUsageSamples)
+     , ("rts.gc.cumulative_bytes_used"    , Counter . fromIntegral . Stats.cumulativeBytesUsed)
+     , ("rts.gc.bytes_copied"             , Counter . fromIntegral . Stats.bytesCopied)
      , ("rts.gc.mutator_cpu_ms"           , Counter . sToMs . Stats.mutatorCpuSeconds)
      , ("rts.gc.mutator_wall_ms"          , Counter . sToMs . Stats.mutatorWallSeconds)
      , ("rts.gc.gc_cpu_ms"                , Counter . sToMs . Stats.gcCpuSeconds)

From 316a206b931667628867cfa335fd9a6d6e39ff1b Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Sun, 8 Jun 2025 14:40:23 +0200
Subject: [PATCH 11/19] fix it harder

---
 System/Metrics.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/System/Metrics.hs b/System/Metrics.hs
index e749cd1..26f4254 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -492,14 +492,14 @@ registerGcMetrics =
      , ("rts.gc.gc_wall_ms"               , Counter . sToMs . Stats.gcWallSeconds)
      , ("rts.gc.cpu_ms"                   , Counter . sToMs . Stats.cpuSeconds)
      , ("rts.gc.wall_ms"                  , Counter . sToMs . Stats.wallSeconds)
-     , ("rts.gc.max_bytes_used"           , Gauge . Stats.maxBytesUsed)
-     , ("rts.gc.current_bytes_used"       , Gauge . Stats.currentBytesUsed)
-     , ("rts.gc.current_bytes_slop"       , Gauge . Stats.currentBytesSlop)
-     , ("rts.gc.max_bytes_slop"           , Gauge . Stats.maxBytesSlop)
-     , ("rts.gc.peak_megabytes_allocated" , Gauge . Stats.peakMegabytesAllocated)
-     , ("rts.gc.par_tot_bytes_copied"     , Gauge . gcParTotBytesCopied)
-     , ("rts.gc.par_avg_bytes_copied"     , Gauge . gcParTotBytesCopied)
-     , ("rts.gc.par_max_bytes_copied"     , Gauge . Stats.parMaxBytesCopied)
+     , ("rts.gc.max_bytes_used"           , Gauge . fromIntegral . Stats.maxBytesUsed)
+     , ("rts.gc.current_bytes_used"       , Gauge . fromIntegral . Stats.currentBytesUsed)
+     , ("rts.gc.current_bytes_slop"       , Gauge . fromIntegral . Stats.currentBytesSlop)
+     , ("rts.gc.max_bytes_slop"           , Gauge . fromIntegral . Stats.maxBytesSlop)
+     , ("rts.gc.peak_megabytes_allocated" , Gauge . fromIntegral . Stats.peakMegabytesAllocated)
+     , ("rts.gc.par_tot_bytes_copied"     , Gauge . fromIntegral . gcParTotBytesCopied)
+     , ("rts.gc.par_avg_bytes_copied"     , Gauge . fromIntegral . gcParTotBytesCopied)
+     , ("rts.gc.par_max_bytes_copied"     , Gauge . fromIntegral . Stats.parMaxBytesCopied)
      ])
     getGcStats
     where

From 0653030421d6993f736f94a4095c4c2c27b690ac Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 17:09:49 -0700
Subject: [PATCH 12/19] Fast way on 64-bit, slow way on 32-bit.

---
 Data/Atomic.hs                          | 85 ++++++++++++++--------
 System/Metrics.hs                       | 93 ++++++++++++-------------
 System/Metrics/Counter.hs               |  5 +-
 System/Metrics/Distribution.hsc         | 58 +++++++++------
 System/Metrics/Distribution/Internal.hs |  4 +-
 System/Metrics/Gauge.hs                 |  9 +--
 benchmarks/Counter.hs                   |  2 +-
 cbits/distrib.h                         |  2 +-
 8 files changed, 148 insertions(+), 110 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index eef5bc7..5d16e6d 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -24,38 +24,75 @@ import GHC.IO
 import GHC.Prim
 
 #include "MachDeps.h"
-
-#ifndef WORD_SIZE_IN_BITS
-#error "WORD_SIZE_IN_BITS not defined"
-#elif WORD_SIZE_IN_BITS == 32
-#define ARRLEN 4
-#elif WORD_SIZE_IN_BITS == 64
-#define ARRLEN 8
-#else
-#error "WORD_SIZE_IN_BITS not 32 or 64"
+#ifndef SIZEOF_HSINT
+#error "MachDeps.h didn't define SIZEOF_HSINT"
 #endif
 
+-- 64-bit machine, Int ~ Int64, do it the fast way:
+#if SIZEOF_HSINT == 8
+
 -- | A mutable, atomic integer.
 data Atomic = C (MutableByteArray# RealWorld)
 
 -- | Create a new, zero initialized, atomic.
-new :: Int -> IO Atomic
-new (I# n) = IO $ \s ->
-    case newByteArray# ARRLEN# s of { (# s1, mba #) ->
-    case atomicWriteIntArray# mba 0# n s1 of { s2 ->
+new :: Int64 -> IO Atomic
+new (I64# n64) = IO $ \s ->
+    case newByteArray# SIZEOF_HSINT# s of { (# s1, mba #) ->
+    case atomicWriteIntArray# mba 0# (int64ToInt# n64) s1 of { s2 ->
     (# s2, C mba #) }}
 
-read :: Atomic -> IO Int
+read :: Atomic -> IO Int64
 read (C mba) = IO $ \s ->
     case atomicReadIntArray# mba 0# s of { (# s1, n #) ->
-    (# s1, I# n #)}
+    (# s1, I64# (intToInt64# n) #)}
 
 -- | Set the atomic to the given value.
-write :: Atomic -> Int -> IO ()
-write (C mba) (I# n) = IO $ \s ->
-    case atomicWriteIntArray# mba 0# n s of { s1 ->
+write :: Atomic -> Int64 -> IO ()
+write (C mba) (I64# n64) = IO $ \s ->
+    case atomicWriteIntArray# mba 0# (int64ToInt# n64) s of { s1 ->
+    (# s1, () #) }
+
+-- | Increase the atomic by the given amount.
+add :: Atomic -> Int64 -> IO ()
+add (C mba) (I64# n64) = IO $ \s ->
+    case fetchAddIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
     (# s1, () #) }
 
+-- | Decrease the atomic by the given amount.
+subtract :: Atomic -> Int64 -> IO ()
+subtract (C mba) (I64# n64) = IO $ \s ->
+    case fetchSubIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
+    (# s1, () #) }
+
+#else
+
+-- 32-bit machine, Int ~ Int32, fall back to IORef. This could be replaced with
+-- faster implementations for specific 32-bit machines in the future, but the
+-- idea is to preserve 64-bit width for counters.
+
+newtype Atomic = C (IORef Int64)
+
+-- | Create a new, zero initialized, atomic.
+new :: Int64 -> IO Atomic
+new = fmap C . newIORef
+
+read :: Atomic -> IO Int64
+read (C ior) = readIORef ior
+
+-- | Set the atomic to the given value.
+write :: Atomic -> Int64 -> IO ()
+write (C ior) !i = atomicWriteIORef ior i
+
+-- | Increase the atomic by the given amount.
+add :: Atomic -> Int64 -> IO ()
+add (C ior) !i = atomicModifyIORef' ior (\!n -> (n+i, ()))
+
+-- | Decrease the atomic by the given amount.
+subtract :: Atomic -> Int64 -> IO ()
+subtract (C ior) !i = atomicModifyIORef' ior (\!n -> (n-i, ()))
+
+#endif
+
 -- | Increase the atomic by one.
 inc :: Atomic -> IO ()
 inc atomic = add atomic 1
@@ -63,15 +100,3 @@ inc atomic = add atomic 1
 -- | Decrease the atomic by one.
 dec :: Atomic -> IO ()
 dec atomic = subtract atomic 1
-
--- | Increase the atomic by the given amount.
-add :: Atomic -> Int -> IO ()
-add (C mba) (I# n) = IO $ \s ->
-    case fetchAddIntArray# mba 0# n s of { (# s1, _ #) ->
-    (# s1, () #) }
-
--- | Decrease the atomic by the given amount.
-subtract :: Atomic -> Int -> IO ()
-subtract (C mba) (I# n) = IO $ \s ->
-    case fetchSubIntArray# mba 0# n s of { (# s1, _ #) ->
-    (# s1, () #) }
diff --git a/System/Metrics.hs b/System/Metrics.hs
index 26f4254..8cbe788 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -69,6 +69,7 @@ module System.Metrics
     ) where
 
 import Control.Monad (forM)
+import Data.Int (Int64)
 import qualified Data.IntMap.Strict as IM
 import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef)
 import qualified Data.HashMap.Strict as M
@@ -131,8 +132,8 @@ data GroupSampler = forall a. GroupSampler
      }
 
 -- TODO: Rename this to Metric and Metric to SampledMetric.
-data MetricSampler = CounterS !(IO Int)
-                   | GaugeS !(IO Int)
+data MetricSampler = CounterS !(IO Int64)
+                   | GaugeS !(IO Int64)
                    | LabelS !(IO T.Text)
                    | DistributionS !(IO Distribution.Stats)
 
@@ -154,18 +155,18 @@ newStore = do
 -- | Register a non-negative, monotonically increasing, integer-valued
 -- metric. The provided action to read the value must be thread-safe.
 -- Also see 'createCounter'.
-registerCounter :: T.Text  -- ^ Counter name
-                -> IO Int  -- ^ Action to read the current metric value
-                -> Store   -- ^ Metric store
+registerCounter :: T.Text   -- ^ Counter name
+                -> IO Int64 -- ^ Action to read the current metric value
+                -> Store    -- ^ Metric store
                 -> IO ()
 registerCounter name sample store =
     register name (CounterS sample) store
 
 -- | Register an integer-valued metric. The provided action to read
 -- the value must be thread-safe. Also see 'createGauge'.
-registerGauge :: T.Text  -- ^ Gauge name
-              -> IO Int  -- ^ Action to read the current metric value
-              -> Store   -- ^ Metric store
+registerGauge :: T.Text   -- ^ Gauge name
+              -> IO Int64 -- ^ Action to read the current metric value
+              -> Store    -- ^ Metric store
               -> IO ()
 registerGauge name sample store =
     register name (GaugeS sample) store
@@ -329,16 +330,6 @@ createDistribution name store = do
 -- easily be added to a metrics store by calling their register
 -- function.
 
-#if MIN_VERSION_base(4,10,0)
--- | Convert nanoseconds to milliseconds.
-nsToMs :: Int -> Int
-nsToMs s = round (realToFrac s / (1000000.0 :: Double))
-#else
--- | Convert seconds to milliseconds.
-sToMs :: Double -> Int
-sToMs s = round (s * 1000.0)
-#endif
-
 -- | Register a number of metrics related to garbage collector
 -- behavior.
 --
@@ -447,15 +438,15 @@ registerGcMetrics =
      , ("rts.gc.cumulative_bytes_used"    , Counter . fromIntegral . Stats.cumulative_live_bytes)
      , ("rts.gc.bytes_copied"             , Counter . fromIntegral . Stats.copied_bytes)
 #if MIN_VERSION_base(4,12,0)
-     , ("rts.gc.init_cpu_ms"              , Counter . nsToMs . fromIntegral . Stats.init_cpu_ns)
-     , ("rts.gc.init_wall_ms"             , Counter . nsToMs . fromIntegral . Stats.init_elapsed_ns)
+     , ("rts.gc.init_cpu_ms"              , Counter . nsToMs . Stats.init_cpu_ns)
+     , ("rts.gc.init_wall_ms"             , Counter . nsToMs . Stats.init_elapsed_ns)
 #endif
-     , ("rts.gc.mutator_cpu_ms"           , Counter . nsToMs . fromIntegral . Stats.mutator_cpu_ns)
-     , ("rts.gc.mutator_wall_ms"          , Counter . nsToMs . fromIntegral . Stats.mutator_elapsed_ns)
-     , ("rts.gc.gc_cpu_ms"                , Counter . nsToMs . fromIntegral . Stats.gc_cpu_ns)
-     , ("rts.gc.gc_wall_ms"               , Counter . nsToMs . fromIntegral . Stats.gc_elapsed_ns)
-     , ("rts.gc.cpu_ms"                   , Counter . nsToMs . fromIntegral . Stats.cpu_ns)
-     , ("rts.gc.wall_ms"                  , Counter . nsToMs . fromIntegral . Stats.elapsed_ns)
+     , ("rts.gc.mutator_cpu_ms"           , Counter . nsToMs . Stats.mutator_cpu_ns)
+     , ("rts.gc.mutator_wall_ms"          , Counter . nsToMs . Stats.mutator_elapsed_ns)
+     , ("rts.gc.gc_cpu_ms"                , Counter . nsToMs . Stats.gc_cpu_ns)
+     , ("rts.gc.gc_wall_ms"               , Counter . nsToMs . Stats.gc_elapsed_ns)
+     , ("rts.gc.cpu_ms"                   , Counter . nsToMs . Stats.cpu_ns)
+     , ("rts.gc.wall_ms"                  , Counter . nsToMs . Stats.elapsed_ns)
      , ("rts.gc.max_bytes_used"           , Gauge . fromIntegral . Stats.max_live_bytes)
      , ("rts.gc.max_large_bytes_used"     , Gauge . fromIntegral . Stats.max_large_objects_bytes)
      , ("rts.gc.max_compact_bytes_used"   , Gauge . fromIntegral . Stats.max_compact_bytes)
@@ -469,42 +460,46 @@ registerGcMetrics =
 #if MIN_VERSION_base(4,11,0)
      , ("rts.gc.par_balanced_bytes_copied", Gauge . fromIntegral . Stats.cumulative_par_balanced_copied_bytes)
 #if MIN_VERSION_base(4,15,0)
-     , ("rts.gc.nm.sync_cpu_ms"           , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_cpu_ns)
-     , ("rts.gc.nm.sync_elapsed_ms"       , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_elapsed_ns)
-     , ("rts.gc.nm.sync_max_elapsed_ms"   , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_sync_max_elapsed_ns)
-     , ("rts.gc.nm.cpu_ms"                , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_cpu_ns)
-     , ("rts.gc.nm.elapsed_ms"            , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_elapsed_ns)
-     , ("rts.gc.nm.max_elapsed_ms"        , Counter . nsToMs . fromIntegral . Stats.nonmoving_gc_max_elapsed_ns)
+     , ("rts.gc.nm.sync_cpu_ms"           , Counter . nsToMs . Stats.nonmoving_gc_sync_cpu_ns)
+     , ("rts.gc.nm.sync_elapsed_ms"       , Counter . nsToMs . Stats.nonmoving_gc_sync_elapsed_ns)
+     , ("rts.gc.nm.sync_max_elapsed_ms"   , Counter . nsToMs . Stats.nonmoving_gc_sync_max_elapsed_ns)
+     , ("rts.gc.nm.cpu_ms"                , Counter . nsToMs . Stats.nonmoving_gc_cpu_ns)
+     , ("rts.gc.nm.elapsed_ms"            , Counter . nsToMs . Stats.nonmoving_gc_elapsed_ns)
+     , ("rts.gc.nm.max_elapsed_ms"        , Counter . nsToMs . Stats.nonmoving_gc_max_elapsed_ns)
 # endif
 # endif
      ])
     getRTSStats
+    where
+    -- | Convert nanoseconds to milliseconds.
+    nsToMs :: Int64 -> Int64
+    nsToMs s = round (realToFrac s / (1000000.0 :: Double))
 #else
     (M.fromList
-     [ ("rts.gc.bytes_allocated"          , Counter . fromIntegral . Stats.bytesAllocated)
-     , ("rts.gc.num_gcs"                  , Counter . fromIntegral . Stats.numGcs)
-     , ("rts.gc.num_bytes_usage_samples"  , Counter . fromIntegral . Stats.numByteUsageSamples)
-     , ("rts.gc.cumulative_bytes_used"    , Counter . fromIntegral . Stats.cumulativeBytesUsed)
-     , ("rts.gc.bytes_copied"             , Counter . fromIntegral . Stats.bytesCopied)
+     [ ("rts.gc.bytes_allocated"          , Counter . Stats.bytesAllocated)
+     , ("rts.gc.num_gcs"                  , Counter . Stats.numGcs)
+     , ("rts.gc.num_bytes_usage_samples"  , Counter . Stats.numByteUsageSamples)
+     , ("rts.gc.cumulative_bytes_used"    , Counter . Stats.cumulativeBytesUsed)
+     , ("rts.gc.bytes_copied"             , Counter . Stats.bytesCopied)
      , ("rts.gc.mutator_cpu_ms"           , Counter . sToMs . Stats.mutatorCpuSeconds)
      , ("rts.gc.mutator_wall_ms"          , Counter . sToMs . Stats.mutatorWallSeconds)
      , ("rts.gc.gc_cpu_ms"                , Counter . sToMs . Stats.gcCpuSeconds)
      , ("rts.gc.gc_wall_ms"               , Counter . sToMs . Stats.gcWallSeconds)
      , ("rts.gc.cpu_ms"                   , Counter . sToMs . Stats.cpuSeconds)
      , ("rts.gc.wall_ms"                  , Counter . sToMs . Stats.wallSeconds)
-     , ("rts.gc.max_bytes_used"           , Gauge . fromIntegral . Stats.maxBytesUsed)
-     , ("rts.gc.current_bytes_used"       , Gauge . fromIntegral . Stats.currentBytesUsed)
-     , ("rts.gc.current_bytes_slop"       , Gauge . fromIntegral . Stats.currentBytesSlop)
-     , ("rts.gc.max_bytes_slop"           , Gauge . fromIntegral . Stats.maxBytesSlop)
-     , ("rts.gc.peak_megabytes_allocated" , Gauge . fromIntegral . Stats.peakMegabytesAllocated)
-     , ("rts.gc.par_tot_bytes_copied"     , Gauge . fromIntegral . gcParTotBytesCopied)
-     , ("rts.gc.par_avg_bytes_copied"     , Gauge . fromIntegral . gcParTotBytesCopied)
-     , ("rts.gc.par_max_bytes_copied"     , Gauge . fromIntegral . Stats.parMaxBytesCopied)
+     , ("rts.gc.max_bytes_used"           , Gauge . Stats.maxBytesUsed)
+     , ("rts.gc.current_bytes_used"       , Gauge . Stats.currentBytesUsed)
+     , ("rts.gc.current_bytes_slop"       , Gauge . Stats.currentBytesSlop)
+     , ("rts.gc.max_bytes_slop"           , Gauge . Stats.maxBytesSlop)
+     , ("rts.gc.peak_megabytes_allocated" , Gauge . Stats.peakMegabytesAllocated)
+     , ("rts.gc.par_tot_bytes_copied"     , Gauge . gcParTotBytesCopied)
+     , ("rts.gc.par_avg_bytes_copied"     , Gauge . gcParTotBytesCopied)
+     , ("rts.gc.par_max_bytes_copied"     , Gauge . Stats.parMaxBytesCopied)
      ])
     getGcStats
     where
     -- | Convert seconds to milliseconds.
-    sToMs :: Double -> Int
+    sToMs :: Double -> Int64
     sToMs s = round (s * 1000.0)
 #endif
 
@@ -619,7 +614,7 @@ getGcStats = Stats.getGCStats
 # endif
 
 -- | Helper to work around rename in GHC.Stats in base-4.6.
--- gcParTotBytesCopied :: Stats.GCStats -> Int64
+gcParTotBytesCopied :: Stats.GCStats -> Int64
 # if MIN_VERSION_base(4,6,0)
 gcParTotBytesCopied = Stats.parTotBytesCopied
 # else
@@ -663,8 +658,8 @@ sampleGroups cbSamplers = concat `fmap` sequence (map runOne cbSamplers)
         return $! map (\ (n, f) -> (n, f a)) (M.toList groupSamplerMetrics)
 
 -- | The value of a sampled metric.
-data Value = Counter {-# UNPACK #-} !Int
-           | Gauge {-# UNPACK #-} !Int
+data Value = Counter {-# UNPACK #-} !Int64
+           | Gauge {-# UNPACK #-} !Int64
            | Label {-# UNPACK #-} !T.Text
            | Distribution !Distribution.Stats
            deriving (Eq, Show)
diff --git a/System/Metrics/Counter.hs b/System/Metrics/Counter.hs
index 55adc8f..847dc3f 100644
--- a/System/Metrics/Counter.hs
+++ b/System/Metrics/Counter.hs
@@ -12,6 +12,7 @@ module System.Metrics.Counter
     ) where
 
 import qualified Data.Atomic as Atomic
+import Data.Int (Int64)
 import Prelude hiding (read)
 
 -- | A mutable, integer-valued counter.
@@ -22,7 +23,7 @@ new :: IO Counter
 new = C `fmap` Atomic.new 0
 
 -- | Get the current value of the counter.
-read :: Counter -> IO Int
+read :: Counter -> IO Int64
 read = Atomic.read . unC
 
 -- | Increase the counter by one.
@@ -30,5 +31,5 @@ inc :: Counter -> IO ()
 inc counter = add counter 1
 
 -- | Add the argument to the counter.
-add :: Counter -> Int -> IO ()
+add :: Counter -> Int64 -> IO ()
 add counter = Atomic.add (unC counter)
diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 8bf557b..52eb404 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ExtendedLiterals #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -6,6 +7,7 @@
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 
 #include "distrib.h"
+#include "MachDeps.h"
 
 -- | This module defines a type for tracking statistics about a series
 -- of events. An event could be handling of a request and the value
@@ -59,7 +61,7 @@ lockPos = div (#offset struct distrib, lock)
 
 countPos :: Int
 countPos = div (#offset struct distrib, count)
-               (sizeOf (undefined :: Int))
+               (sizeOf (undefined :: Int64))
 
 meanPos :: Int
 meanPos = div (#offset struct distrib, mean)
@@ -89,7 +91,7 @@ newDistrib = IO $ \s ->
     -- probably unecessary
     case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
     case countPos of { (I## countPos') ->
-    case writeIntArray## mba countPos' 0## s2 of { s3 ->
+    case writeInt64Array## mba countPos' 0##Int64 s2 of { s3 ->
     case meanPos of { (I## meanPos') ->
     case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -147,14 +149,26 @@ spinUnlock mba = \s ->
     case writeIntArray## mba lockPos' 0## s of { s2 ->
     s2 }}
 
+int64ToDouble :: Int64## -> Double##
+-- 64-bit machine, Int ~ Int64, do it the fast way:
+#if SIZEOF_HSINT == 8
+int64ToDouble i = int2Double## (int64ToInt## i)
+#else
+-- I don't know a better way on 32-bit machines...
+int64ToDouble i =
+    case fromIntegral (I64## i) of (D## d) -> d
+#endif
+
+{-# INLINE int64ToDouble #-}
+
 -- | Add the same value to the distribution N times.
-addN :: Distribution -> Double -> Int -> IO ()
-addN distribution (D## val) (I## n) = IO $ \s ->
+addN :: Distribution -> Double -> Int64 -> IO ()
+addN distribution (D## val) (I64## n) = IO $ \s ->
     case myStripe distribution of { (IO myStripe') ->
     case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
     case spinLock mba s1 of { s2 ->
     case countPos of { (I## countPos') ->
-    case readIntArray## mba countPos' s2 of { (## s3, count ##) ->
+    case readInt64Array## mba countPos' s2 of { (## s3, count ##) ->
     case meanPos of { (I## meanPos') ->
     case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -165,11 +179,11 @@ addN distribution (D## val) (I## n) = IO $ \s ->
     case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
     case maxPos of { (I## maxPos') ->
     case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
-    case count +## n of { count' ->
+    case plusInt64## count n of { count' ->
     case val -#### mean of { delta ->
-    case mean +#### ((int2Double## n) *#### delta /#### (int2Double## count')) of { mean' ->
-    case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int2Double## n)) of { sumSqDelta' ->
-    case writeIntArray## mba countPos' count' s8 of { s9 ->
+    case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
+    case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
+    case writeInt64Array## mba countPos' count' s8 of { s9 ->
     case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
     case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
     case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
@@ -184,15 +198,15 @@ combine :: Distrib -> Distrib -> IO ()
 combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
     case spinLock bMBA s of { s1 ->
     case countPos of { (I## countPos') ->
-    case readIntArray## aMBA countPos' s1 of { (## s2, aCount ##) ->
-    case readIntArray## bMBA countPos' s2 of { (## s3, bCount ##) ->
-    case aCount +## bCount of { count' ->
+    case readInt64Array## aMBA countPos' s1 of { (## s2, aCount ##) ->
+    case readInt64Array## bMBA countPos' s2 of { (## s3, bCount ##) ->
+    case plusInt64## aCount bCount of { count' ->
     case meanPos of { (I## meanPos' ) ->
     case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
     case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
     case bMean -#### aMean of { delta ->
-    case (   (((int2Double## aCount) *#### aMean) +#### ((int2Double## bCount) *#### bMean))
-         /#### (int2Double## count')
+    case (   (((int64ToDouble aCount) *#### aMean) +#### ((int64ToDouble bCount) *#### bMean))
+         /#### (int64ToDouble count')
          ) of { mean' ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
     case readDoubleArray## aMBA sumSqDeltaPos' s5 of { (## s6, aSumSqDelta ##) ->
@@ -201,13 +215,13 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
          +#### bSumSqDelta
          +#### (   delta
                *#### delta
-               *#### (   (int2Double## aCount) *#### (int2Double## bCount)
-                     /#### (int2Double## count')
+               *#### (   (int64ToDouble aCount) *#### (int64ToDouble bCount)
+                     /#### (int64ToDouble count')
                      )
                )
          ) of { sumSqDelta' ->
-    case writeIntArray## aMBA countPos' count' s7 of { s8 ->
-    case (case count' ==## 0## of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
+    case writeInt64Array## aMBA countPos' count' s7 of { s8 ->
+    case (case eqInt64## count' 0##Int64 of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
     case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
     case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
     case sumPos of { (I## sumPos') ->
@@ -236,7 +250,7 @@ read distrib = do
         case sumPos of { (I## sumPos') ->
         case minPos of { (I## minPos') ->
         case maxPos of { (I## maxPos') ->
-        case readIntArray## mba countPos' s of { (## s1, count ##) ->
+        case readInt64Array## mba countPos' s of { (## s1, count ##) ->
         case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
         case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
         case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->
@@ -244,9 +258,9 @@ read distrib = do
         case readDoubleArray## mba maxPos' s5 of { (## s6, dMax ##) ->
         (## s6
         , Stats { mean = (D## mean)
-                , variance = if (I## count) == 0 then 0.0
-                             else (D## sumSqDelta) / (D## (int2Double## count))
-                , count = (I## count)
+                , variance = if (I64## count) == 0 then 0.0
+                             else (D## sumSqDelta) / (D## (int64ToDouble count))
+                , count = (I64## count)
                 , sum = (D## dSum)
                 , min = (D## dMin)
                 , max = (D## dMax)
diff --git a/System/Metrics/Distribution/Internal.hs b/System/Metrics/Distribution/Internal.hs
index af01e99..3c59349 100644
--- a/System/Metrics/Distribution/Internal.hs
+++ b/System/Metrics/Distribution/Internal.hs
@@ -6,11 +6,13 @@ module System.Metrics.Distribution.Internal
     ( Stats(..)
     ) where
 
+import Data.Int (Int64)
+
 -- | Distribution statistics
 data Stats = Stats
     { mean     :: !Double  -- ^ Sample mean
     , variance :: !Double  -- ^ Biased sample variance
-    , count    :: !Int   -- ^ Event count
+    , count    :: !Int64   -- ^ Event count
     , sum      :: !Double  -- ^ Sum of values
     , min      :: !Double  -- ^ Min value seen
     , max      :: !Double  -- ^ Max value seen
diff --git a/System/Metrics/Gauge.hs b/System/Metrics/Gauge.hs
index b91fe4c..0702ea9 100644
--- a/System/Metrics/Gauge.hs
+++ b/System/Metrics/Gauge.hs
@@ -15,6 +15,7 @@ module System.Metrics.Gauge
     ) where
 
 import qualified Data.Atomic as Atomic
+import Data.Int (Int64)
 import Prelude hiding (subtract, read)
 
 -- | A mutable, integer-valued gauge.
@@ -25,7 +26,7 @@ new :: IO Gauge
 new = C `fmap` Atomic.new 0
 
 -- | Get the current value of the gauge.
-read :: Gauge -> IO Int
+read :: Gauge -> IO Int64
 read = Atomic.read . unC
 
 -- | Increase the gauge by one.
@@ -37,13 +38,13 @@ dec :: Gauge -> IO ()
 dec gauge = subtract gauge 1
 
 -- | Increase the gauge by the given amount.
-add :: Gauge -> Int -> IO ()
+add :: Gauge -> Int64 -> IO ()
 add gauge = Atomic.add (unC gauge)
 
 -- | Decrease the gauge by the given amount.
-subtract :: Gauge -> Int -> IO ()
+subtract :: Gauge -> Int64 -> IO ()
 subtract gauge = Atomic.subtract (unC gauge)
 
 -- | Set the gauge to the given value.
-set :: Gauge -> Int -> IO ()
+set :: Gauge -> Int64 -> IO ()
 set gauge = Atomic.write (unC gauge)
diff --git a/benchmarks/Counter.hs b/benchmarks/Counter.hs
index 53a68bb..5f4d8fe 100644
--- a/benchmarks/Counter.hs
+++ b/benchmarks/Counter.hs
@@ -14,7 +14,7 @@ main = do
     mapM_ (forkIO . work counter iters) locks
     mapM_ takeMVar locks
     fin <- C.read counter
-    when (fin /= (n * iters)) $
+    when (fin /= fromIntegral (n * iters)) $
         fail "Data.Atomic is broken!"
   where
     n = 100
diff --git a/cbits/distrib.h b/cbits/distrib.h
index 77beb91..ead588f 100644
--- a/cbits/distrib.h
+++ b/cbits/distrib.h
@@ -13,7 +13,7 @@
 struct distrib {
   // 0 -> unlocked; 1 -> locked
   HSINTTYPE lock;
-  HSINTTYPE count;
+  int64_t count;
   double mean;
   double sum_sq_delta;
   double sum;

From 5d6ad40401b6104d0c6d3b7ca0da54c3908855a5 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 17:19:18 -0700
Subject: [PATCH 13/19] Remove some unnecessary changes, preserve some of the
 old explanatory comments.

---
 .gitignore                      |  1 +
 System/Metrics.hs               | 12 ++++++------
 System/Metrics/Distribution.hsc |  9 +++++++++
 3 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/.gitignore b/.gitignore
index cc7651d..a879044 100644
--- a/.gitignore
+++ b/.gitignore
@@ -13,3 +13,4 @@ examples/Group
 *.sublime-*
 dist-newstyle/
 cabal.project.local
+cabal.project.local~
diff --git a/System/Metrics.hs b/System/Metrics.hs
index 8cbe788..0d4c7ea 100644
--- a/System/Metrics.hs
+++ b/System/Metrics.hs
@@ -155,18 +155,18 @@ newStore = do
 -- | Register a non-negative, monotonically increasing, integer-valued
 -- metric. The provided action to read the value must be thread-safe.
 -- Also see 'createCounter'.
-registerCounter :: T.Text   -- ^ Counter name
-                -> IO Int64 -- ^ Action to read the current metric value
-                -> Store    -- ^ Metric store
+registerCounter :: T.Text    -- ^ Counter name
+                -> IO Int64  -- ^ Action to read the current metric value
+                -> Store     -- ^ Metric store
                 -> IO ()
 registerCounter name sample store =
     register name (CounterS sample) store
 
 -- | Register an integer-valued metric. The provided action to read
 -- the value must be thread-safe. Also see 'createGauge'.
-registerGauge :: T.Text   -- ^ Gauge name
-              -> IO Int64 -- ^ Action to read the current metric value
-              -> Store    -- ^ Metric store
+registerGauge :: T.Text    -- ^ Gauge name
+              -> IO Int64  -- ^ Action to read the current metric value
+              -> Store     -- ^ Metric store
               -> IO ()
 registerGauge name sample store =
     register name (GaugeS sample) store
diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 52eb404..723935d 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -162,6 +162,8 @@ int64ToDouble i =
 {-# INLINE int64ToDouble #-}
 
 -- | Add the same value to the distribution N times.
+--   Mean and variance are computed according to
+--   http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Online_algorithm
 addN :: Distribution -> Double -> Int64 -> IO ()
 addN distribution (D## val) (I64## n) = IO $ \s ->
     case myStripe distribution of { (IO myStripe') ->
@@ -194,6 +196,11 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
     case spinUnlock mba s14 of { s15 ->
     (## s15, () ##) }}}}}}}}}}}}}}}}}}}}}}}}}}}}
 
+-- | Combine 'b' with 'a', writing the result in 'a'. Takes the lock of
+--   'b' while combining, but doesn't otherwise modify 'b'. 'a' is
+--   assumed to not be used concurrently.
+--   See also:
+--   http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Parallel_algorithm
 combine :: Distrib -> Distrib -> IO ()
 combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
     case spinLock bMBA s of { s1 ->
@@ -232,6 +239,8 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
     case readDoubleArray## bMBA minPos' s13 of { (## s14, bMin ##) ->
     case writeDoubleArray## aMBA minPos' bMin s14 of { s15 ->
     case maxPos of { (I## maxPos') ->
+    -- This is slightly hacky, but ok: see
+    -- 813aa426be78e8abcf1c7cdd43433bcffa07828e
     case readDoubleArray## bMBA maxPos' s15 of { (## s16, bMax ##) ->
     case writeDoubleArray## aMBA maxPos' bMax s16 of { s17 ->
     case spinUnlock bMBA s17 of { s18 ->

From e5439d2976b0cc281cc30e2adb265184eb87682e Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 17:35:34 -0700
Subject: [PATCH 14/19] Make it work on wasm32-wasi and older GHCs

---
 Data/Atomic.hs                  | 22 +++++++++++++++++-----
 System/Metrics/Distribution.hsc |  5 ++---
 2 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index 5d16e6d..77938c0 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -17,17 +17,29 @@ module Data.Atomic
     , subtract
     ) where
 
+#include "MachDeps.h"
+#ifndef SIZEOF_HSINT
+#error "MachDeps.h didn't define SIZEOF_HSINT"
+#endif
+
 import Prelude hiding (read, subtract)
 
 import GHC.Int
+
+#if SIZEOF_HSINT == 8
+
+-- 64-bit imports
 import GHC.IO
 import GHC.Prim
 
-#include "MachDeps.h"
-#ifndef SIZEOF_HSINT
-#error "MachDeps.h didn't define SIZEOF_HSINT"
+#else
+
+-- 32-bit imports
+import Data.IORef
+
 #endif
 
+
 -- 64-bit machine, Int ~ Int64, do it the fast way:
 #if SIZEOF_HSINT == 8
 
@@ -85,11 +97,11 @@ write (C ior) !i = atomicWriteIORef ior i
 
 -- | Increase the atomic by the given amount.
 add :: Atomic -> Int64 -> IO ()
-add (C ior) !i = atomicModifyIORef' ior (\!n -> (n+i, ()))
+add (C ior) !i = atomicModifyIORef' ior (\(!n) -> (n+i, ()))
 
 -- | Decrease the atomic by the given amount.
 subtract :: Atomic -> Int64 -> IO ()
-subtract (C ior) !i = atomicModifyIORef' ior (\!n -> (n-i, ()))
+subtract (C ior) !i = atomicModifyIORef' ior (\(!n) -> (n-i, ()))
 
 #endif
 
diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 723935d..2945a13 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -1,5 +1,4 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ExtendedLiterals #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -91,7 +90,7 @@ newDistrib = IO $ \s ->
     -- probably unecessary
     case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
     case countPos of { (I## countPos') ->
-    case writeInt64Array## mba countPos' 0##Int64 s2 of { s3 ->
+    case writeInt64Array## mba countPos' (intToInt64## 0##) s2 of { s3 ->
     case meanPos of { (I## meanPos') ->
     case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -228,7 +227,7 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
                )
          ) of { sumSqDelta' ->
     case writeInt64Array## aMBA countPos' count' s7 of { s8 ->
-    case (case eqInt64## count' 0##Int64 of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
+    case (case eqInt64## count' (intToInt64## 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
     case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
     case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
     case sumPos of { (I## sumPos') ->

From a12f5bdf4c63be8192a3f8337aad7663b1d69dd3 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 17:47:33 -0700
Subject: [PATCH 15/19] Int64# was added in GHC 9.4.x

---
 Data/Atomic.hs                  | 24 ++++++++--
 System/Metrics/Distribution.hsc | 81 ++++++++++++++++++++++++---------
 2 files changed, 78 insertions(+), 27 deletions(-)

diff --git a/Data/Atomic.hs b/Data/Atomic.hs
index 77938c0..ce28d2a 100644
--- a/Data/Atomic.hs
+++ b/Data/Atomic.hs
@@ -43,6 +43,20 @@ import Data.IORef
 -- 64-bit machine, Int ~ Int64, do it the fast way:
 #if SIZEOF_HSINT == 8
 
+#if MIN_VERSION_base(4,17,0)
+int64ToInt :: Int64# -> Int#
+int64ToInt = int64ToInt#
+
+intToInt64 :: Int# -> Int64#
+intToInt64 = intToInt64#
+#else
+int64ToInt :: Int# -> Int#
+int64ToInt i = i
+
+intToInt64 :: Int# -> Int#
+intToInt64 i = i
+#endif
+
 -- | A mutable, atomic integer.
 data Atomic = C (MutableByteArray# RealWorld)
 
@@ -50,30 +64,30 @@ data Atomic = C (MutableByteArray# RealWorld)
 new :: Int64 -> IO Atomic
 new (I64# n64) = IO $ \s ->
     case newByteArray# SIZEOF_HSINT# s of { (# s1, mba #) ->
-    case atomicWriteIntArray# mba 0# (int64ToInt# n64) s1 of { s2 ->
+    case atomicWriteIntArray# mba 0# (int64ToInt n64) s1 of { s2 ->
     (# s2, C mba #) }}
 
 read :: Atomic -> IO Int64
 read (C mba) = IO $ \s ->
     case atomicReadIntArray# mba 0# s of { (# s1, n #) ->
-    (# s1, I64# (intToInt64# n) #)}
+    (# s1, I64# (intToInt64 n) #)}
 
 -- | Set the atomic to the given value.
 write :: Atomic -> Int64 -> IO ()
 write (C mba) (I64# n64) = IO $ \s ->
-    case atomicWriteIntArray# mba 0# (int64ToInt# n64) s of { s1 ->
+    case atomicWriteIntArray# mba 0# (int64ToInt n64) s of { s1 ->
     (# s1, () #) }
 
 -- | Increase the atomic by the given amount.
 add :: Atomic -> Int64 -> IO ()
 add (C mba) (I64# n64) = IO $ \s ->
-    case fetchAddIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
+    case fetchAddIntArray# mba 0# (int64ToInt n64) s of { (# s1, _ #) ->
     (# s1, () #) }
 
 -- | Decrease the atomic by the given amount.
 subtract :: Atomic -> Int64 -> IO ()
 subtract (C mba) (I64# n64) = IO $ \s ->
-    case fetchSubIntArray# mba 0# (int64ToInt# n64) s of { (# s1, _ #) ->
+    case fetchSubIntArray# mba 0# (int64ToInt n64) s of { (# s1, _ #) ->
     (# s1, () #) }
 
 #else
diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 2945a13..6c84f32 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -36,7 +36,7 @@ import Prelude hiding (max, min, read, sum)
 import Foreign.Storable (sizeOf)
 
 import GHC.Float
-import GHC.Int
+import GHC.Int (Int(..), Int64(..))
 import GHC.IO
 import GHC.Prim
 
@@ -44,6 +44,54 @@ import Data.Array
 import System.Metrics.Distribution.Internal (Stats(..))
 import System.Metrics.ThreadId
 
+-- 64-bit machine, Int ~ Int64, do it the fast way:
+#if SIZEOF_HSINT == 8
+
+#if MIN_VERSION_base(4,17,0)
+int64ToDouble :: Int64## -> Double##
+int64ToDouble i = int2Double## (int64ToInt## i)
+
+intToInt64 :: Int## -> Int64##
+intToInt64 = intToInt64##
+
+plusInt64 :: Int64## -> Int64## -> Int64##
+plusInt64 = plusInt64##
+
+eqInt64 :: Int64## -> Int64## -> Int##
+eqInt64 = eqInt64##
+
+readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int64## ##)
+readInt64Array = readInt64Array##
+
+writeInt64Array :: MutableByteArray## d -> Int## -> Int64## -> State## d -> State## d
+writeInt64Array = writeInt64Array##
+
+#else
+int64ToDouble :: Int## -> Double##
+int64ToDouble i = int2Double## i
+
+intToInt64 :: Int## -> Int##
+intToInt64 i = i
+
+plusInt64 :: Int## -> Int## -> Int##
+plusInt64 a b = a +## b
+
+eqInt64 :: Int## -> Int## -> Int##
+eqInt64 a b = a ==## b
+
+readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int## ##)
+readInt64Array = readIntArray##
+
+writeInt64Array :: MutableByteArray## d -> Int## -> Int## -> State## d -> State## d
+writeInt64Array = writeIntArray##
+#endif
+
+#else
+-- I don't know a better way on 32-bit machines...
+int64ToDouble i =
+    case fromIntegral (I64## i) of (D## d) -> d
+#endif
+
 -- | An metric for tracking events.
 newtype Distribution = Distribution { unD :: Array Stripe }
 
@@ -90,7 +138,7 @@ newDistrib = IO $ \s ->
     -- probably unecessary
     case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
     case countPos of { (I## countPos') ->
-    case writeInt64Array## mba countPos' (intToInt64## 0##) s2 of { s3 ->
+    case writeInt64Array mba countPos' (intToInt64 0##) s2 of { s3 ->
     case meanPos of { (I## meanPos') ->
     case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -148,17 +196,6 @@ spinUnlock mba = \s ->
     case writeIntArray## mba lockPos' 0## s of { s2 ->
     s2 }}
 
-int64ToDouble :: Int64## -> Double##
--- 64-bit machine, Int ~ Int64, do it the fast way:
-#if SIZEOF_HSINT == 8
-int64ToDouble i = int2Double## (int64ToInt## i)
-#else
--- I don't know a better way on 32-bit machines...
-int64ToDouble i =
-    case fromIntegral (I64## i) of (D## d) -> d
-#endif
-
-{-# INLINE int64ToDouble #-}
 
 -- | Add the same value to the distribution N times.
 --   Mean and variance are computed according to
@@ -169,7 +206,7 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
     case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
     case spinLock mba s1 of { s2 ->
     case countPos of { (I## countPos') ->
-    case readInt64Array## mba countPos' s2 of { (## s3, count ##) ->
+    case readInt64Array mba countPos' s2 of { (## s3, count ##) ->
     case meanPos of { (I## meanPos') ->
     case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
     case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
@@ -180,11 +217,11 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
     case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
     case maxPos of { (I## maxPos') ->
     case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
-    case plusInt64## count n of { count' ->
+    case plusInt64 count n of { count' ->
     case val -#### mean of { delta ->
     case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
     case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
-    case writeInt64Array## mba countPos' count' s8 of { s9 ->
+    case writeInt64Array mba countPos' count' s8 of { s9 ->
     case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
     case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
     case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
@@ -204,9 +241,9 @@ combine :: Distrib -> Distrib -> IO ()
 combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
     case spinLock bMBA s of { s1 ->
     case countPos of { (I## countPos') ->
-    case readInt64Array## aMBA countPos' s1 of { (## s2, aCount ##) ->
-    case readInt64Array## bMBA countPos' s2 of { (## s3, bCount ##) ->
-    case plusInt64## aCount bCount of { count' ->
+    case readInt64Array aMBA countPos' s1 of { (## s2, aCount ##) ->
+    case readInt64Array bMBA countPos' s2 of { (## s3, bCount ##) ->
+    case plusInt64 aCount bCount of { count' ->
     case meanPos of { (I## meanPos' ) ->
     case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
     case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
@@ -226,8 +263,8 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
                      )
                )
          ) of { sumSqDelta' ->
-    case writeInt64Array## aMBA countPos' count' s7 of { s8 ->
-    case (case eqInt64## count' (intToInt64## 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
+    case writeInt64Array aMBA countPos' count' s7 of { s8 ->
+    case (case eqInt64 count' (intToInt64 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
     case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
     case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
     case sumPos of { (I## sumPos') ->
@@ -258,7 +295,7 @@ read distrib = do
         case sumPos of { (I## sumPos') ->
         case minPos of { (I## minPos') ->
         case maxPos of { (I## maxPos') ->
-        case readInt64Array## mba countPos' s of { (## s1, count ##) ->
+        case readInt64Array mba countPos' s of { (## s1, count ##) ->
         case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
         case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
         case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->

From 3d3fc981d42af08d46a4b16791508e6b05c2946d Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 18:37:56 -0700
Subject: [PATCH 16/19] Make it build on WASM again.

---
 System/Metrics/Distribution.hsc | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 6c84f32..b2b528a 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -44,6 +44,11 @@ import Data.Array
 import System.Metrics.Distribution.Internal (Stats(..))
 import System.Metrics.ThreadId
 
+-- Three cases for these definitions
+-- 64-bit, GHC has Int64
+-- 64-bit, GHC doesn't have Int64
+-- 32-bit
+
 -- 64-bit machine, Int ~ Int64, do it the fast way:
 #if SIZEOF_HSINT == 8
 
@@ -87,7 +92,25 @@ writeInt64Array = writeIntArray##
 #endif
 
 #else
+-- NB: I've only tested these with the WASM backend:
+ 
+intToInt64 :: Int## -> Int64##
+intToInt64 = intToInt64##
+
+plusInt64 :: Int64## -> Int64## -> Int64##
+plusInt64 = plusInt64##
+
+eqInt64 :: Int64## -> Int64## -> Int##
+eqInt64 = eqInt64##
+
+readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int64## ##)
+readInt64Array = readInt64Array##
+
+writeInt64Array :: MutableByteArray## d -> Int## -> Int64## -> State## d -> State## d
+writeInt64Array = writeInt64Array##
+
 -- I don't know a better way on 32-bit machines...
+int64ToDouble :: Int64## -> Double##
 int64ToDouble i =
     case fromIntegral (I64## i) of (D## d) -> d
 #endif

From 90391c424ddd1ba908c8ab3e026d69f9ee1d6eec Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Wed, 18 Jun 2025 18:48:11 -0700
Subject: [PATCH 17/19] Clean up once more

---
 System/Metrics/Distribution.hsc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index b2b528a..e637b92 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -73,16 +73,16 @@ writeInt64Array = writeInt64Array##
 
 #else
 int64ToDouble :: Int## -> Double##
-int64ToDouble i = int2Double## i
+int64ToDouble = int2Double##
 
 intToInt64 :: Int## -> Int##
 intToInt64 i = i
 
 plusInt64 :: Int## -> Int## -> Int##
-plusInt64 a b = a +## b
+plusInt64 = (+##)
 
 eqInt64 :: Int## -> Int## -> Int##
-eqInt64 a b = a ==## b
+eqInt64 = (==##)
 
 readInt64Array :: MutableByteArray## d -> Int## -> State## d -> (## State## d, Int## ##)
 readInt64Array = readIntArray##

From 2921d8c3d71ec51098856a6d65142a70cf9db6d3 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Thu, 19 Jun 2025 13:44:16 -0700
Subject: [PATCH 18/19] Don't have to destructure boxed constants everywhere.

---
 System/Metrics/Distribution.hsc | 133 +++++++++++++-------------------
 1 file changed, 54 insertions(+), 79 deletions(-)

diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index e637b92..7b6b5bc 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -122,6 +122,10 @@ newtype Stripe = Stripe { stripeD :: Distrib }
 
 data Distrib = Distrib (MutableByteArray## RealWorld)
 
+unI :: Int -> Int##
+unI (I## x) = x
+{-# INLINE unI #-}
+
 distribLen :: Int
 distribLen = (#size struct distrib)
 
@@ -155,24 +159,16 @@ maxPos = div (#offset struct distrib, max)
 
 newDistrib :: IO Distrib
 newDistrib = IO $ \s ->
-    case distribLen of { (I## distribLen') ->
-    case newByteArray## distribLen' s of { (## s1, mba ##) ->
-    case lockPos of { (I## lockPos') ->
-    -- probably unecessary
-    case atomicWriteIntArray## mba lockPos' 0## s1 of { s2 ->
-    case countPos of { (I## countPos') ->
-    case writeInt64Array mba countPos' (intToInt64 0##) s2 of { s3 ->
-    case meanPos of { (I## meanPos') ->
-    case writeDoubleArray## mba meanPos' 0.0#### s3 of { s4 ->
-    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
-    case writeDoubleArray## mba sumSqDeltaPos' 0.0#### s4 of { s5 ->
-    case sumPos of { (I## sumPos') ->
-    case writeDoubleArray## mba sumPos' 0.0#### s5 of { s6 ->
-    case minPos of { (I## minPos') ->
-    case writeDoubleArray## mba minPos' 0.0#### s6 of { s7 ->
-    case maxPos of { (I## maxPos') ->
-    case writeDoubleArray## mba maxPos' 0.0#### s7 of { s8 ->
-    (## s8, Distrib mba ##) }}}}}}}}}}}}}}}}
+    case newByteArray## (unI distribLen) s of { (## s1, mba ##) ->
+    -- probably unnecessary
+    case atomicWriteIntArray## mba (unI lockPos) 0## s1 of { s2 ->
+    case writeInt64Array mba (unI countPos) (intToInt64 0##) s2 of { s3 ->
+    case writeDoubleArray## mba (unI meanPos) 0.0#### s3 of { s4 ->
+    case writeDoubleArray## mba (unI sumSqDeltaPos) 0.0#### s4 of { s5 ->
+    case writeDoubleArray## mba (unI sumPos) 0.0#### s5 of { s6 ->
+    case writeDoubleArray## mba (unI minPos) 0.0#### s6 of { s7 ->
+    case writeDoubleArray## mba (unI maxPos) 0.0#### s7 of { s8 ->
+    (## s8, Distrib mba ##) }}}}}}}}
 
 newStripe :: IO Stripe
 newStripe = do
@@ -207,17 +203,14 @@ add distrib val = addN distrib val 1
 {-# INLINE spinLock #-}
 spinLock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld
 spinLock mba = \s ->
-    case lockPos of { (I## lockPos') ->
-    case casIntArray## mba lockPos' 0## 1## s of { (## s1, r ##) ->
+    case casIntArray## mba (unI lockPos) 0## 1## s of { (## s1, r ##) ->
     case r ==## 0## of { 0## ->
-    spinLock mba s1; _ -> s1 }}}
+    spinLock mba s1; _ -> s1 }}
 
 {-# INLINE spinUnlock #-}
 spinUnlock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld
 spinUnlock mba = \s ->
-    case lockPos of { (I## lockPos') ->
-    case writeIntArray## mba lockPos' 0## s of { s2 ->
-    s2 }}
+    case writeIntArray## mba (unI lockPos) 0## s of { s2 -> s2 }
 
 
 -- | Add the same value to the distribution N times.
@@ -228,32 +221,26 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
     case myStripe distribution of { (IO myStripe') ->
     case myStripe' s of { (## s1, (Stripe (Distrib mba)) ##) ->
     case spinLock mba s1 of { s2 ->
-    case countPos of { (I## countPos') ->
-    case readInt64Array mba countPos' s2 of { (## s3, count ##) ->
-    case meanPos of { (I## meanPos') ->
-    case readDoubleArray## mba meanPos' s3 of { (## s4, mean ##) ->
-    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
-    case readDoubleArray## mba sumSqDeltaPos' s4 of { (## s5, sumSqDelta ##) ->
-    case sumPos of { (I## sumPos') ->
-    case readDoubleArray## mba sumPos' s5 of { (## s6, dSum ##) ->
-    case minPos of { (I## minPos') ->
-    case readDoubleArray## mba minPos' s6 of { (## s7, dMin ##) ->
-    case maxPos of { (I## maxPos') ->
-    case readDoubleArray## mba maxPos' s7 of { (## s8, dMax ##) ->
+    case readInt64Array mba (unI countPos) s2 of { (## s3, count ##) ->
+    case readDoubleArray## mba (unI meanPos) s3 of { (## s4, mean ##) ->
+    case readDoubleArray## mba (unI sumSqDeltaPos) s4 of { (## s5, sumSqDelta ##) ->
+    case readDoubleArray## mba (unI sumPos) s5 of { (## s6, dSum ##) ->
+    case readDoubleArray## mba (unI minPos) s6 of { (## s7, dMin ##) ->
+    case readDoubleArray## mba (unI maxPos) s7 of { (## s8, dMax ##) ->
     case plusInt64 count n of { count' ->
     case val -#### mean of { delta ->
     case mean +#### ((int64ToDouble n) *#### delta /#### (int64ToDouble count')) of { mean' ->
     case sumSqDelta +#### (delta *#### (val -#### mean') *#### (int64ToDouble n)) of { sumSqDelta' ->
-    case writeInt64Array mba countPos' count' s8 of { s9 ->
-    case writeDoubleArray## mba meanPos' mean' s9 of { s10 ->
-    case writeDoubleArray## mba sumSqDeltaPos' sumSqDelta' s10 of { s11 ->
-    case writeDoubleArray## mba sumPos' (dSum +#### val) s11 of { s12 ->
+    case writeInt64Array mba (unI countPos) count' s8 of { s9 ->
+    case writeDoubleArray## mba (unI meanPos) mean' s9 of { s10 ->
+    case writeDoubleArray## mba (unI sumSqDeltaPos) sumSqDelta' s10 of { s11 ->
+    case writeDoubleArray## mba (unI sumPos) (dSum +#### val) s11 of { s12 ->
     case (case val <#### dMin of { 0## -> dMin; _ -> val }) of { dMin' ->
     case (case val >#### dMax of { 0## -> dMax; _ -> val }) of { dMax' ->
-    case writeDoubleArray## mba minPos' dMin' s12 of { s13 ->
-    case writeDoubleArray## mba maxPos' dMax' s13 of { s14 ->
+    case writeDoubleArray## mba (unI minPos) dMin' s12 of { s13 ->
+    case writeDoubleArray## mba (unI maxPos) dMax' s13 of { s14 ->
     case spinUnlock mba s14 of { s15 ->
-    (## s15, () ##) }}}}}}}}}}}}}}}}}}}}}}}}}}}}
+    (## s15, () ##) }}}}}}}}}}}}}}}}}}}}}}
 
 -- | Combine 'b' with 'a', writing the result in 'a'. Takes the lock of
 --   'b' while combining, but doesn't otherwise modify 'b'. 'a' is
@@ -263,20 +250,17 @@ addN distribution (D## val) (I64## n) = IO $ \s ->
 combine :: Distrib -> Distrib -> IO ()
 combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
     case spinLock bMBA s of { s1 ->
-    case countPos of { (I## countPos') ->
-    case readInt64Array aMBA countPos' s1 of { (## s2, aCount ##) ->
-    case readInt64Array bMBA countPos' s2 of { (## s3, bCount ##) ->
+    case readInt64Array aMBA (unI countPos) s1 of { (## s2, aCount ##) ->
+    case readInt64Array bMBA (unI countPos) s2 of { (## s3, bCount ##) ->
     case plusInt64 aCount bCount of { count' ->
-    case meanPos of { (I## meanPos' ) ->
-    case readDoubleArray## aMBA meanPos' s3 of { (## s4, aMean ##) ->
-    case readDoubleArray## bMBA meanPos' s4 of { (## s5, bMean ##) ->
+    case readDoubleArray## aMBA (unI meanPos) s3 of { (## s4, aMean ##) ->
+    case readDoubleArray## bMBA (unI meanPos) s4 of { (## s5, bMean ##) ->
     case bMean -#### aMean of { delta ->
     case (   (((int64ToDouble aCount) *#### aMean) +#### ((int64ToDouble bCount) *#### bMean))
          /#### (int64ToDouble count')
          ) of { mean' ->
-    case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
-    case readDoubleArray## aMBA sumSqDeltaPos' s5 of { (## s6, aSumSqDelta ##) ->
-    case readDoubleArray## bMBA sumSqDeltaPos' s6 of { (## s7, bSumSqDelta ##) ->
+    case readDoubleArray## aMBA (unI sumSqDeltaPos) s5 of { (## s6, aSumSqDelta ##) ->
+    case readDoubleArray## bMBA (unI sumSqDeltaPos) s6 of { (## s7, bSumSqDelta ##) ->
     case (   aSumSqDelta 
          +#### bSumSqDelta
          +#### (   delta
@@ -286,24 +270,21 @@ combine (Distrib bMBA) (Distrib aMBA) = IO $ \s ->
                      )
                )
          ) of { sumSqDelta' ->
-    case writeInt64Array aMBA countPos' count' s7 of { s8 ->
+    case writeInt64Array aMBA (unI countPos) count' s7 of { s8 ->
     case (case eqInt64 count' (intToInt64 0##) of { 0## -> mean'; _ -> 0.0#### }) of { writeMean ->
-    case writeDoubleArray## aMBA meanPos' writeMean s8 of { s9 ->
-    case writeDoubleArray## aMBA sumSqDeltaPos' sumSqDelta' s9 of { s10 ->
-    case sumPos of { (I## sumPos') ->
-    case readDoubleArray## aMBA sumPos' s10 of { (## s11, aSum ##) ->
-    case readDoubleArray## bMBA sumPos' s11 of { (## s12, bSum ##) ->
-    case writeDoubleArray## aMBA sumPos' (aSum +#### bSum) s12 of { s13 ->
-    case minPos of { (I## minPos') ->
-    case readDoubleArray## bMBA minPos' s13 of { (## s14, bMin ##) ->
-    case writeDoubleArray## aMBA minPos' bMin s14 of { s15 ->
-    case maxPos of { (I## maxPos') ->
+    case writeDoubleArray## aMBA (unI meanPos) writeMean s8 of { s9 ->
+    case writeDoubleArray## aMBA (unI sumSqDeltaPos) sumSqDelta' s9 of { s10 ->
+    case readDoubleArray## aMBA (unI sumPos) s10 of { (## s11, aSum ##) ->
+    case readDoubleArray## bMBA (unI sumPos) s11 of { (## s12, bSum ##) ->
+    case writeDoubleArray## aMBA (unI sumPos) (aSum +#### bSum) s12 of { s13 ->
+    case readDoubleArray## bMBA (unI minPos) s13 of { (## s14, bMin ##) ->
+    case writeDoubleArray## aMBA (unI minPos) bMin s14 of { s15 ->
     -- This is slightly hacky, but ok: see
     -- 813aa426be78e8abcf1c7cdd43433bcffa07828e
-    case readDoubleArray## bMBA maxPos' s15 of { (## s16, bMax ##) ->
-    case writeDoubleArray## aMBA maxPos' bMax s16 of { s17 ->
+    case readDoubleArray## bMBA (unI maxPos) s15 of { (## s16, bMax ##) ->
+    case writeDoubleArray## aMBA (unI maxPos) bMax s16 of { s17 ->
     case spinUnlock bMBA s17 of { s18 ->
-    (## s18, () ##) }}}}}}}}}}}}}}}}}}}}}}}}}}}}}
+    (## s18, () ##) }}}}}}}}}}}}}}}}}}}}}}}
 
 -- | Get the current statistical summary for the event being tracked.
 read :: Distribution -> IO Stats
@@ -312,18 +293,12 @@ read distrib = do
     forM_ (toList $ unD distrib) $ \(Stripe d) ->
         combine d result
     IO $ \s ->
-        case meanPos of { (I## meanPos') ->
-        case countPos of { (I## countPos') ->
-        case sumSqDeltaPos of { (I## sumSqDeltaPos') ->
-        case sumPos of { (I## sumPos') ->
-        case minPos of { (I## minPos') ->
-        case maxPos of { (I## maxPos') ->
-        case readInt64Array mba countPos' s of { (## s1, count ##) ->
-        case readDoubleArray## mba meanPos' s1 of { (## s2, mean ##) ->
-        case readDoubleArray## mba sumSqDeltaPos' s2 of { (## s3, sumSqDelta ##) ->
-        case readDoubleArray## mba sumPos' s3 of { (## s4, dSum ##) ->
-        case readDoubleArray## mba minPos' s4 of { (## s5, dMin ##) ->
-        case readDoubleArray## mba maxPos' s5 of { (## s6, dMax ##) ->
+        case readInt64Array mba (unI countPos) s of { (## s1, count ##) ->
+        case readDoubleArray## mba (unI meanPos) s1 of { (## s2, mean ##) ->
+        case readDoubleArray## mba (unI sumSqDeltaPos) s2 of { (## s3, sumSqDelta ##) ->
+        case readDoubleArray## mba (unI sumPos) s3 of { (## s4, dSum ##) ->
+        case readDoubleArray## mba (unI minPos) s4 of { (## s5, dMin ##) ->
+        case readDoubleArray## mba (unI maxPos) s5 of { (## s6, dMax ##) ->
         (## s6
         , Stats { mean = (D## mean)
                 , variance = if (I64## count) == 0 then 0.0
@@ -333,4 +308,4 @@ read distrib = do
                 , min = (D## dMin)
                 , max = (D## dMax)
                 }
-        ##) }}}}}}}}}}}}
+        ##) }}}}}}

From a89e220899e1017c683ebe245c0c29e5dcf77cf4 Mon Sep 17 00:00:00 2001
From: Travis Whitaker <pi.boy.travis@gmail.com>
Date: Thu, 19 Jun 2025 13:53:54 -0700
Subject: [PATCH 19/19] yield in spinLock unhappy path

---
 System/Metrics/Distribution.hsc | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/System/Metrics/Distribution.hsc b/System/Metrics/Distribution.hsc
index 7b6b5bc..46166b1 100644
--- a/System/Metrics/Distribution.hsc
+++ b/System/Metrics/Distribution.hsc
@@ -204,8 +204,9 @@ add distrib val = addN distrib val 1
 spinLock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld
 spinLock mba = \s ->
     case casIntArray## mba (unI lockPos) 0## 1## s of { (## s1, r ##) ->
-    case r ==## 0## of { 0## ->
-    spinLock mba s1; _ -> s1 }}
+    case r of { 0## -> s1; _ ->
+    case yield## s1 of { s2 ->
+    spinLock mba s2 }}}
 
 {-# INLINE spinUnlock #-}
 spinUnlock :: MutableByteArray## RealWorld -> State## RealWorld -> State## RealWorld