contiguous 0.2.0.0 → 0.3.0.0

raw patch · 2 files changed

+141/−17 lines, 2 filesdep +deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

API changes (from Hackage documentation)

Files

• contiguous.cabal +2/−1
• src/Data/Primitive/Contiguous.hs +139/−16

@@ -1,6 +1,6 @@ cabal-version: 2.0 name: contiguous-version: 0.2.0.0+version: 0.3.0.0 homepage: https://github.com/andrewthad/contiguous bug-reports: https://github.com/andrewthad/contiguous/issues author: Andrew Martin@@ -28,6 +28,7 @@   build-depends:       base >=4.9 && <5     , primitive >= 0.6.4+    , deepseq >= 1.4   default-language: Haskell2010   ghc-options: -O2 -Wall 

@@ -13,20 +13,32 @@   , Always   , map   , foldr+  , foldMap   , foldl'   , foldr'   , foldMap'   , foldlM'+  , traverse_+  , itraverse_   , unsafeFromListN   , unsafeFromListReverseN+  , liftHashWithSalt+  , same   ) where -import Prelude hiding (map,foldr)-import Control.Monad.ST (ST,runST)+import Prelude hiding (map,foldr,foldMap)+import Control.Monad.ST (runST)+import Control.Monad.Primitive+import Data.Bits (xor) import Data.Kind (Type) import Data.Primitive-import GHC.Exts (ArrayArray#,Constraint)+import GHC.Exts (MutableArrayArray#,ArrayArray#,Constraint,sizeofByteArray#,sizeofArray#,sizeofArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#)+import Control.DeepSeq (NFData) +import qualified Control.DeepSeq as DS++-- | A typeclass that is satisfied by all types. This is used+-- used to provide a fake constraint for 'Array' and 'SmallArray'. class Always a instance Always a @@ -35,29 +47,34 @@   type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr   type family Element arr :: Type -> Constraint   empty :: arr a-  new :: Element arr b => Int -> ST s (Mutable arr s b)+  null :: arr b -> Bool+  new :: (PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b)+  replicateM :: (PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)   index :: Element arr b => arr b -> Int -> b   index# :: Element arr b => arr b -> Int -> (# b #)   indexM :: (Element arr b, Monad m) => arr b -> Int -> m b-  read :: Element arr b => Mutable arr s b -> Int -> ST s b-  write :: Element arr b => Mutable arr s b -> Int -> b -> ST s ()-  resize :: Element arr b => Mutable arr s b -> Int -> ST s (Mutable arr s b)+  read :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m b+  write :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> b -> m ()+  resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)   size :: Element arr b => arr b -> Int-  sizeMutable :: Element arr b => Mutable arr s b -> ST s Int-  unsafeFreeze :: Mutable arr s b -> ST s (arr b)-  copy :: Element arr b => Mutable arr s b -> Int -> arr b -> Int -> Int -> ST s ()-  copyMutable :: Element arr b => Mutable arr s b -> Int -> Mutable arr s b -> Int -> Int -> ST s ()+  sizeMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int+  unsafeFreeze :: PrimMonad m => Mutable arr (PrimState m) b -> m (arr b)+  copy :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()+  copyMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()   clone :: Element arr b => arr b -> Int -> Int -> arr b-  cloneMutable :: Element arr b => Mutable arr s b -> Int -> Int -> ST s (Mutable arr s b)+  cloneMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (Mutable arr (PrimState m) b)   equals :: (Element arr b, Eq b) => arr b -> arr b -> Bool   unlift :: arr b -> ArrayArray#   lift :: ArrayArray# -> arr b+  sameMutable :: Mutable arr s a -> Mutable arr s a -> Bool+  rnf :: (NFData a, Element arr a) => arr a -> ()  instance Contiguous PrimArray where   type Mutable PrimArray = MutablePrimArray   type Element PrimArray = Prim   empty = mempty   new = newPrimArray+  replicateM = replicatePrimArrayM   index = indexPrimArray   index# arr ix = (# indexPrimArray arr ix #)   indexM arr ix = return (indexPrimArray arr ix)@@ -74,12 +91,18 @@   equals = (==)   unlift = toArrayArray#   lift = fromArrayArray#+  null (PrimArray a) = case sizeofByteArray# a of+    0# -> True+    _ -> False+  sameMutable = sameMutablePrimArray+  rnf (PrimArray !_) = ()  instance Contiguous Array where   type Mutable Array = MutableArray   type Element Array = Always   empty = mempty   new n = newArray n errorThunk+  replicateM = newArray   index = indexArray   index# = indexArray##   indexM = indexArrayM@@ -96,12 +119,25 @@   equals = (==)   unlift = toArrayArray#   lift = fromArrayArray#+  null (Array a) = case sizeofArray# a of+    0# -> True+    _ -> False+  sameMutable = sameMutableArray+  rnf !ary = +    let !sz = sizeofArray ary+        go !i+          | i == sz = ()+          | otherwise =+              let !(# x #) = indexArray## ary i+               in DS.rnf x `seq` go (i+1)+     in go 0  instance Contiguous UnliftedArray where   type Mutable UnliftedArray = MutableUnliftedArray   type Element UnliftedArray = PrimUnlifted   empty = emptyUnliftedArray   new = unsafeNewUnliftedArray+  replicateM = newUnliftedArray   index = indexUnliftedArray   index# arr ix = (# indexUnliftedArray arr ix #)   indexM arr ix = return (indexUnliftedArray arr ix)@@ -118,19 +154,31 @@   equals = (==)   unlift = toArrayArray#   lift = fromArrayArray#+  null (UnliftedArray a) = case sizeofArrayArray# a of+    0# -> True+    _ -> False+  sameMutable = sameMutableUnliftedArray+  rnf !ary = +    let !sz = sizeofUnliftedArray ary+        go !i+          | i == sz = ()+          | otherwise =+              let x = indexUnliftedArray ary i+               in DS.rnf x `seq` go (i+1)+     in go 0  errorThunk :: a errorThunk = error "Contiguous typeclass: unitialized element" {-# NOINLINE errorThunk #-} -resizeArray :: Always a => MutableArray s a -> Int -> ST s (MutableArray s a)+resizeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a) resizeArray !src !sz = do   dst <- newArray sz errorThunk   copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src))   return dst {-# INLINE resizeArray #-} -resizeUnliftedArray :: PrimUnlifted a => MutableUnliftedArray s a -> Int -> ST s (MutableUnliftedArray s a)+resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a) resizeUnliftedArray !src !sz = do   dst <- unsafeNewUnliftedArray sz   copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src))@@ -142,7 +190,7 @@ {-# NOINLINE emptyUnliftedArray #-}  -- | Map over the elements of an array.-map :: (Contiguous arr, Element arr b, Element arr c) => (b -> c) -> arr b -> arr c+map :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => (b -> c) -> arr1 b -> arr2 c map f a = runST $ do   mb <- new (size a)   let go !i@@ -187,6 +235,17 @@   in go (size ary - 1) z {-# INLINABLE foldr' #-} +-- | Monoidal fold over the element of an array.+foldMap :: (Contiguous arr, Element arr a, Monoid m) => (a -> m) -> arr a -> m+foldMap f arr = go 0+  where+    !sz = size arr+    go !i+      | sz > i = case index# arr i of+          (# x #) -> mappend (f x) (go (i+1))+      | otherwise = mempty+{-# INLINABLE foldMap #-}+ -- | Strict monoidal fold over the elements of an array. foldMap' :: (Contiguous arr, Element arr a, Monoid m)   => (a -> m) -> arr a -> m@@ -219,13 +278,23 @@   unsafeFreezePrimArray marr {-# INLINE clonePrimArray #-} -cloneMutablePrimArray :: Prim a => MutablePrimArray s a -> Int -> Int -> ST s (MutablePrimArray s a)+cloneMutablePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a) cloneMutablePrimArray !arr !off !len = do   marr <- newPrimArray len   copyMutablePrimArray marr 0 arr off len   return marr {-# INLINE cloneMutablePrimArray #-} +replicatePrimArrayM :: (PrimMonad m, Prim a)+  => Int -- ^ length+  -> a -- ^ element+  -> m (MutablePrimArray (PrimState m) a)+replicatePrimArrayM len a = do+  marr <- newPrimArray len+  setPrimArray marr 0 len a+  return marr+{-# INLINE replicatePrimArrayM #-}+ -- | Create an array from a list. If the given length does -- not match the actual length, this function has undefined -- behavior.@@ -257,3 +326,57 @@         go (ix-1) xs   go (n - 1) l   unsafeFreeze m++traverse_ ::+     (Contiguous arr, Element arr a, Applicative f)+  => (a -> f b)+  -> arr a+  -> f ()+traverse_ f a = go 0 where+  !sz = size a+  go !ix = if ix < sz+    then f (index a ix) *> go (ix + 1)+    else pure ()+{-# INLINABLE traverse_ #-}++itraverse_ ::+     (Contiguous arr, Element arr a, Applicative f)+  => (Int -> a -> f b)+  -> arr a+  -> f ()+itraverse_ f a = go 0 where+  !sz = size a+  go !ix = if ix < sz+    then f ix (index a ix) *> go (ix + 1)+    else pure ()+{-# INLINABLE itraverse_ #-}++liftHashWithSalt :: (Contiguous arr, Element arr a)+  => (Int -> a -> Int)+  -> Int+  -> arr a+  -> Int+liftHashWithSalt f s0 arr = go 0 s0 where+  sz = size arr+  go !ix !s = if ix < sz+    then +      let !(# x #) = index# arr ix+       in go (ix + 1) (f s x)+    else hashIntWithSalt s ix+{-# INLINABLE liftHashWithSalt #-}++-- | This function does not behave deterministically. Optimization level and+-- inlining can affect its results. However, the one thing that can be counted+-- on is that if it returns @True@, the two immutable arrays are definitely the+-- same. This is useful as shortcut for equality tests. However, keep in mind+-- that a result of @False@ tells us nothing about the arguments.+same :: Contiguous arr => arr a -> arr a -> Bool+same a b = isTrue# (sameMutableArrayArray# (unsafeCoerce# (unlift a) :: MutableArrayArray# s) (unsafeCoerce# (unlift b) :: MutableArrayArray# s))++hashIntWithSalt :: Int -> Int -> Int+hashIntWithSalt salt x = salt `combine` x++combine :: Int -> Int -> Int+combine h1 h2 = (h1 * 16777619) `xor` h2++