mutable-containers-0.3.2/0000755000000000000000000000000012563022550013476 5ustar0000000000000000mutable-containers-0.3.2/ChangeLog.md0000644000000000000000000000125512563022550015652 0ustar0000000000000000## 0.3.2 * Export IOPRef, IOSRef, IOBRef [#5](https://github.com/fpco/mutable-containers/pull/5) ## 0.3.1 * Export IOURef [#4](https://github.com/fpco/mutable-containers/pull/4) ## 0.3.0 * Rename `DList` to `DLList` to avoid conflict with difference lists ## 0.2.1.2 * `Deque` optimizations by avoiding modulus operations completely. ## 0.2.1.1 * Fix a bug in `Deque`'s new vector allocation/copy code. ## 0.2.1 * Export `Prim`, `Unbox` and `Storable` * `SRef` uses `ForeignPtr` directly (slightly more efficient) ## 0.2.0 * Restructure under the Data.Mutable module. ## 0.1.2.0 * Added PRef ## 0.1.1.0 * Added reference benchmark. * Added boxed deque and references. mutable-containers-0.3.2/mutable-containers.cabal0000644000000000000000000000437712563022550020271 0ustar0000000000000000name: mutable-containers version: 0.3.2 synopsis: Abstactions and concrete implementations of mutable containers description: See docs and README at homepage: https://github.com/fpco/mutable-containers license: MIT license-file: LICENSE author: Michael Snoyman maintainer: michael@fpcomplete.com category: Data build-type: Simple extra-source-files: README.md ChangeLog.md cabal-version: >=1.10 library exposed-modules: Data.Mutable other-modules: Data.Mutable.SRef Data.Mutable.Class Data.Mutable.URef Data.Mutable.PRef Data.Mutable.BRef Data.Mutable.DLList Data.Mutable.Deque build-depends: base >= 4.7 && < 5 , primitive >= 0.5.2.1 , containers , vector , mono-traversable , ghc-prim default-language: Haskell2010 ghc-options: -O2 test-suite test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs build-depends: base , mutable-containers , hspec , QuickCheck , vector , primitive , containers default-language: Haskell2010 benchmark deque type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: deque.hs build-depends: base , mutable-containers , criterion , containers ghc-options: -Wall -O2 -rtsopts default-language: Haskell2010 benchmark ref type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: ref.hs build-depends: base , mutable-containers , criterion ghc-options: -Wall -O2 -rtsopts default-language: Haskell2010 source-repository head type: git location: git://github.com/fpco/mutable-containers.git mutable-containers-0.3.2/LICENSE0000644000000000000000000000204312563022550014502 0ustar0000000000000000Copyright (c) 2015 Michael Snoyman Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. mutable-containers-0.3.2/README.md0000644000000000000000000002372412563022550014765 0ustar0000000000000000[![Coverage Status](https://img.shields.io/coveralls/fpco/mutable-containers.svg)](https://coveralls.io/r/fpco/mutable-containers) ![Travis Build Status](https://travis-ci.org/fpco/mutable-containers.svg) One of Haskell's strengths is immutable data structures. These structures make it easier to reason about code, simplify concurrency and parallelism, and in some cases can improve performance by allowing sharing. However, there are still classes of problems where mutable data structures can both be more convenient, and provide a performance boost. This library is meant to provide such structures in a performant, well tested way. It also provides a simple abstraction over such data structures via typeclasses. Before anything else, let me provide the caveats of this package: * Don't use this package unless you have a good reason to! Immutable data structures are a better approach most of the time! * This code is intentionally *not* multithread safe. If you need something like a concurrent queue, there are many options on Hackage, from `Chan` to `TChan`, to [chaselev-deque](http://hackage.haskell.org/package/chaselev-deque). We'll first talk about the general approach to APIs in this package. Next, there are two main sets of abstractions provided, which we'll cover in the following two sections, along with their concrete implementations. Finally, we'll cover benchmarks. ## API structure The API takes heavy advantage of the `PrimMonad` typeclass from the primitive package. This allows our data structures to work in both `IO` and `ST` code. Each data structure has an associated type, `MCState`, which gives the primitive state for that structure. For example, in the case of `IORef`, that state is `RealWorld`, whereas for `STRef s`, it would be `s`. This associated type is quite similar to the `PrimState` associated type from primitive, and in many type signatures you'll see an equality constraint along the lines of: ```haskell PrimState m ~ MCState c ``` For those who are wondering, `MCState` stands for "mutable container state." All actions are part of a typeclass, which allows for generic access to different types of structures quite easily. In addition, we provide type hint functions, such as `asIORef`, which can help specify types when using such generic functions. For example, a common idiom might be: ```haskell ioref <- fmap asIORef $ newRef someVal ``` Wherever possible, we stick to well accepted naming and type signature standards. For example, note how closely `modifyRef` and `modifyRef'` match `modifyIORef` and `modifyIORef'`. ## Single cell references The base package provides both `IORef` and `STRef` as boxed mutable references, for storing a single value. The primitive package also provides `MutVar`, which generalizes over both of those and works for any `PrimMonad` instance. The `MutableRef` typeclass in this package abstracts over all three of those. It has two associated types: `MCState` for the primitive state, and `RefElement` to specify what is contained by the reference. You may be wondering: why not just take the reference as a type parameter? That wouldn't allow us to have monomorphic reference types, which may be useful under some circumstances. This is a similar motivation to how the `mono-traversable` package works. In addition to providing an abstraction over `IORef`, `STRef`, and `MutVar`, this package provides four additional single-cell mutable references. `URef`, `SRef`, and `BRef` all contain a 1-length mutable vector under the surface, which is unboxed, storable, and boxed, respectively. The advantage of the first two over boxed standard boxed references is that it can avoid a significant amount of allocation overhead. See [the relevant Stack Overflow discussion](http://stackoverflow.com/questions/27261813/why-is-my-little-stref-int-require-allocating-gigabytes) and the benchmarks below. While `BRef` doesn't give this same advantage (since the values are still boxed), it was trivial to include it along with the other two, and does actually demonstrate a performance advantage. Unlike `URef` and `SRef`, there is no restriction on the type of value it can store. The final reference type is `PRef`. Unlike the other three mentioned, it doesn't use vectors at all, but instead drops down directly to a mutable bytearray to store values. This means it has slightly less overhead (no need to store the size of the vector), but also restricts the types of things that can be stored (only instances of `Prim`). You should benchmark your program to determine the most efficient reference type, but generally speaking `PRef` will be most performant, followed by `URef` and `SRef`, and finally `BRef`. ## Collections Collections allow you to push and pop values to the beginning and end of themselves. Since different data structures allow different operations, each operation goes into its own typeclass, appropriately named `MutablePushFront`, `MutablePushBack`, `MutablePopFront`, and `MutablePopBack`. There is also a parent typeclass `MutableCollection` which provides: 1. The `CollElement` associated type to indicate what kinds of values are in the collection. 2. The `newColl` function to create a new, empty collection. The `mono-traversable` package provides a typeclass `IsSequence` which abstracts over sequence-like things. In particular, it provides operations for `cons`, `snoc`, `uncons`, and `unsnoc`. Using this abstraction, we can provide an instance for all of the typeclasses listed above for any mutable reference containing an instance of `IsSequence`, e.g. `IORef [Int]` or `BRef s (Seq Double)`. Note that the performance of some of these combinations is *terrible*. In particular, `pushBack` or `popBack` on a list requires traversing the entire list, and any push operations on a `Vector` requires copying the entire contents of the vector. Caveat emptor! If you *must* use one of these structures, it's highly recommended to use `Seq`, which gives the best overall performance. However, in addition to these instances, this package also provides two additional data structures: double-ended queues and doubly-linked lists. The former is based around mutable vectors, and therefore as unboxed (`UDeque`), storable (`SDeque`), and boxed (`BDeque`) variants. Doubly-linked lists have no such variety, and are simply `DList`s. For general purpose queue-like structures, `UDeque` or `SDeque` is likely to give you best performance. As usual, benchmark your own program to be certain, and see the benchmark results below. ## Benchmark results The following benchmarks were performed on January 7, 2015, against version 0.2.0. ### Ref benchmark ``` benchmarking IORef time 4.322 μs (4.322 μs .. 4.323 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 4.322 μs (4.322 μs .. 4.323 μs) std dev 1.401 ns (1.114 ns .. 1.802 ns) benchmarking STRef time 4.484 μs (4.484 μs .. 4.485 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 4.484 μs (4.484 μs .. 4.484 μs) std dev 941.0 ps (748.5 ps .. 1.164 ns) benchmarking MutVar time 4.482 μs (4.482 μs .. 4.483 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 4.482 μs (4.482 μs .. 4.483 μs) std dev 843.2 ps (707.9 ps .. 1.003 ns) benchmarking URef time 2.020 μs (2.019 μs .. 2.020 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 2.020 μs (2.019 μs .. 2.020 μs) std dev 955.2 ps (592.2 ps .. 1.421 ns) benchmarking PRef time 2.015 μs (2.014 μs .. 2.015 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 2.014 μs (2.014 μs .. 2.015 μs) std dev 901.3 ps (562.8 ps .. 1.238 ns) benchmarking SRef time 2.231 μs (2.230 μs .. 2.232 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 2.231 μs (2.230 μs .. 2.231 μs) std dev 1.938 ns (1.589 ns .. 2.395 ns) benchmarking BRef time 4.279 μs (4.279 μs .. 4.279 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 4.279 μs (4.279 μs .. 4.279 μs) std dev 1.281 ns (1.016 ns .. 1.653 ns) ``` ### Deque benchmark ``` time 8.371 ms (8.362 ms .. 8.382 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 8.386 ms (8.378 ms .. 8.398 ms) std dev 29.25 μs (20.73 μs .. 42.47 μs) benchmarking IORef (Seq Int) time 142.9 μs (142.7 μs .. 143.1 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 142.7 μs (142.6 μs .. 142.9 μs) std dev 542.8 ns (426.5 ns .. 697.0 ns) benchmarking UDeque time 107.5 μs (107.4 μs .. 107.6 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 107.5 μs (107.4 μs .. 107.6 μs) std dev 227.4 ns (171.8 ns .. 297.8 ns) benchmarking SDeque time 97.82 μs (97.76 μs .. 97.89 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 97.82 μs (97.78 μs .. 97.89 μs) std dev 169.5 ns (110.6 ns .. 274.5 ns) benchmarking BDeque time 113.5 μs (113.4 μs .. 113.6 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 113.6 μs (113.5 μs .. 113.7 μs) std dev 300.4 ns (221.8 ns .. 424.1 ns) benchmarking DList time 156.5 μs (156.3 μs .. 156.6 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 156.4 μs (156.3 μs .. 156.6 μs) std dev 389.5 ns (318.3 ns .. 502.8 ns) ``` ## Test coverage As of version 0.2.0, this package has 100% test coverage. If you look at the report yourself, you'll see some uncovered code; it's just the automatically derived `Show` instance needed for QuickCheck inside the test suite itself. mutable-containers-0.3.2/Setup.hs0000644000000000000000000000005612563022550015133 0ustar0000000000000000import Distribution.Simple main = defaultMain mutable-containers-0.3.2/test/0000755000000000000000000000000012563022550014455 5ustar0000000000000000mutable-containers-0.3.2/test/Spec.hs0000644000000000000000000001514412563022550015710 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} import Control.Monad (forM_) import Data.Mutable import Data.Sequence (Seq) import Data.Vector (Vector) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen main :: IO () main = hspec spec data RefAction = WriteRef Int | ModifyRef Int | ModifyRef' Int | AtomicModifyRef Int | AtomicModifyRef' Int deriving Show instance Arbitrary RefAction where arbitrary = oneof [ fmap WriteRef arbitrary , fmap ModifyRef arbitrary , fmap ModifyRef' arbitrary , fmap AtomicModifyRef arbitrary , fmap AtomicModifyRef' arbitrary ] data DequeAction = PushFront Int | PushBack Int | PopFront | PopBack deriving Show instance Arbitrary DequeAction where arbitrary = oneof $ concat [ replicate 25 $ fmap PushFront arbitrary , replicate 25 $ fmap PushBack arbitrary , [return PopFront, return PopBack] ] manyPushes :: [DequeAction] manyPushes = concat [ replicate 50 $ PushBack 0 , replicate 50 PopFront , replicate 50 $ PushFront 0 , replicate 50 PopBack ] specialCase :: [DequeAction] specialCase = [PushBack 9, PushBack 5,PushBack 11,PushBack 2,PushBack 13,PushBack 10,PushBack 4,PushBack 13,PushBack 7,PushBack 8,PushBack 6,PushBack 4,PushBack 7,PushBack 9,PushBack 10,PushBack 3,PushBack 2,PushBack 12,PushBack 12 ,PushBack 6,PushBack 3,PushBack 5,PushBack 14,PushBack 14,PushBack 11,PushBack 8,PopFront,PopFront,PopFront,PushBack 11,PushBack 3,PopFront,PopFront,PushBack 13,PushBack 12,PopFront,PushBack 10,PushBack 7,PopFront,PopFront,PushBack 13,PushBack 9,PopFront,PushBack 7,PushBack 2,PopFront,PopFront,PushBack 6,PushBack 4,PopFront,PopFront,PopFront,PushBack 9,PushBack 3,PopFront,PushBack 10,PushBack 6,PopFront,PopFront,PopFront,PushBack 12,PushBack 5,PopFront,PushBack 12,PushBack 5,PopFront,PushBack 6,PushBack 4,PopFront,PopFront,PopFront,PushBack 14,PushBack 10,PopFront,PushBack 14,PushBack 10,PopFront,PushBack 11,PushBack 8,PopFront,PushBack 8,PushBack 2,PopFront,PopFront,PopFront,PushBack 13,PushBack 7,PopFront,PushBack 12,PushBack 5,PopFront,PushBack 10,PushBack 8, PopFront,PushBack 7,PushBack 2,PopFront,PopFront,PushBack 9,PushBack 4,PopFront,PopFront,PopFront,PopFront,PopFront,PopFront,PopFront,PopFront,PushBack 4,PushBack 9,PushBack 3,PushBack 10,PushBack 6,PushBack 4,PushBack 13,PushBack 7,PushBack 9,PushBack 3,PopFront] spec :: Spec spec = do describe "Deque" $ do let runActions forceType actions = do base <- newColl :: IO (IORef [Int]) tested <- fmap forceType newColl forM_ (PopFront : PopBack : actions) $ \action -> do case action of PushFront i -> do pushFront base i pushFront tested i PushBack i -> do pushBack base i pushBack tested i PopFront -> do expected <- popFront base actual <- popFront tested actual `shouldBe` expected PopBack -> do expected <- popBack base actual <- popBack tested actual `shouldBe` expected let drain = do expected <- popBack base actual <- popBack tested actual `shouldBe` expected case actual of Just _ -> drain Nothing -> return $! () drain let test name forceType = describe name $ do prop "arbitrary actions" $ runActions forceType it "many pushes" $ runActions forceType manyPushes it "special case" $ runActions forceType specialCase test "UDeque" asUDeque test "SDeque" asSDeque test "BDeque" asBDeque test "DLList" asDLList test "MutVar Seq" (id :: MutVar (PrimState IO) (Seq Int) -> MutVar (PrimState IO) (Seq Int)) test "STRef Vector" (id :: STRef (PrimState IO) (Vector Int) -> STRef (PrimState IO) (Vector Int)) test "BRef Vector" (id :: BRef (PrimState IO) (Vector Int) -> BRef (PrimState IO) (Vector Int)) describe "Ref" $ do let test name forceType atomic atomic' = prop name $ \start actions -> do base <- fmap asIORef $ newRef start tested <- fmap forceType $ newRef start let check = do expected <- readRef base actual <- readRef tested expected `shouldBe` actual forM_ (actions :: [RefAction]) $ \action -> case action of WriteRef i -> do writeRef base i writeRef tested i check ModifyRef i -> do modifyRef base (+ i) modifyRef tested (+ i) check ModifyRef' i -> do modifyRef' base (subtract i) modifyRef' tested (subtract i) check AtomicModifyRef i -> do let f x = (x + i, ()) atomicModifyRef base f _ <- atomic tested f check AtomicModifyRef' i -> do atomicModifyRef' base $ \x -> (x - i, ()) _ <- atomic' tested $ \x -> (x - i, ()) check test "URef" asURef modifyRefHelper modifyRefHelper' test "PRef" asPRef modifyRefHelper modifyRefHelper' test "SRef" asSRef modifyRefHelper modifyRefHelper' test "BRef" asBRef modifyRefHelper modifyRefHelper' test "STRef" asSTRef modifyRefHelper modifyRefHelper' test "MutVar" asMutVar atomicModifyRef atomicModifyRef' modifyRefHelper :: (MCState c ~ PrimState IO, RefElement c ~ Int, MutableRef c) => c -> (Int -> (Int, ())) -> IO () modifyRefHelper ref f = modifyRef ref $ \i -> let (x, y) = f i in y `seq` x modifyRefHelper' :: (MCState c ~ PrimState IO, RefElement c ~ Int, MutableRef c) => c -> (Int -> (Int, ())) -> IO () modifyRefHelper' ref f = modifyRef' ref $ \i -> let (x, y) = f i in y `seq` x mutable-containers-0.3.2/bench/0000755000000000000000000000000012563022550014555 5ustar0000000000000000mutable-containers-0.3.2/bench/ref.hs0000644000000000000000000000135612563022550015672 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} import Control.Monad import Criterion.Main import Data.Mutable test :: (MCState c ~ PrimState IO, RefElement c ~ Int, MutableRef c) => String -> (c -> c) -> Benchmark test name forceType = bench name $ whnfIO $ do ref <- fmap forceType $ newRef (5 :: Int) replicateM_ 500 $ do modifyRef' ref (+ 1) modifyRef' ref (subtract 1) void $ readRef ref replicateM_ 500 $ do writeRef ref (5 :: Int) void $ readRef ref {-# INLINE test #-} main :: IO () main = defaultMain [ test "IORef" asIORef , test "STRef" asSTRef , test "MutVar" asMutVar , test "URef" asURef , test "PRef" asPRef , test "SRef" asSRef , test "BRef" asBRef ] mutable-containers-0.3.2/bench/deque.hs0000644000000000000000000000212612563022550016215 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} import Control.Monad import Criterion.Main import Data.Mutable import Data.Sequence (Seq) test :: (MCState c ~ PrimState IO, CollElement c ~ Int, MutableDeque c) => String -> (c -> c) -> Benchmark test name forceType = bench name $ whnfIO $ do let x = 5 :: Int coll <- fmap forceType newColl replicateM_ 500 $ pushFront coll x replicateM_ 500 $ pushBack coll x replicateM_ 200 $ void $ popFront coll replicateM_ 200 $ void $ popBack coll replicateM_ 500 $ do pushBack coll x pushFront coll x void $ popFront coll replicateM_ 500 $ do pushBack coll x pushFront coll x replicateM_ 500 $ do pushBack coll x void $ popFront coll {-# INLINE test #-} main :: IO () main = defaultMain [ test "IORef [Int]" (id :: IORef [Int] -> IORef [Int]) , test "IORef (Seq Int)" (id :: IORef (Seq Int) -> IORef (Seq Int)) , test "UDeque" asUDeque , test "SDeque" asSDeque , test "BDeque" asBDeque , test "DList" asDList ] mutable-containers-0.3.2/Data/0000755000000000000000000000000012563022550014347 5ustar0000000000000000mutable-containers-0.3.2/Data/Mutable.hs0000644000000000000000000000267112563022550016302 0ustar0000000000000000-- | Classes and concrete implementations for mutable data structures. -- -- For more information on the design of this library, see the README file, -- also available at . module Data.Mutable ( -- * Data types -- ** Single-cell mutable references PRef , IOPRef , asPRef , URef , IOURef , asURef , SRef , IOSRef , asSRef , BRef , IOBRef , asBRef -- *** Standard re-exports , IORef , asIORef , STRef , asSTRef , MutVar , asMutVar -- ** Collections/queues , Deque , UDeque , asUDeque , SDeque , asSDeque , BDeque , asBDeque , DLList , asDLList -- * Type classes , MutableContainer (..) , MutableRef (..) , MutableAtomicRef (..) , MutableCollection (..) , MutablePushFront (..) , MutablePushBack (..) , MutablePopFront (..) , MutablePopBack (..) -- * Constraint kinds , MutableQueue , MutableStack , MutableDeque -- * Convenience re-exports , PrimMonad , PrimState , RealWorld , Prim , Unbox , Storable ) where import Data.Mutable.Class import Data.Mutable.URef import Data.Mutable.SRef import Data.Mutable.PRef import Data.Mutable.BRef import Data.Mutable.Deque import Data.Mutable.DLList import Data.Vector.Unboxed (Unbox) import Data.Primitive (Prim) import Data.Vector.Storable (Storable) mutable-containers-0.3.2/Data/Mutable/0000755000000000000000000000000012563022550015740 5ustar0000000000000000mutable-containers-0.3.2/Data/Mutable/DLList.hs0000644000000000000000000000676612563022550017446 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | Doubly-linked list module Data.Mutable.DLList ( DLList , asDLList , module Data.Mutable.Class ) where import Data.Mutable.Class data Node s a = Node a (MutVar s (Maybe (Node s a))) -- previous (MutVar s (Maybe (Node s a))) -- next -- | A doubly-linked list. -- -- Since 0.3.0 data DLList s a = DLList (MutVar s (Maybe (Node s a))) (MutVar s (Maybe (Node s a))) -- | -- Since 0.2.0 asDLList :: DLList s a -> DLList s a asDLList = id {-# INLINE asDLList #-} instance MutableContainer (DLList s a) where type MCState (DLList s a) = s instance MutableCollection (DLList s a) where type CollElement (DLList s a) = a newColl = do x <- newRef $! Nothing y <- newRef $! Nothing return $! DLList x y {-# INLINE newColl #-} instance MutablePopFront (DLList s a) where popFront (DLList frontRef backRef) = do mfront <- readRef frontRef case mfront of Nothing -> return Nothing Just (Node val _ nextRef) -> do mnext <- readRef nextRef case mnext of Nothing -> do writeRef frontRef $! Nothing writeRef backRef $! Nothing Just next@(Node _ prevRef _) -> do writeRef prevRef $! Nothing writeRef frontRef $! Just next return $ Just val {-# INLINE popFront #-} instance MutablePopBack (DLList s a) where popBack (DLList frontRef backRef) = do mback <- readRef backRef case mback of Nothing -> return Nothing Just (Node val prevRef _) -> do mprev <- readRef prevRef case mprev of Nothing -> do writeRef frontRef $! Nothing writeRef backRef $! Nothing Just prev@(Node _ _ nextRef) -> do writeRef nextRef $! Nothing writeRef backRef (Just prev) return $ Just val {-# INLINE popBack #-} instance MutablePushFront (DLList s a) where pushFront (DLList frontRef backRef) val = do mfront <- readRef frontRef case mfront of Nothing -> do prevRef <- newRef $! Nothing nextRef <- newRef $! Nothing let node = Just $ Node val prevRef nextRef writeRef frontRef node writeRef backRef node Just front@(Node _ prevRef _) -> do prevRefNew <- newRef $! Nothing nextRef <- newRef $ Just front let node = Just $ Node val prevRefNew nextRef writeRef prevRef node writeRef frontRef node {-# INLINE pushFront #-} instance MutablePushBack (DLList s a) where pushBack (DLList frontRef backRef) val = do mback <- readRef backRef case mback of Nothing -> do prevRef <- newRef $! Nothing nextRef <- newRef $! Nothing let node = Just $! Node val prevRef nextRef writeRef frontRef $! node writeRef backRef $! node Just back@(Node _ _ nextRef) -> do nextRefNew <- newRef $! Nothing prevRef <- newRef $! Just back let node = Just $! Node val prevRef nextRefNew writeRef nextRef $! node writeRef backRef $! node {-# INLINE pushBack #-} mutable-containers-0.3.2/Data/Mutable/Class.hs0000644000000000000000000002526112563022550017347 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} -- | Various typeclasses for mutable containers. module Data.Mutable.Class ( PrimMonad , PrimState , RealWorld , MutableQueue , MutableStack , MutableDeque , IORef , asIORef , STRef , asSTRef , MutVar , asMutVar , MutableContainer (..) , MutableRef (..) , MutableAtomicRef (..) , MutableCollection (..) , MutablePushFront (..) , MutablePushBack (..) , MutablePopFront (..) , MutablePopBack (..) , pushFrontRef , pushBackRef , popFrontRef , popBackRef ) where import Control.Monad.Primitive import Data.IORef import Data.Monoid import Data.MonoTraversable (Element) import Data.Primitive.MutVar import qualified Data.Sequences as Seqs import Data.STRef -- | The parent typeclass for all mutable containers. -- -- Since 0.2.0 class MutableContainer c where -- | Associated type giving the primitive state token for the given -- container, much like 'PrimState' from primitive. -- -- Since 0.2.0 type MCState c instance MutableContainer (IORef a) where type MCState (IORef a) = PrimState IO instance MutableContainer (STRef s a) where type MCState (STRef s a) = s instance MutableContainer (MutVar s a) where type MCState (MutVar s a) = s -- | Typeclass for single-cell mutable references. -- -- Since 0.2.0 class MutableContainer c => MutableRef c where -- | Associated type giving the type of the value inside the mutable -- reference. -- -- Since 0.2.0 type RefElement c -- | Create a new mutable reference with the given value. -- -- Since 0.2.0 newRef :: (PrimMonad m, PrimState m ~ MCState c) => RefElement c -> m c -- | Read the current value in the mutable reference. -- -- Since 0.2.0 readRef :: (PrimMonad m, PrimState m ~ MCState c) => c -> m (RefElement c) -- | Write a new value to the mutable reference. -- -- Since 0.2.0 writeRef :: (PrimMonad m, PrimState m ~ MCState c) => c -> RefElement c -> m () -- | Modify the value in the mutable reference, without necessarily forcing the result. -- -- Note: some implementations /will/ force the result, in particular -- @PRef@, @SRef@, and @URef@. -- -- Since 0.2.0 modifyRef :: (PrimMonad m, PrimState m ~ MCState c) => c -> (RefElement c -> RefElement c) -> m () -- | Modify the value in the mutable reference, forcing the result. -- -- Since 0.2.0 modifyRef' :: (PrimMonad m, PrimState m ~ MCState c) => c -> (RefElement c -> RefElement c) -> m () instance MutableRef (IORef a) where type RefElement (IORef a) = a newRef = primToPrim . newIORef {-# INLINE newRef #-} readRef = primToPrim . readIORef {-# INLINE readRef #-} writeRef c = primToPrim . writeIORef c {-# INLINE writeRef #-} modifyRef c = primToPrim . modifyIORef c {-# INLINE modifyRef #-} modifyRef' c = primToPrim . modifyIORef' c {-# INLINE modifyRef' #-} instance MutableRef (STRef s a) where type RefElement (STRef s a) = a newRef = primToPrim . newSTRef {-# INLINE newRef #-} readRef = primToPrim . readSTRef {-# INLINE readRef #-} writeRef c = primToPrim . writeSTRef c {-# INLINE writeRef #-} modifyRef c = primToPrim . modifySTRef c {-# INLINE modifyRef #-} modifyRef' c = primToPrim . modifySTRef' c {-# INLINE modifyRef' #-} instance MutableRef (MutVar s a) where type RefElement (MutVar s a) = a newRef = newMutVar {-# INLINE newRef #-} readRef = readMutVar {-# INLINE readRef #-} writeRef = writeMutVar {-# INLINE writeRef #-} modifyRef = modifyMutVar {-# INLINE modifyRef #-} modifyRef' = modifyMutVar' {-# INLINE modifyRef' #-} -- | @MutableRef@s that provide for atomic modifications of their contents. -- -- Since 0.2.0 class MutableRef c => MutableAtomicRef c where -- | Modify the value without necessarily forcing the result. -- -- Since 0.2.0 atomicModifyRef :: (PrimMonad m, PrimState m ~ MCState c) => c -> (RefElement c -> (RefElement c, a)) -> m a -- | Modify the value, forcing the result. -- -- Since 0.2.0 atomicModifyRef' :: (PrimMonad m, PrimState m ~ MCState c) => c -> (RefElement c -> (RefElement c, a)) -> m a instance MutableAtomicRef (IORef a) where atomicModifyRef c = primToPrim . atomicModifyIORef c {-# INLINE atomicModifyRef #-} atomicModifyRef' c = primToPrim . atomicModifyIORef' c {-# INLINE atomicModifyRef' #-} instance MutableAtomicRef (MutVar s a) where atomicModifyRef = atomicModifyMutVar {-# INLINE atomicModifyRef #-} atomicModifyRef' = atomicModifyMutVar' {-# INLINE atomicModifyRef' #-} -- | Containers which contain 0 or more values. -- -- Since 0.2.0 class MutableContainer c => MutableCollection c where -- | The type of each value in the collection. -- -- Since 0.2.0 type CollElement c -- | Create a new, empty collection. -- -- Since 0.2.0 newColl :: (PrimMonad m, PrimState m ~ MCState c) => m c instance Monoid w => MutableCollection (IORef w) where type CollElement (IORef w) = Element w newColl = newRef mempty {-# INLINE newColl #-} instance Monoid w => MutableCollection (STRef s w) where type CollElement (STRef s w) = Element w newColl = newRef mempty {-# INLINE newColl #-} instance Monoid w => MutableCollection (MutVar s w) where type CollElement (MutVar s w) = Element w newColl = newRef mempty {-# INLINE newColl #-} -- | Take a value from the front of the collection, if available. -- -- Since 0.2.0 class MutableCollection c => MutablePopFront c where -- | Take a value from the front of the collection, if available. -- -- Since 0.2.0 popFront :: (PrimMonad m, PrimState m ~ MCState c) => c -> m (Maybe (CollElement c)) popFrontRef :: ( PrimMonad m , PrimState m ~ MCState c , MutableRef c , CollElement c ~ Element (RefElement c) , Seqs.IsSequence (RefElement c) ) => c -> m (Maybe (CollElement c)) popFrontRef c = do l <- readRef c case Seqs.uncons l of Nothing -> return Nothing Just (x, xs) -> do writeRef c xs return (Just x) {-# INLINE popFrontRef #-} instance Seqs.IsSequence a => MutablePopFront (IORef a) where popFront = popFrontRef {-# INLINE popFront #-} instance Seqs.IsSequence a => MutablePopFront (STRef s a) where popFront = popFrontRef {-# INLINE popFront #-} instance Seqs.IsSequence a => MutablePopFront (MutVar s a) where popFront = popFrontRef {-# INLINE popFront #-} -- | Place a value at the front of the collection. -- -- Since 0.2.0 class MutableCollection c => MutablePushFront c where -- | Place a value at the front of the collection. -- -- Since 0.2.0 pushFront :: (PrimMonad m, PrimState m ~ MCState c) => c -> CollElement c -> m () pushFrontRef :: ( PrimMonad m , PrimState m ~ MCState c , MutableRef c , CollElement c ~ Element (RefElement c) , Seqs.IsSequence (RefElement c) ) => c -> CollElement c -> m () pushFrontRef c e = modifyRef' c (Seqs.cons e) {-# INLINE pushFrontRef #-} instance Seqs.IsSequence a => MutablePushFront (IORef a) where pushFront = pushFrontRef {-# INLINE pushFront #-} instance Seqs.IsSequence a => MutablePushFront (STRef s a) where pushFront = pushFrontRef {-# INLINE pushFront #-} instance Seqs.IsSequence a => MutablePushFront (MutVar s a) where pushFront = pushFrontRef {-# INLINE pushFront #-} -- | Take a value from the back of the collection, if available. -- -- Since 0.2.0 class MutableCollection c => MutablePopBack c where -- | Take a value from the back of the collection, if available. -- -- Since 0.2.0 popBack :: (PrimMonad m, PrimState m ~ MCState c) => c -> m (Maybe (CollElement c)) popBackRef :: ( PrimMonad m , PrimState m ~ MCState c , MutableRef c , CollElement c ~ Element (RefElement c) , Seqs.IsSequence (RefElement c) ) => c -> m (Maybe (CollElement c)) popBackRef c = do l <- readRef c case Seqs.unsnoc l of Nothing -> return Nothing Just (xs, x) -> do writeRef c xs return (Just x) {-# INLINE popBackRef #-} instance Seqs.IsSequence a => MutablePopBack (IORef a) where popBack = popBackRef {-# INLINE popBack #-} instance Seqs.IsSequence a => MutablePopBack (STRef s a) where popBack = popBackRef {-# INLINE popBack #-} instance Seqs.IsSequence a => MutablePopBack (MutVar s a) where popBack = popBackRef {-# INLINE popBack #-} -- | Place a value at the back of the collection. -- -- Since 0.2.0 class MutableCollection c => MutablePushBack c where -- | Place a value at the back of the collection. -- -- Since 0.2.0 pushBack :: (PrimMonad m, PrimState m ~ MCState c) => c -> CollElement c -> m () pushBackRef :: ( PrimMonad m , PrimState m ~ MCState c , MutableRef c , CollElement c ~ Element (RefElement c) , Seqs.IsSequence (RefElement c) ) => c -> CollElement c -> m () pushBackRef c e = modifyRef' c (`Seqs.snoc` e) {-# INLINE pushBackRef #-} instance Seqs.IsSequence a => MutablePushBack (IORef a) where pushBack = pushBackRef {-# INLINE pushBack #-} instance Seqs.IsSequence a => MutablePushBack (STRef s a) where pushBack = pushBackRef {-# INLINE pushBack #-} instance Seqs.IsSequence a => MutablePushBack (MutVar s a) where pushBack = pushBackRef {-# INLINE pushBack #-} -- | Collections which allow pushing and popping at the front (aka FIFOs). -- -- Since 0.2.0 type MutableQueue c = (MutablePopFront c, MutablePushBack c) -- | Collections which allow pushing at the back and popping at the front (aka FILOs). -- -- Since 0.2.0 type MutableStack c = (MutablePopFront c, MutablePushFront c) -- | Collections which allow pushing and popping at the front and back. -- -- Since 0.2.0 type MutableDeque c = (MutableQueue c, MutablePushFront c, MutablePopBack c) -- | -- Since 0.2.0 asIORef :: IORef a -> IORef a asIORef = id -- | -- Since 0.2.0 asSTRef :: STRef s a -> STRef s a asSTRef = id -- | -- Since 0.2.0 asMutVar :: MutVar s a -> MutVar s a asMutVar = id mutable-containers-0.3.2/Data/Mutable/URef.hs0000644000000000000000000000251512563022550017140 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | Use 1-length mutable unboxed vectors for mutable references. -- -- Motivated by: and ArrayRef. module Data.Mutable.URef ( -- * Types URef , IOURef -- * Functions , asURef , MutableRef (..) ) where import Control.Monad (liftM) import Data.Mutable.Class import qualified Data.Vector.Generic.Mutable as V import qualified Data.Vector.Unboxed.Mutable as VU -- | An unboxed vector reference, supporting any monad. -- -- Since 0.2.0 newtype URef s a = URef (VU.MVector s a) -- | -- Since 0.2.0 asURef :: URef s a -> URef s a asURef x = x {-# INLINE asURef #-} -- | An unboxed IO vector reference. type IOURef = URef (PrimState IO) instance MutableContainer (URef s a) where type MCState (URef s a) = s instance VU.Unbox a => MutableRef (URef s a) where type RefElement (URef s a) = a newRef = liftM URef . V.replicate 1 {-# INLINE newRef#-} readRef (URef v) = V.unsafeRead v 0 {-# INLINE readRef #-} writeRef (URef v) = V.unsafeWrite v 0 {-# INLINE writeRef #-} modifyRef (URef v) f = V.unsafeRead v 0 >>= V.unsafeWrite v 0 . f {-# INLINE modifyRef #-} modifyRef' = modifyRef {-# INLINE modifyRef' #-} mutable-containers-0.3.2/Data/Mutable/Deque.hs0000644000000000000000000001120412563022550017335 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Data.Mutable.Deque ( Deque , UDeque , asUDeque , SDeque , asSDeque , BDeque , asBDeque , module Data.Mutable.Class ) where import Control.Exception (assert) import Control.Monad (liftM) import Data.Mutable.Class import qualified Data.Vector.Generic.Mutable as V import qualified Data.Vector.Mutable as B import qualified Data.Vector.Storable.Mutable as S import qualified Data.Vector.Unboxed.Mutable as U data DequeState v s a = DequeState (v s a) {-# UNPACK #-} !Int -- start {-# UNPACK #-} !Int -- size -- | A double-ended queue supporting any underlying vector type and any monad. -- -- This implements a circular double-ended queue with exponential growth. -- -- Since 0.2.0 newtype Deque v s a = Deque (MutVar s (DequeState v s a)) -- | A 'Deque' specialized to unboxed vectors. -- -- Since 0.2.0 type UDeque = Deque U.MVector -- | A 'Deque' specialized to storable vectors. -- -- Since 0.2.0 type SDeque = Deque S.MVector -- | A 'Deque' specialized to boxed vectors. -- -- Since 0.2.0 type BDeque = Deque B.MVector -- | -- Since 0.2.0 asUDeque :: UDeque s a -> UDeque s a asUDeque = id -- | -- Since 0.2.0 asSDeque :: SDeque s a -> SDeque s a asSDeque = id -- | -- Since 0.2.0 asBDeque :: BDeque s a -> BDeque s a asBDeque = id instance MutableContainer (Deque v s a) where type MCState (Deque v s a) = s instance V.MVector v a => MutableCollection (Deque v s a) where type CollElement (Deque v s a) = a newColl = do v <- V.new baseSize liftM Deque $ newRef (DequeState v 0 0) where baseSize = 32 {-# INLINE newColl #-} instance V.MVector v a => MutablePopFront (Deque v s a) where popFront (Deque var) = do DequeState v start size <- readRef var if size == 0 then return Nothing else do x <- V.unsafeRead v start let start' = start + 1 start'' | start' >= V.length v = 0 | otherwise = start' writeRef var $! DequeState v start'' (size - 1) return $! Just x {-# INLINE popFront #-} instance V.MVector v a => MutablePopBack (Deque v s a) where popBack (Deque var) = do DequeState v start size <- readRef var if size == 0 then return Nothing else do let size' = size - 1 end = start + size' end' | end >= V.length v = end - V.length v | otherwise = end x <- V.unsafeRead v end' writeRef var $! DequeState v start size' return $! Just x {-# INLINE popBack #-} instance V.MVector v a => MutablePushFront (Deque v s a) where pushFront (Deque var) x = do DequeState v start size <- readRef var inner v start size where inner v start size = do if size >= V.length v then newVector v start size inner else do let size' = size + 1 start' = (start - 1) `rem` V.length v start'' | start' < 0 = V.length v + start' | otherwise = start' V.unsafeWrite v start'' x writeRef var $! DequeState v start'' size' {-# INLINE pushFront #-} instance V.MVector v a => MutablePushBack (Deque v s a) where pushBack (Deque var) x = do DequeState v start size <- readRef var inner v start size where inner v start size = do if size >= V.length v then newVector v start size inner else do let end = start + size end' | end >= V.length v = end - V.length v | otherwise = end V.unsafeWrite v end' x writeRef var $! DequeState v start (size + 1) {-# INLINE pushBack #-} newVector :: (PrimMonad m, V.MVector v a) => v (PrimState m) a -> Int -> Int -> (v (PrimState m) a -> Int -> Int -> m b) -> m b newVector v size2 sizeOrig f = assert (sizeOrig == V.length v) $ do v' <- V.unsafeNew (V.length v * 2) let size1 = V.length v - size2 V.unsafeCopy (V.unsafeTake size1 v') (V.unsafeSlice size2 size1 v) V.unsafeCopy (V.unsafeSlice size1 size2 v') (V.unsafeTake size2 v) f v' 0 sizeOrig {-# INLINE newVector #-} mutable-containers-0.3.2/Data/Mutable/SRef.hs0000644000000000000000000000273012563022550017135 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | Use 1-length mutable storable vectors for mutable references. -- -- Motivated by: and ArrayRef. module Data.Mutable.SRef ( -- * Types SRef , IOSRef -- * Functions , asSRef , MutableRef (..) ) where import Data.Mutable.Class import Foreign.ForeignPtr import Foreign.Storable import Control.Monad.Primitive -- | A storable vector reference, supporting any monad. -- -- Since 0.2.0 newtype SRef s a = SRef (ForeignPtr a) -- | -- Since 0.2.0 asSRef :: SRef s a -> SRef s a asSRef x = x {-# INLINE asSRef #-} -- | A storable IO vector reference. type IOSRef = SRef (PrimState IO) instance MutableContainer (SRef s a) where type MCState (SRef s a) = s instance Storable a => MutableRef (SRef s a) where type RefElement (SRef s a) = a newRef x = unsafePrimToPrim $ do fptr <- mallocForeignPtr withForeignPtr fptr $ flip poke x return $! SRef fptr {-# INLINE newRef#-} readRef (SRef fptr) = unsafePrimToPrim $ withForeignPtr fptr peek {-# INLINE readRef #-} writeRef (SRef fptr) x = unsafePrimToPrim $ withForeignPtr fptr $ flip poke x {-# INLINE writeRef #-} modifyRef (SRef fptr) f = unsafePrimToPrim $ withForeignPtr fptr $ \ptr -> peek ptr >>= poke ptr . f {-# INLINE modifyRef #-} modifyRef' = modifyRef {-# INLINE modifyRef' #-} mutable-containers-0.3.2/Data/Mutable/BRef.hs0000644000000000000000000000412612563022550017115 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- | Use 1-length mutable boxed vectors for mutable references. -- -- Motivated by: and ArrayRef. module Data.Mutable.BRef ( -- * Types BRef , IOBRef -- * Functions , asBRef , MutableRef (..) ) where import Control.Monad (liftM) import Data.Monoid (Monoid, mempty) import Data.MonoTraversable (Element) import Data.Mutable.Class import Data.Sequences (IsSequence) import qualified Data.Vector.Generic.Mutable as V import qualified Data.Vector.Mutable as VB -- | A boxed vector reference, supporting any monad. -- -- Since 0.2.0 newtype BRef s a = BRef (VB.MVector s a) -- | -- Since 0.2.0 asBRef :: BRef s a -> BRef s a asBRef x = x {-# INLINE asBRef #-} -- | A boxed IO vector reference. type IOBRef = BRef (PrimState IO) instance MutableContainer (BRef s a) where type MCState (BRef s a) = s instance MutableRef (BRef s a) where type RefElement (BRef s a) = a newRef = liftM BRef . V.replicate 1 {-# INLINE newRef#-} readRef (BRef v) = V.unsafeRead v 0 {-# INLINE readRef #-} writeRef (BRef v) = V.unsafeWrite v 0 {-# INLINE writeRef #-} modifyRef (BRef v) f = V.unsafeRead v 0 >>= V.unsafeWrite v 0 . f {-# INLINE modifyRef #-} modifyRef' = modifyRef {-# INLINE modifyRef' #-} instance Monoid w => MutableCollection (BRef s w) where type CollElement (BRef s w) = Element w newColl = newRef mempty {-# INLINE newColl #-} instance IsSequence seq => MutablePushFront (BRef s seq) where pushFront = pushFrontRef {-# INLINE pushFront #-} instance IsSequence seq => MutablePushBack (BRef s seq) where pushBack = pushBackRef {-# INLINE pushBack #-} instance IsSequence seq => MutablePopFront (BRef s seq) where popFront = popFrontRef {-# INLINE popFront #-} instance IsSequence seq => MutablePopBack (BRef s seq) where popBack = popBackRef {-# INLINE popBack #-} mutable-containers-0.3.2/Data/Mutable/PRef.hs0000644000000000000000000000343112563022550017131 0ustar0000000000000000{-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} -- | Use @ByteArray@s containing one element for mutable references. -- -- This is similar to @URef@s, but avoids the overhead of storing the length of -- the @Vector@, which we statically know will always be 1. This allows it to -- be a bit faster. -- -- Motivated by: and ArrayRef. module Data.Mutable.PRef ( -- * Types PRef , IOPRef -- * Functions , asPRef , MutableRef (..) ) where import Control.Monad (liftM) import Data.Mutable.Class import Data.Primitive (sizeOf) import Data.Primitive.ByteArray (MutableByteArray, newByteArray, readByteArray, writeByteArray) import Data.Primitive.Types (Prim) import GHC.Types (Int (..)) -- | A primitive ByteArray reference, supporting any monad. -- -- Since 0.2.0 newtype PRef s a = PRef (MutableByteArray s) -- | -- Since 0.2.0 asPRef :: PRef s a -> PRef s a asPRef x = x {-# INLINE asPRef #-} -- | A primitive ByteArray IO reference. type IOPRef = PRef (PrimState IO) instance MutableContainer (PRef s a) where type MCState (PRef s a) = s instance Prim a => MutableRef (PRef s a) where type RefElement (PRef s a) = a newRef x = do ba <- newByteArray (sizeOf $! x) writeByteArray ba 0 x return $! PRef ba {-# INLINE newRef #-} readRef (PRef ba) = readByteArray ba 0 {-# INLINE readRef #-} writeRef (PRef ba) = writeByteArray ba 0 {-# INLINE writeRef #-} modifyRef (PRef ba) f = do x <- readByteArray ba 0 writeByteArray ba 0 $! f x {-# INLINE modifyRef #-} modifyRef' = modifyRef {-# INLINE modifyRef' #-}