unboxed-ref 0.3.0.0 → 0.4.0.0

raw patch · 5 files changed

+134/−9 lines, 5 filesdep +HUnitdep +asyncdep +unboxed-refdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, async, unboxed-ref

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +2/−2
• Data/IORef/Unboxed.hs +68/−6
• README.md +1/−0
• test/Main.hs +45/−0
• unboxed-ref.cabal +18/−1

@@ -1,5 +1,5 @@ # Revision history for unboxed-ref -## 0.1.0.0  -- YYYY-mm-dd+## 0.4.0.0  -- 2017-07-17 -* First version. Released on an unsuspecting world.+* Add atomic operations which return old value, which is useful for building concurrent control structures.

@@ -30,6 +30,12 @@   , atomicNandCounter   , atomicOrCounter   , atomicXorCounter+  , atomicAddCounter_+  , atomicSubCounter_+  , atomicAndCounter_+  , atomicNandCounter_+  , atomicOrCounter_+  , atomicXorCounter_   ) where  import Data.Primitive.Types@@ -86,40 +92,96 @@ -- atomicAddCounter :: Counter -> Int -> IO Int atomicAddCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchAddIntArray# mba# 0# x# s1# in (# s2#, (I# (res +# x#)) #)+    let (# s2#, res# #) = fetchAddIntArray# mba# 0# x# s1# in (# s2#, (I# (res# +# x#)) #) {-# INLINE atomicAddCounter #-} +-- | Atomically add a 'Counter', return the value BEFORE added.+--+-- @since 0.4.0.0+--+atomicAddCounter_ :: Counter -> Int -> IO Int+atomicAddCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchAddIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicAddCounter_ #-}+ -- | Atomically sub a 'Counter', return the value AFTER subbed. -- atomicSubCounter :: Counter -> Int -> IO Int atomicSubCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchSubIntArray# mba# 0# x# s1# in (# s2#, (I# (res -# x#)) #)+    let (# s2#, res# #) = fetchSubIntArray# mba# 0# x# s1# in (# s2#, (I# (res# -# x#)) #) {-# INLINE atomicSubCounter #-} +-- | Atomically sub a 'Counter', return the value BEFORE subbed.+--+-- @since 0.4.0.0+--+atomicSubCounter_ :: Counter -> Int -> IO Int+atomicSubCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchSubIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicSubCounter_ #-}+ -- | Atomically and a 'Counter', return the value AFTER anded. -- atomicAndCounter :: Counter -> Int -> IO Int atomicAndCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchAndIntArray# mba# 0# x# s1# in (# s2#, (I# (res `andI#` x#)) #)+    let (# s2#, res# #) = fetchAndIntArray# mba# 0# x# s1# in (# s2#, (I# (res# `andI#` x#)) #) {-# INLINE atomicAndCounter #-} +-- | Atomically and a 'Counter', return the value BEFORE anded.+--+-- You can leverage idempotence of anding zero to make a concurrent resource lock.+--+-- @since 0.4.0.0+--+atomicAndCounter_ :: Counter -> Int -> IO Int+atomicAndCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchAndIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicAndCounter_ #-}+ -- | Atomically nand a 'Counter', return the value AFTER nanded. -- atomicNandCounter :: Counter -> Int -> IO Int atomicNandCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchNandIntArray# mba# 0# x# s1# in (# s2#, (I# (notI# (res `andI#` x#))) #)+    let (# s2#, res# #) = fetchNandIntArray# mba# 0# x# s1# in (# s2#, (I# (notI# (res# `andI#` x#))) #) {-# INLINE atomicNandCounter #-} +-- | Atomically nand a 'Counter', return the value BEFORE nanded.+--+-- @since 0.4.0.0+--+atomicNandCounter_ :: Counter -> Int -> IO Int+atomicNandCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchNandIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicNandCounter_ #-}+ -- | Atomically or a 'Counter', return the value AFTER ored. -- atomicOrCounter :: Counter -> Int -> IO Int atomicOrCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchOrIntArray# mba# 0# x# s1# in (# s2#, (I# (res `orI#` x#)) #)+    let (# s2#, res# #) = fetchOrIntArray# mba# 0# x# s1# in (# s2#, (I# (res# `orI#` x#)) #) {-# INLINE atomicOrCounter #-} +-- | Atomically or a 'Counter', return the value BEFORE ored.+--+-- @since 0.4.0.0+--+atomicOrCounter_ :: Counter -> Int -> IO Int+atomicOrCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchOrIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicOrCounter_ #-}+ -- | Atomically xor a 'Counter', return the value AFTER xored. -- atomicXorCounter :: Counter -> Int -> IO Int atomicXorCounter (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->-    let (# s2#, res #) = fetchXorIntArray# mba# 0# x# s1# in (# s2#, (I# (res `xorI#` x#)) #)+    let (# s2#, res# #) = fetchXorIntArray# mba# 0# x# s1# in (# s2#, (I# (res# `xorI#` x#)) #) {-# INLINE atomicXorCounter #-}++-- | Atomically xor a 'Counter', return the value BEFORE xored.+--+-- @since 0.4.0.0+--+atomicXorCounter_ :: Counter -> Int -> IO Int+atomicXorCounter_ (IORefU (STRefU (MutableByteArray mba#))) (I# x#) = IO $ \ s1# ->+    let (# s2#, res# #) = fetchXorIntArray# mba# 0# x# s1# in (# s2#, (I# res#) #)+{-# INLINE atomicXorCounter_ #-}

@@ -2,6 +2,7 @@ ===========  [![Hackage](https://img.shields.io/hackage/v/unboxed-ref.svg?style=flat)](http://hackage.haskell.org/package/unboxed-ref)+[![Test Status](https://img.shields.io/travis/winterland1989/unboxed-ref.svg)](https://travis-ci.org/winterland1989/unboxed-ref)  This package provide fast unboxed references for `ST` and `IO` monad and atomic operations for `IORefU Int` type. Unboxed reference is implemented using single cell `MutableByteArray s` to eliminate indirection overhead which `MutVar# s a` carry, on the otherhand unboxed reference only support limited type(instances of `Prim` class). 

@@ -0,0 +1,45 @@+import Test.HUnit+import System.Exit+import Data.IORef.Unboxed+import Control.Concurrent.Async+import Control.Monad++main :: IO ()+main = do+    counts2 <- runTestTT . TestList . take 30 . cycle $ -- run 10 times+        [ TestLabel "fetchAndAndTest" fetchAndAndTest+        , TestLabel "fetchAndOrTest" fetchAndOrTest+        , TestLabel "fetchAndAddTest" fetchAndAddTest+        ]+    if (errors counts2 + failures counts2 == 0)+        then exitSuccess+        else exitFailure++fetchAndAndTest :: Test+fetchAndAndTest = TestCase $ do+    c <- newCounter 1+    r <- newCounter 0+    replicateConcurrently_ 10000 $ do+        c' <- atomicAndCounter_ c 0+        when (c' == 1) (void $ atomicAddCounter r 1)+    r' <- readIORefU r+    assertEqual "fetchAndAnd zero should be idempotent" 1 r'+++fetchAndOrTest :: Test+fetchAndOrTest = TestCase $ do+    c <- newCounter 0+    r <- newCounter 0+    replicateConcurrently_ 10000 $ do+        c' <- atomicOrCounter_ c 1+        when (c' == 0) (void $ atomicAddCounter r 1)+    r' <- readIORefU r+    assertEqual "fetchAndOr zero should be idempotent" 1 r'++fetchAndAddTest :: Test+fetchAndAddTest = TestCase $ do+    r <- newCounter 0+    replicateConcurrently_ 10000 $ do+        atomicAddCounter_ r 1+    r' <- readIORefU r+    assertEqual "fetchAndAdd should be atomic" 10000 r'

@@ -1,5 +1,5 @@ name:                unboxed-ref-version:             0.3.0.0+version:             0.4.0.0 synopsis:            Fast unboxed references for ST and IO monad description:         Fast unboxed references for ST and IO monad license:             BSD3@@ -15,6 +15,10 @@ homepage:            https://github.com/winterland1989/unboxed-ref bug-reports:         https://github.com/winterland1989/unboxed-ref/issues +source-repository head+  type:     git+  location: git://github.com/winterland1989/unboxed-ref.git+ library     exposed-modules:     Data.IORef.Unboxed                          Data.STRef.Unboxed@@ -26,3 +30,16 @@      -- hs-source-dirs:           default-language:    Haskell2010++test-suite tests+    type: exitcode-stdio-1.0+    main-is: Main.hs+    hs-source-dirs: test+    build-depends:+        base == 4.*,+        unboxed-ref,+        async,+        HUnit+    -- other-modules:+    default-language: Haskell2010+    ghc-options: -Wall