impure-containers 0.5.0 → 0.5.1

raw patch · 6 files changed

+169/−21 lines, 6 filesdep ~hashabledep ~primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: hashable, primitive

API changes (from Hackage documentation)

Files

• impure-containers.cabal +4/−4
• src/Data/ArrayList/Generic.hs +136/−15
• src/Data/HashMap/Mutable/Internal/IntArray.hs +7/−1
• src/ImpureContainers/MByteArray.hs +9/−0
• src/ImpureContainers/PrimRef.hs +10/−0
• test/Spec.hs +3/−1

@@ -1,7 +1,7 @@ --------------------------------------------------------------------------------  name:                     impure-containers-version:                  0.5.0+version:                  0.5.1 stability:                Experimental build-type:               Simple cabal-version:            >= 1.10@@ -88,10 +88,10 @@                         , Data.HashMap.Mutable.Internal.UnsafeTricks                         , Data.HashMap.Mutable.Internal.Utils   build-depends:          base                        >= 4.8   && < 5-                        , hashable                    >= 1.2   && < 1.3-                        , primitive                   >= 0.6   && < 0.7+                        , hashable                    >= 1.2   && < 1.4+                        , primitive                   >= 0.6   && < 0.8                         , vector                      >= 0.11  && < 0.13-                        , containers                  >  0.5   && < 0.6+                        , containers                  >  0.5   && < 0.7                         , ghc-prim   default-language:       Haskell2010 

@@ -1,41 +1,162 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns     #-}+{-# LANGUAGE FlexibleContexts #-} -module Data.ArrayList.Generic where+{- | +Auto-growing 'ArrayList' type that over-allocates memory to optimize frequent resizes.++This is similar to @std::vector@ from C++ or @list@ from Python.++When an @ArrayList@ is requested to grow and current allocated capacity can't hold the+required number of items, capacity is multiplied by a constant factor of @1.5@, instead+of allocating just the required number of items. This ensures that frequent grow requests+will result in a much lower number of actual allocations and memory moves.++All functions in this module are marked @INLINEABLE@, so that they may be specialized to concrete+monad and vector types at the use-site.+-}+module Data.ArrayList.Generic+  (+    -- * Creation of @ArrayList@s+    ArrayList+  , new, fromVector++    -- * Accessing the underlying vector+  , vector, size+  , unsafeVector++    -- * Extending the @ArrayList@+  , push, grow++    -- * Deconstruction of @ArrayList@s+  , freeze+  ) where++import           Control.Monad               (when) import           Control.Monad.Primitive+import           Control.Monad.ST            (ST) import           Data.Primitive.MutVar import           Data.Vector.Generic         (Mutable, Vector) import qualified Data.Vector.Generic         as GV import           Data.Vector.Generic.Mutable (MVector) import qualified Data.Vector.Generic.Mutable as GM+import qualified Data.Vector.Mutable         as VM+import qualified Data.Vector.Unboxed.Mutable as VUM+import           GHC.Prim                    (RealWorld)  data ArrayList v s a = ArrayList   { arrayListSize   :: !(MutVar s Int)   , arrayListVector :: !(MutVar s (v s a))   } +-- | Create a new 'ArrayList' with requested capacity. The length of 'ArrayList' as reported by+-- 'size' will be @0@. new :: (PrimMonad m, MVector v a) => Int -> m (ArrayList v (PrimState m) a) new len = ArrayList <$> newMutVar 0 <*> (newMutVar =<< GM.new len)+{-# INLINEABLE new #-} +-- | Create a new 'ArrayList' from immutable vector. Capacity will be equal to the length of vector.+-- Memory will be copied, so that input vector is safe to use afterwards.+fromVector :: (PrimMonad m, Vector v a) => v a -> m (ArrayList (Mutable v) (PrimState m) a)+fromVector vec = ArrayList <$> newMutVar (GV.length vec) <*> (newMutVar =<< GV.thaw vec)+{-# INLINEABLE fromVector #-}++-- | Get underlying mutable vector that stores @ArrayList@'s data. Length of this vector will be set+-- to the actually used length of @ArrayList@, not its capacity.+vector :: (PrimMonad m, MVector v a) => ArrayList v (PrimState m) a -> m (v (PrimState m) a)+vector (ArrayList sizeRef mvecRef) = do+  !size_ <- readMutVar sizeRef+  GM.unsafeTake size_ <$> readMutVar mvecRef+{-# INLINEABLE vector #-}++-- | Like 'vector', but do not set the length of resulting vector. Its length will be equal to the+-- capacity of 'ArrayList'. This means that some elements of the vector will be uninitialized.+unsafeVector :: (PrimMonad m, MVector v a) => ArrayList v (PrimState m) a -> m (v (PrimState m) a)+unsafeVector (ArrayList _ mvecRef) = readMutVar mvecRef+{-# INLINEABLE unsafeVector #-}++-- | Get currently used size of the 'ArrayList'.+size :: (PrimMonad m, MVector v a) => ArrayList v (PrimState m) a -> m Int+size (ArrayList sizeRef _) = readMutVar sizeRef+{-# INLINEABLE size #-}+ -- | Append an element to the end of the 'ArrayList'. push :: (PrimMonad m, MVector v a) => ArrayList v (PrimState m) a -> a -> m ()-push (ArrayList sizeRef mvecRef) a = do-  !size <- readMutVar sizeRef+push al@(ArrayList sizeRef mvecRef) a = do+  grow al 1++  !size_ <- readMutVar sizeRef   !mvec <- readMutVar mvecRef-  let !newSize = size + 1-      vlen = GM.length mvec++  GM.unsafeWrite mvec (size_ - 1) a+{-# INLINEABLE push #-}+{-# SPECIALIZE push :: ArrayList VM.MVector RealWorld a -> a -> IO () #-}+{-# SPECIALIZE push :: ArrayList VM.MVector s a -> a -> ST s () #-}+{-# SPECIALIZE push :: (GM.MVector VUM.MVector a) => ArrayList VUM.MVector RealWorld a -> a -> IO () #-}+{-# SPECIALIZE push :: (GM.MVector VUM.MVector a) => ArrayList VUM.MVector s a -> a -> ST s () #-}+{-# SPECIALIZE push :: (MVector v a) => ArrayList v RealWorld a -> a -> IO () #-}+{-# SPECIALIZE push :: (MVector v a) => ArrayList v s a -> a -> ST s () #-}++-- | Request to add more items to the vector. Used size will be set to current size + extra requested size.+--+-- __NOTE__: Do not use the result of 'vector' after calling this function, as it may refer to discarded+-- memory.+--+-- This function defines two Cost Centres: "@ArrayList.grow.toNewSize@" when vector will grow to fit+-- precisely the number of required elements, and "@ArrayList.grow.toNewCapacity@" when vector will+-- over-allocate memory.+--+-- These may be useful when profiling your program to check how much allocations and moves 'ArrayList'+-- does actually save.+--+-- This function is specialized to 'IO' and 'ST' monads, as well to simple 'VM.MVector' and unboxed+-- 'VUM.MVector' types.+grow :: (PrimMonad m, MVector v a) => ArrayList v (PrimState m) a -> Int -> m ()+grow (ArrayList sizeRef mvecRef) extraSize = do+  !size_ <- readMutVar sizeRef+  !mvec <- readMutVar mvecRef++  let+    capacity = GM.length mvec+    newSize = size_ + extraSize+    -- Next step in exponential grow+    newCapacity = floor $ fromIntegral capacity * factor++  -- Need to grow the vector only if the current capacity can't hold the requested size+  when (capacity < newSize) $ do+      -- Grow vector to be max (capacity * factor) (curSize + extraSize)+      -- unsafeGrow will reallocate the vector and return newly created one.+      --+      -- NOTE: unsafeGrow accepts extra size requested, not total new size.+      !mvec' <- if newSize > newCapacity+         then+           {-# SCC "ArrayList.grow.toNewSize" #-} GM.unsafeGrow mvec (newSize - capacity)+         else+           {-# SCC "ArrayList.grow.toNewCapacity" #-} GM.unsafeGrow mvec (newCapacity - capacity)++      -- Ensure that the memory requested by user is initialized.+      --GM.basicInitialize $ GM.unsafeSlice size_ extraSize mvec'++      writeMutVar mvecRef mvec'++  -- In any case, remeber current used size.   writeMutVar sizeRef newSize-  if size < vlen-    then GM.unsafeWrite mvec size a-    else do-      newMVec <- GM.unsafeGrow mvec size-      GM.unsafeWrite newMVec size a-      writeMutVar mvecRef newMVec+{-# INLINEABLE grow #-}+{-# SPECIALIZE grow :: ArrayList VM.MVector RealWorld a -> Int -> IO () #-}+{-# SPECIALIZE grow :: ArrayList VM.MVector s a -> Int -> ST s () #-}+{-# SPECIALIZE grow :: (GM.MVector VUM.MVector a) => ArrayList VUM.MVector RealWorld a -> Int -> IO () #-}+{-# SPECIALIZE grow :: (GM.MVector VUM.MVector a) => ArrayList VUM.MVector s a -> Int -> ST s () #-}+{-# SPECIALIZE grow :: (MVector v a) => ArrayList v RealWorld a -> Int -> IO () #-}+{-# SPECIALIZE grow :: (MVector v a) => ArrayList v s a -> Int -> ST s () #-} +factor :: Double+factor = 1.5++-- | Make a copy of currently used part of 'ArrayList' and return it as an immutable vector. freeze :: (PrimMonad m, Vector v a) => ArrayList (Mutable v) (PrimState m) a -> m (v a) freeze (ArrayList sizeRef mvecRef) = do-  !size <- readMutVar sizeRef+  !size_ <- readMutVar sizeRef   !mvec <- readMutVar mvecRef-  let sizedMVec = GM.unsafeTake size mvec+  let sizedMVec = GM.unsafeTake size_ mvec   GV.freeze sizedMVec-+{-# INLINEABLE freeze #-}

@@ -20,8 +20,10 @@ import           Control.Monad.Primitive  (PrimMonad, PrimState) import           Control.Monad.ST import           Data.Bits-import qualified Data.Primitive.ByteArray as A+#if !MIN_VERSION_primitive(0, 7, 0) import           Data.Primitive.Types     (Addr (..))+#endif+import qualified Data.Primitive.ByteArray as A import           GHC.Exts import           GHC.Word import           Prelude                  hiding (length)@@ -113,4 +115,8 @@ toPtr :: IntArray s -> Ptr a toPtr (IA a) = Ptr a#   where+#if MIN_VERSION_primitive(0,7,0)+    !(Ptr !a#) = A.mutableByteArrayContents a+#else     !(Addr !a#) = A.mutableByteArrayContents a+#endif

@@ -1,5 +1,6 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE CPP       #-} {-# LANGUAGE MagicHash #-}  --------------------------------------------------------------------------------@@ -42,7 +43,11 @@  import           Control.Monad.Primitive import           Data.Coerce             (coerce)+#if MIN_VERSION_primitive(0, 7, 0)+import           Data.Primitive          (Prim, Ptr)+#else import           Data.Primitive          (Addr, Prim)+#endif import qualified Data.Primitive  import qualified GHC.Prim@@ -108,7 +113,11 @@ contents   :: MByteArray s   -- ^ FIXME: doc+#if MIN_VERSION_primitive(0, 7, 0)+  -> Ptr Word8+#else   -> Addr+#endif   -- ^ FIXME: doc contents = Data.Primitive.mutableByteArrayContents {-# INLINE contents #-}

@@ -31,6 +31,7 @@  -------------------------------------------------------------------------------- +{-# LANGUAGE CPP             #-} {-# LANGUAGE MagicHash       #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE UnboxedTuples   #-}@@ -84,7 +85,12 @@ import           Control.Monad.Primitive                  (PrimMonad, PrimState, primitive, primitive_) +#if MIN_VERSION_primitive(0, 7, 0)+import           Data.Primitive              (Prim, Ptr, alignment, sizeOf)+import           Data.Word                   (Word8)+#else import           Data.Primitive              (Addr, Prim, alignment, sizeOf)+#endif  import qualified GHC.Prim                    as GHC.Prim import           GHC.Types                   (Int (I#))@@ -180,7 +186,11 @@ contents   :: PrimRef s a   -- ^ FIXME: doc+#if MIN_VERSION_primitive(0, 7, 0)+  -> Ptr Word8+#else   -> Addr+#endif   -- ^ FIXME: doc contents (MkPrimRef m) = MByteArray.contents m {-# INLINE contents #-}

@@ -24,6 +24,7 @@ import           Data.List                            (groupBy) import qualified Data.List                            as List import qualified Data.Map.Strict                      as Map+import           Data.Semigroup                       (Semigroup) import qualified Data.Set                             as Set import           Data.Word import           Debug.Trace@@ -79,9 +80,10 @@   arbitrary = fmap Min (choose (0,20))   shrink (Min a) = fmap Min $ filter (>= 0) $ shrinkIntegral a +instance Semigroup Min where+  (Min a) <> (Min b) = Min (min a b) instance Monoid Min where   mempty = Min maxBound-  mappend (Min a) (Min b) = Min (min a b)  newtype MyElement = MyElement { getMyElement :: Int }   deriving (Show,Read,Eq,Ord)