summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorwinterland <>2017-07-17 09:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-07-17 09:46:00 (GMT)
commit42bdf88e2bc1a0d95f79e3f3e30930810d0c4672 (patch)
tree56fe2783b02480cbb97cccc01300d24f8b570f23
parentc7472354f6334b3f44a48ebb5c82f89a61c3ffd8 (diff)
version 0.4.0.0HEAD0.4.0.0master
-rw-r--r--ChangeLog.md4
-rw-r--r--Data/IORef/Unboxed.hs74
-rw-r--r--README.md1
-rw-r--r--test/Main.hs45
-rw-r--r--unboxed-ref.cabal19
5 files changed, 134 insertions, 9 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index eaefc95..52aee79 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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.
diff --git a/Data/IORef/Unboxed.hs b/Data/IORef/Unboxed.hs
index e9a72c4..0ccb3d0 100644
--- a/Data/IORef/Unboxed.hs
+++ b/Data/IORef/Unboxed.hs
@@ -30,6 +30,12 @@ module Data.IORef.Unboxed
, atomicNandCounter
, atomicOrCounter
, atomicXorCounter
+ , atomicAddCounter_
+ , atomicSubCounter_
+ , atomicAndCounter_
+ , atomicNandCounter_
+ , atomicOrCounter_
+ , atomicXorCounter_
) where
import Data.Primitive.Types
@@ -86,40 +92,96 @@ newCounter = newIORefU
--
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_ #-}
diff --git a/README.md b/README.md
index 1c69f07..1e98828 100644
--- a/README.md
+++ b/README.md
@@ -2,6 +2,7 @@ unboxed-ref
===========
[![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).
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
index 0000000..790c9fd
--- /dev/null
+++ b/test/Main.hs
@@ -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'
diff --git a/unboxed-ref.cabal b/unboxed-ref.cabal
index e500b37..236f5b6 100644
--- a/unboxed-ref.cabal
+++ b/unboxed-ref.cabal
@@ -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 @@ cabal-version: >=1.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 @@ library
-- 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