CounterArray based on `fetchAddIntArray#`

gistfile1.hs

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}

module RingCounter
    ( CounterArray
    , newCounterArray
    , sizeofCounterArray
    , readCounterArray
    , writeCounterArray
    , fetchAddCounterArray
    ) where

import GHC.Exts
import GHC.Types

#include "MachDeps.h"

data CounterArray = CA !(MutableByteArray# RealWorld)

newCounterArray :: Word -> IO CounterArray
newCounterArray n = IO $ \s -> case newByteArray# sz# s of
    (# s', mba# #) -> case setByteArray# mba# 0# sz# 0# s' of
        !s'' -> (# s'', CA mba# #)
  where
    !(I# sz#) = SIZEOF_HSWORD * (fromIntegral n)

sizeofCounterArray :: CounterArray -> Word
sizeofCounterArray (CA mba#) = W# (int2Word# (sizeofMutableByteArray# mba#)) `quot` SIZEOF_HSWORD

readCounterArray :: CounterArray -> Word -> IO Int
readCounterArray (CA mba#) ix = IO $ \s -> case readIntArray# mba# ix# s of
    (# s', i# #) -> (# s', I# i# #)
  where
    !(I# ix#) = fromIntegral $ ix `rem` sizeofCounterArray (CA mba#)

writeCounterArray :: CounterArray -> Word -> Int -> IO ()
writeCounterArray (CA mba#) ix (I# i#) = IO $ \s -> case writeIntArray# mba# ix# i# s of
    !s' -> (# s', () #)
  where
    !(I# ix#) = fromIntegral $ ix `rem` sizeofCounterArray (CA mba#)

fetchAddCounterArray :: CounterArray -> Word -> Int -> IO Int
fetchAddCounterArray (CA mba#) ix (I# i#) = IO $ \s -> case fetchAddIntArray# mba# ix# i# s of
    (# !s', i'# #) -> (# s', I# i'# #)
  where
    !(I# ix#) = fromIntegral $ ix `rem` sizeofCounterArray (CA mba#)