remove atomic-primops dependency

.gitignore

@@ -1,5 +1,6 @@
 .envrc
 .ghc.environment.*
+Session.vim
 cabal.project.local
-dist/
 dist-newstyle/
+dist/

CHANGELOG.md

@@ -1,3 +1,7 @@
+## Unreleased
+
+- Remove `atomic-primops` dependency
+
 ## [0.4.0.1] - 2022-11-05
 
 - Fix inaccurate haddock on `recurring`

src/TimerWheel.hs

@@ -26,8 +26,7 @@ import TimerWheel.Internal.Config (Config)
 import qualified TimerWheel.Internal.Config as Config
 import TimerWheel.Internal.Micros (Micros (Micros))
 import qualified TimerWheel.Internal.Micros as Micros
-import TimerWheel.Internal.Supply (Supply)
-import qualified TimerWheel.Internal.Supply as Supply
+import TimerWheel.Internal.Supply (Counter, incrCounter, newCounter)
 import TimerWheel.Internal.Wheel (Wheel)
 import qualified TimerWheel.Internal.Wheel as Wheel
 
@@ -88,7 +87,7 @@ import qualified TimerWheel.Internal.Wheel as Wheel
 -- @
 data TimerWheel = TimerWheel
   { -- | A supply of unique ints.
-    supply :: {-# UNPACK #-} !Supply,
+    supply :: {-# UNPACK #-} !Counter,
     -- | The array of collections of timers.
     wheel :: {-# UNPACK #-} !Wheel
     -- thread :: {-# UNPACK #-} !ThreadId
@@ -103,7 +102,7 @@ create :: Ki.Scope -> Config -> IO TimerWheel
 create scope config = do
   validateConfig config
   wheel <- Wheel.create (Config.spokes config) (Micros.fromFixed (Config.resolution config))
-  supply <- Supply.new
+  supply <- newCounter
   Ki.fork_ scope (Wheel.reap wheel)
   pure TimerWheel {supply, wheel}
 
@@ -154,7 +153,7 @@ register_ wheel delay action = do
 
 registerImpl :: TimerWheel -> Micros -> IO () -> IO (IO Bool)
 registerImpl TimerWheel {supply, wheel} delay action = do
-  key <- Supply.next supply
+  key <- incrCounter supply
   Wheel.insert wheel key delay action
 
 -- | @recurring wheel action delay@ registers an action __@action@__ in timer wheel __@wheel@__ to fire every

src/TimerWheel/Internal/Supply.hs

@@ -1,21 +1,57 @@
+-- Some code modified from the atomic-primops library; license included below.
+--
+-- Copyright (c)2012-2013, Ryan R. Newton
+--
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are met:
+--
+--     * Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     * Redistributions in binary form must reproduce the above
+--       copyright notice, this list of conditions and the following
+--       disclaimer in the documentation and/or other materials provided
+--       with the distribution.
+--
+--     * Neither the name of Ryan R. Newton nor the names of other
+--       contributors may be used to endorse or promote products derived
+--       from this software without specific prior written permission.
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 module TimerWheel.Internal.Supply
-  ( Supply,
-    new,
-    next,
+  ( Counter,
+    newCounter,
+    incrCounter,
   )
 where
 
-import Data.Atomics.Counter (AtomicCounter, incrCounter, newCounter)
-import Data.Coerce (coerce)
+import Data.Bits
+import GHC.Base
 
-newtype Supply
-  = Supply AtomicCounter
+-- | A thread-safe counter implemented with atomic fetch-and-add.
+data Counter
+  = Counter (MutableByteArray# RealWorld)
 
-new :: IO Supply
-new =
-  coerce (newCounter 0)
+-- | Create a new counter initialized to 0.
+newCounter :: IO Counter
+newCounter =
+  IO \s0# ->
+    case newByteArray# size s0# of
+      (# s1#, arr# #) ->
+        case writeIntArray# arr# 0# 0# s1# of
+          s2# -> (# s2#, Counter arr# #)
+  where
+    !(I# size) =
+      finiteBitSize (undefined :: Int) `div` 8
+{-# INLINE newCounter #-}
 
-next :: Supply -> IO Int
-next =
-  coerce (incrCounter 1)
-{-# INLINE next #-}
+-- | Increment a counter and return the value prior to incrementing.
+incrCounter :: Counter -> IO Int
+incrCounter (Counter arr#) =
+  IO \s0# ->
+    case fetchAddIntArray# arr# 0# 1# s0# of
+      (# s1#, n# #) -> (# s1#, I# n# #)
+{-# INLINE incrCounter #-}

test/Main.hs

@@ -68,11 +68,10 @@ main = do
           takeMVar var
           throwIO (userError "fail")
       )
-      ( \ex ->
-          case fromException ex of
-            Just Bye -> pure ()
-            _ -> throwIO ex
-      )
+      \ex ->
+        case fromException ex of
+          Just Bye -> pure ()
+          _ -> throwIO ex
 
 data Bye = Bye
   deriving stock (Show)

timer-wheel.cabal

@@ -36,12 +36,12 @@ source-repository head
 library
   build-depends:
     array ^>= 0.5.2.0,
-    atomic-primops ^>= 0.8,
     base ^>= 4.12 || ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 || ^>= 4.18,
     ki ^>= 1.0.0,
     psqueues ^>= 0.2.7
 
   default-extensions:
+    BangPatterns
     BlockArguments
     DeriveAnyClass
     DeriveGeneric