packages feed

unboxed-ref (empty) → 0.1.0.0

raw patch · 8 files changed

+321/−0 lines, 8 filesdep +basedep +ghc-primdep +primitivesetup-changed

Dependencies added: base, ghc-prim, primitive

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for unboxed-ref++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ Data/IORef/Unboxed.hs view
@@ -0,0 +1,125 @@+-----------------------------------------------------------------------------+---- |+---- Module      :  Data.IORef.Unboxed+---- Copyright   :  (c) Winter+---- License     :  BSD-style+----+---- Maintainer  :  drkoster@qq.com+---- Stability   :  experimental+---- Portability :  portable+----+---- Unboxed mutable references in the IO monad.+----+-------------------------------------------------------------------------------++{-# LANGUAGE MagicHash, UnboxedTuples #-}++module Data.IORef.Unboxed+  ( -- * Unboxed IO references+    IORefU+  , newIORefU+  , readIORefU+  , writeIORefU+  , modifyIORefU+    -- * Atomic operations for @IORefU Int@+  , Counter+  , newCounter+  , atomicAddCounter+  , atomicSubCounter+  , atomicAndCounter+  , atomicNandCounter+  , atomicOrCounter+  , atomicXorCounter+  ) where++import Data.Primitive.Types+import Data.Primitive.ByteArray+import GHC.Prim+import GHC.Types+import GHC.ST+import Control.Monad.ST.Unsafe (unsafeSTToIO)+import Data.STRef.Unboxed.Internal++-- | A mutable variable in the IO monad which can hold an instance of 'Prim'.+--+newtype IORefU a = IORefU (STRefU RealWorld a)++-- | Build a new 'IORefU'+--+newIORefU :: Prim a => a -> IO (IORefU a)+newIORefU init = IORefU `fmap` unsafeSTToIO (newSTRefU init)+{-# INLINE newIORefU #-}++-- | Read the value of an 'IORefU'+--+readIORefU :: Prim a => IORefU a -> IO a+readIORefU (IORefU stRefU) = unsafeSTToIO (readSTRefU stRefU)+{-# INLINE readIORefU #-}++-- | Write a new value into an 'IORefU'+--+writeIORefU :: Prim a => IORefU a -> a -> IO ()+writeIORefU (IORefU stRefU) x = unsafeSTToIO (writeSTRefU stRefU x)+{-# INLINE writeIORefU #-}++-- | Mutate the contents of an 'IORef'.+--+--  Unboxed reference is always strict on the value it hold.+--+modifyIORefU :: Prim a => IORefU a -> (a -> a) -> IO ()+modifyIORefU ref f = readIORefU ref >>= writeIORefU ref . f+{-# INLINE modifyIORefU #-}++-- | Alias for 'IORefU Int' which support several atomic operations.+--+type Counter = IORefU Int++-- | Build a new 'Counter'+--+newCounter :: Int -> IO Counter+newCounter = newIORefU+{-# INLINE newCounter #-}++-- | Atomically add a 'Counter', return the value AFTER added.+--+-- It's implemented using fetch-and-add primitive, which is much faster than a CAS loop(@atomicModifyIORef@).+--+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#)) #)+{-# 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#)) #)+{-# 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 +# x#)) #)+{-# 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# (res +# x#)) #)+{-# 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 +# x#)) #)+{-# 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 +# x#)) #)+{-# INLINE atomicXorCounter #-}
+ Data/STRef/Unboxed.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+---- |+---- Module      :  Data.STRef.Unboxed+---- Copyright   :  (c) Winter+---- License     :  BSD-style+----+---- Maintainer  :  drkoster@qq.com+---- Stability   :  experimental+---- Portability :  portable+----+---- Unboxed mutable references in the /strict/ ST monad.+----+-------------------------------------------------------------------------------++{-# LANGUAGE MagicHash #-}++module Data.STRef.Unboxed+  ( -- * Unboxed ST references+    STRefU+  , newSTRefU+  , readSTRefU+  , writeSTRefU+  , modifySTRefU+  ) where++import Data.STRef.Unboxed.Internal
+ Data/STRef/Unboxed/Internal.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+---- |+---- Module      :  Data.STRef.Unboxed.Internal+---- Copyright   :  (c) Winter+---- License     :  BSD-style+----+---- Maintainer  :  drkoster@qq.com+---- Stability   :  experimental+---- Portability :  portable+----+---- Unboxed mutable references in the /strict/ ST monad.+----+-------------------------------------------------------------------------------++{-# LANGUAGE MagicHash #-}++module Data.STRef.Unboxed.Internal+  ( -- * Unboxed ST references+    STRefU(..)+  , newSTRefU+  , readSTRefU+  , writeSTRefU+  , modifySTRefU+  ) where++import Data.Primitive.Types+import Data.Primitive.ByteArray+import GHC.Prim+import GHC.ST+import GHC.Types++-- | A mutable variable in the ST monad which can hold an instance of 'Prim'.+--+data STRefU s a = STRefU {-# UNPACK #-} !(MutableByteArray s)++-- | Build a new 'STRefU'+--+newSTRefU :: Prim a => a -> ST s (STRefU s a)+newSTRefU init = do+     mba <- newByteArray (I# (sizeOf# init))+     writeByteArray mba 0 init+     return (STRefU mba)+{-# INLINE newSTRefU #-}++-- | Read the value of an 'STRefU'+--+readSTRefU :: Prim a => STRefU s a -> ST s a+readSTRefU (STRefU mba) = readByteArray mba 0+{-# INLINE readSTRefU #-}++-- | Write a new value into an 'STRefU'+--+writeSTRefU :: Prim a => STRefU s a -> a -> ST s ()+writeSTRefU (STRefU mba) x = writeByteArray mba 0 x+{-# INLINE writeSTRefU #-}++-- | Mutate the contents of an 'STRefU'.+--+--  Unboxed reference is always strict on the value it hold.+--+modifySTRefU :: Prim a => STRefU s a -> (a -> a) -> ST s ()+modifySTRefU ref f = readSTRefU ref >>= writeSTRefU ref . f+{-# INLINE modifySTRefU #-}
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, winter++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 winter nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,44 @@+unboxed-ref+===========++[![Hackage](https://img.shields.io/hackage/v/unboxed-ref.svg?style=flat)](http://hackage.haskell.org/package/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).++A simple diagram could show the difference between `IORef Int` with `IORefU Int`:++```+data Foo = Foo {-# UNPACK #-} (IORef Int)++        +-----------+    +-------------+    +---------++        | Foo |  *  +--->+ MutVar# | * +--->+ I# | i# |+        +-----------+    +-------------+    +---------+++data Bar = Bar {-# UNPACK #-} (IORefU Int)++        +-----------+    +------------------------++        | Bar |  *  +--->+ MutableByteArray# | i# |+        +-----------+    +------------------------++```++Benchmark+---------++Modified from [this benchmark](https://marcotmarcot.wordpress.com/2010/03/13/performance-of-ioref/).++```bash+$ cd bench && cabal build+$ time ./dist/build/bench-ref/bench-ref+143+./dist/build/bench-ref/bench-ref  19.76s user 0.02s system 99% cpu 19.785 total+------------------------------------------------------------+$ time ./dist/build/bench-unboxed-ref/bench-unboxed-ref+143+./dist/build/bench-unboxed-ref/bench-unboxed-ref  16.66s user 0.02s system 99% cpu 16.694 total+------------------------------------------------------------+$ ./dist/build/bench-unboxed-ref-atomic/bench-unboxed-ref-atomic+50500000+------------------------------------------------------------+$ ./dist/build/bench-ref-atomic/bench-ref-atomic+3597361+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ unboxed-ref.cabal view
@@ -0,0 +1,26 @@+name:                unboxed-ref+version:             0.1.0.0+synopsis:            Fast unboxed references for ST and IO monad+description:         Fast unboxed references for ST and IO monad+license:             BSD3+license-file:        LICENSE+author:              winter+maintainer:          drkoster@qq.com+copyright:           Copyright (c) Winter 2017+category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md +                     README.md+cabal-version:       >=1.10++library+    exposed-modules:     Data.IORef.Unboxed+                         Data.STRef.Unboxed+    other-modules:       Data.STRef.Unboxed.Internal+    -- other-extensions:    +    build-depends:       base >=4.8 && <5.0+                     ,   ghc-prim >=0.4+                     ,   primitive++    -- hs-source-dirs:      +    default-language:    Haskell2010