packages feed

contiguous 0.4.0.1 → 0.5

raw patch · 5 files changed

+2762/−1569 lines, 5 filesdep +quickcheck-classesdep +randomdep +random-shuffledep ~basedep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: quickcheck-classes, random, random-shuffle, weigh

Dependency ranges changed: base, primitive

API changes (from Hackage documentation)

+ Data.Primitive.Contiguous: (<$) :: (Contiguous arr1, Contiguous arr2, Element arr1 b, Element arr2 a) => a -> arr1 b -> arr2 a
+ Data.Primitive.Contiguous: ap :: (Contiguous arr1, Contiguous arr2, Contiguous arr3, Element arr1 (a -> b), Element arr2 a, Element arr3 b) => arr1 (a -> b) -> arr2 a -> arr3 b
+ Data.Primitive.Contiguous: asum :: (Contiguous arr, Element arr (f a), Alternative f) => arr (f a) -> f a
+ Data.Primitive.Contiguous: catMaybes :: (Contiguous arr, Element arr a, Element arr (Maybe a)) => arr (Maybe a) -> arr a
+ Data.Primitive.Contiguous: data Array a
+ Data.Primitive.Contiguous: data MutableArray s a
+ Data.Primitive.Contiguous: data MutablePrimArray s a
+ Data.Primitive.Contiguous: data MutableUnliftedArray s a
+ Data.Primitive.Contiguous: data PrimArray a
+ Data.Primitive.Contiguous: data SmallArray a
+ Data.Primitive.Contiguous: data SmallMutableArray s a
+ Data.Primitive.Contiguous: data UnliftedArray a
+ Data.Primitive.Contiguous: elem :: (Contiguous arr, Element arr a, Eq a) => a -> arr a -> Bool
+ Data.Primitive.Contiguous: find :: (Contiguous arr, Element arr a) => (a -> Bool) -> arr a -> Maybe a
+ Data.Primitive.Contiguous: for :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b, Applicative f) => arr1 a -> (a -> f b) -> f (arr2 b)
+ Data.Primitive.Contiguous: forM :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b, Monad m) => arr1 a -> (a -> m b) -> m (arr2 b)
+ Data.Primitive.Contiguous: forM_ :: (Contiguous arr, Element arr a, Element arr b, Applicative f) => (a -> f b) -> arr a -> f ()
+ Data.Primitive.Contiguous: for_ :: (Contiguous arr, Element arr a, Applicative f) => arr a -> (a -> f b) -> f ()
+ Data.Primitive.Contiguous: generateM :: (Contiguous arr, Element arr a, Monad m) => Int -> (Int -> m a) -> m (arr a)
+ Data.Primitive.Contiguous: iprescanl :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (Int -> b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: iprescanl' :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (Int -> b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: iscanl :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (Int -> b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: iscanl' :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (Int -> b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: lefts :: forall arr a b. (Contiguous arr, Element arr a, Element arr (Either a b)) => arr (Either a b) -> arr a
+ Data.Primitive.Contiguous: mapM :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b, Monad m) => (a -> m b) -> arr1 a -> m (arr2 b)
+ Data.Primitive.Contiguous: mapM_ :: (Contiguous arr, Element arr a, Element arr b, Applicative f) => (a -> f b) -> arr a -> f ()
+ Data.Primitive.Contiguous: maximum :: (Contiguous arr, Element arr a, Ord a) => arr a -> Maybe a
+ Data.Primitive.Contiguous: maximumBy :: (Contiguous arr, Element arr a) => (a -> a -> Ordering) -> arr a -> Maybe a
+ Data.Primitive.Contiguous: minimum :: (Contiguous arr, Element arr a, Ord a) => arr a -> Maybe a
+ Data.Primitive.Contiguous: minimumBy :: (Contiguous arr, Element arr a) => (a -> a -> Ordering) -> arr a -> Maybe a
+ Data.Primitive.Contiguous: partitionEithers :: forall arr a b. (Contiguous arr, Element arr a, Element arr b, Element arr (Either a b)) => arr (Either a b) -> (arr a, arr b)
+ Data.Primitive.Contiguous: prescanl :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: prescanl' :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: reverseSlice :: (Contiguous arr, Element arr a, PrimMonad m) => Mutable arr (PrimState m) a -> Int -> Int -> m ()
+ Data.Primitive.Contiguous: rights :: forall arr a b. (Contiguous arr, Element arr b, Element arr (Either a b)) => arr (Either a b) -> arr b
+ Data.Primitive.Contiguous: scanl :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: scanl' :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (b -> a -> b) -> b -> arr1 a -> arr2 b
+ Data.Primitive.Contiguous: sequence :: (Contiguous arr1, Contiguous arr2, Element arr1 (f a), Element arr2 a, Applicative f) => arr1 (f a) -> f (arr2 a)
+ Data.Primitive.Contiguous: sequence_ :: (Contiguous arr, Element arr (f a), Applicative f) => arr (f a) -> f ()
+ Data.Primitive.Contiguous: swap :: (Contiguous arr, Element arr a, PrimMonad m) => Mutable arr (PrimState m) a -> Int -> Int -> m ()
+ Data.Primitive.Contiguous: zip :: (Contiguous arr1, Contiguous arr2, Contiguous arr3, Element arr1 a, Element arr2 b, Element arr3 (a, b)) => arr1 a -> arr2 b -> arr3 (a, b)
+ Data.Primitive.Contiguous: zipWith :: (Contiguous arr1, Contiguous arr2, Contiguous arr3, Element arr1 a, Element arr2 b, Element arr3 c) => (a -> b -> c) -> arr1 a -> arr2 b -> arr3 c
- Data.Primitive.Contiguous: itraverse :: (Contiguous arr, Element arr a, Element arr b, Applicative f) => (Int -> a -> f b) -> arr a -> f (arr b)
+ Data.Primitive.Contiguous: itraverse :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b, Applicative f) => (Int -> a -> f b) -> arr1 a -> f (arr2 b)
- Data.Primitive.Contiguous: traverse :: (Contiguous arr, Element arr a, Element arr b, Applicative f) => (a -> f b) -> arr a -> f (arr b)
+ Data.Primitive.Contiguous: traverse :: (Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b, Applicative f) => (a -> f b) -> arr1 a -> f (arr2 b)

Files

+ bench/Main.hs view
@@ -0,0 +1,355 @@+{-# language+        BangPatterns+      , MagicHash+      , ScopedTypeVariables+      , TypeApplications+      , UnboxedTuples+  #-}++module Main (main) where++import Prelude hiding+  ( null, read, Foldable(..), map+  )++import Control.Monad+import Data.Functor.Identity (Identity(..))+import Data.Monoid (Sum(..))+import Data.Primitive.Contiguous+import GHC.Exts (RealWorld)+import System.Random+import System.Random.Shuffle+import Weigh++main :: IO ()+main = do+  array10 <- randomC @Array 10+  array100 <- randomC @Array 100+  array1000 <- randomC @Array 1000+  smallArray10 <- randomC @SmallArray 10+  smallArray100 <- randomC @SmallArray 100+  smallArray1000 <- randomC @SmallArray 1000+  primArray10 <- randomC @PrimArray 10+  primArray100 <- randomC @PrimArray 100+  primArray1000 <- randomC @PrimArray 1000++  marray10 <- randomCM @Array 10+  marray100 <- randomCM @Array 100+  marray1000 <- randomCM @Array 1000+  msmallArray10 <- randomCM @SmallArray 10+  msmallArray100 <- randomCM @SmallArray 100+  msmallArray1000 <- randomCM @SmallArray 1000+  mprimArray10 <- randomCM @PrimArray 10+  mprimArray100 <- randomCM @PrimArray 100+  mprimArray1000 <- randomCM @PrimArray 1000++  mainWith $ do+    wgroup "0-allocation" $ do+      wgroup "size" $ do+        func "array10" size array10+        func "array100" size array100+        func "array1000" size array1000++        func "smallArray10" size smallArray10+        func "smallArray100" size smallArray100+        func "smallArray1000" size smallArray1000++        func "primArray10" size primArray10+        func "primArray100" size primArray100+        func "primArray1000" size primArray1000++        io "marray10" sizeMutable marray10+        io "marray100" sizeMutable marray100+        io "marray1000" sizeMutable marray1000++        io "msmallArray10" sizeMutable msmallArray10+        io "msmallArray100" sizeMutable msmallArray100+        io "msmallArray1000" sizeMutable msmallArray1000++        io "mprimArray10" sizeMutable mprimArray10+        io "mprimArray100" sizeMutable mprimArray100+        io "mprimArray1000" sizeMutable mprimArray1000+      wgroup "null" $ do+        func "array10" null array10+        func "array100" null array100+        func "array1000" null array1000++        func "smallArray10" null smallArray10+        func "smallArray100" null smallArray100+        func "smallArray1000" null smallArray1000++        func "primArray10" null primArray10+        func "primArray100" null primArray100+        func "primArray1000" null primArray1000+      wgroup "index/read" $ do+        func "array10: index#" (index## 5) array10+        func "array100: index#" (index## 50) array100+        func "array1000: index#" (index## 500) array1000++        func "smallArray10: index#" (index## 5) smallArray10+        func "smallArray100: index#" (index## 50) smallArray100+        func "smallArray1000: index#" (index## 500) smallArray1000++        func "primArray10: index#" (index## 5) primArray10+        func "primArray100: index#" (index## 50) primArray100+        func "primArray1000: index#" (index## 500) primArray1000++        func "array10: index" (flip index 5) array10+        func "array100: index" (flip index 50) array100+        func "array1000: index" (flip index 500) array1000++        func "smallArray10: index" (flip index 5) smallArray10+        func "smallArray100: index" (flip index 50) smallArray100+        func "smallArray1000: index" (flip index 500) smallArray1000++        func "primArray10: index" (flip index 5) primArray10+        func "primArray100: index" (flip index 50) primArray100+        func "primArray1000: index" (flip index 500) primArray1000++        io "marray10: read" (flip read 5) marray10+        io "marray100: read" (flip read 50) marray100+        io "marray1000: read" (flip read 500) marray1000++        io "msmallArray10: read" (flip read 5) msmallArray10+        io "msmallArray100: read" (flip read 50) msmallArray100+        io "msmallArray1000: read" (flip read 500) msmallArray1000++        io "mprimArray10: read" (flip read 5) mprimArray10+        io "mprimArray100: read" (flip read 50) mprimArray100+        io "mprimArray1000: read" (flip read 500) mprimArray1000+      wgroup "folds" $ do+        wgroup "foldMap" $ do+          func "array10: foldMap computes sum" (foldMap sum1) array10+          func "array100: foldMap computes sum" (foldMap sum1) array100+          func "array1000: foldMap computes sum" (foldMap sum1) array1000++          func "smallArray10: foldMap computes sum" (foldMap sum1) smallArray10+          func "smallArray100: foldMap computes sum" (foldMap sum1) smallArray100+          func "smallArray1000: foldMap computes sum" (foldMap sum1) smallArray1000++          func "primArray10: foldMap computes sum" (foldMap sum1) primArray10+          func "primArray100: foldMap computes sum" (foldMap sum1) primArray100+          func "primArray1000: foldMap computes sum" (foldMap sum1) primArray1000+        wgroup "foldMap'" $ do+          func "array10: foldMap' computes sum" (foldMap' sum1) array10+          func "array100: foldMap' computes sum" (foldMap' sum1) array100+          func "array1000: foldMap' computes sum" (foldMap' sum1) array1000++          func "smallArray10: foldMap' computes sum" (foldMap' sum1) smallArray10+          func "smallArray100: foldMap' computes sum" (foldMap' sum1) smallArray100+          func "smallArray1000: foldMap' computes sum" (foldMap' sum1) smallArray1000++          func "primArray10: foldMap' computes sum" (foldMap' sum1) primArray10+          func "primArray100: foldMap' computes sum" (foldMap' sum1) primArray100+          func "primArray1000: foldMap' computes sum" (foldMap' sum1) primArray1000+        wgroup "foldr" $ do+          func "array10: foldr computes sum" (foldr (+) 0) array10+          func "array100: foldr computes sum" (foldr (+) 0) array100+          func "array1000: foldr computes sum" (foldr (+) 0) array1000++          func "smallArray10: foldr computes sum" (foldr (+) 0) smallArray10+          func "smallArray100: foldr computes sum" (foldr (+) 0) smallArray100+          func "smallArray1000: foldr computes sum" (foldr (+) 0) smallArray1000++          func "primArray10: foldr computes sum" (foldr (+) 0) primArray10+          func "primArray100: foldr computes sum" (foldr (+) 0) primArray100+          func "primArray1000: foldr computes sum" (foldr (+) 0) primArray1000+        wgroup "foldr'" $ do+          func "array10: foldr' computes sum" (foldr' (+) 0) array10+          func "array100: foldr' computes sum" (foldr' (+) 0) array100+          func "array1000: foldr' computes sum" (foldr' (+) 0) array1000++          func "smallArray10: foldr' computes sum" (foldr' (+) 0) smallArray10+          func "smallArray100: foldr' computes sum" (foldr' (+) 0) smallArray100+          func "smallArray1000: foldr' computes sum" (foldr' (+) 0) smallArray1000++          func "primArray10: foldr' computes sum" (foldr' (+) 0) primArray10+          func "primArray100: foldr' computes sum" (foldr' (+) 0) primArray100+          func "primArray1000: foldr' computes sum" (foldr' (+) 0) primArray1000+        wgroup "foldl" $ do+          func "array10: foldl computes sum" (foldl (+) 0) array10+          func "array100: foldl computes sum" (foldl (+) 0) array100+          func "array1000: foldl computes sum" (foldl (+) 0) array1000++          func "smallArray10: foldl computes sum" (foldl (+) 0) smallArray10+          func "smallArray100: foldl computes sum" (foldl (+) 0) smallArray100+          func "smallArray1000: foldl computes sum" (foldl (+) 0) smallArray1000++          func "primArray10: foldl computes sum" (foldl (+) 0) primArray10+          func "primArray100: foldl computes sum" (foldl (+) 0) primArray100+          func "primArray1000: foldl computes sum" (foldl (+) 0) primArray1000+        wgroup "foldl'" $ do+          func "array10: foldl' computes sum" (foldl' (+) 0) array10+          func "array100: foldl' computes sum" (foldl' (+) 0) array100+          func "array1000: foldl' computes sum" (foldl' (+) 0) array1000++          func "smallArray10: foldl' computes sum" (foldl' (+) 0) smallArray10+          func "smallArray100: foldl' computes sum" (foldl' (+) 0) smallArray100+          func "smallArray1000: foldl' computes sum" (foldl' (+) 0) smallArray1000++          func "primArray10: foldl' computes sum" (foldl' (+) 0) primArray10+          func "primArray100: foldl' computes sum" (foldl' (+) 0) primArray100+          func "primArray1000: foldl' computes sum" (foldl' (+) 0) primArray1000+        wgroup "ifoldl'" $ do+          func "array10: ifoldl' computes sum" (ifoldl' add3 0) array10+          func "array100: ifoldl' computes sum" (ifoldl' add3 0) array100+          func "array1000: ifoldl' computes sum" (ifoldl' add3 0) array1000++          func "smallArray10: ifoldl' computes sum" (ifoldl' add3 0) smallArray10+          func "smallArray100: ifoldl' computes sum" (ifoldl' add3 0) smallArray100+          func "smallArray1000: ifoldl' computes sum" (ifoldl' add3 0) smallArray1000++          func "primArray10: ifoldl' computes sum" (ifoldl' add3 0) primArray10+          func "primArray100: ifoldl' computes sum" (ifoldl' add3 0) primArray100+          func "primArray1000: ifoldl' computes sum" (ifoldl' add3 0) primArray1000+        wgroup "ifoldr'" $ do+          func "array10: ifoldr' computes sum" (ifoldr' add3 0) array10+          func "array100: ifoldr' computes sum" (ifoldr' add3 0) array100+          func "array1000: ifoldr' computes sum" (ifoldr' add3 0) array1000++          func "smallArray10: ifoldr' computes sum" (ifoldr' add3 0) smallArray10+          func "smallArray100: ifoldr' computes sum" (ifoldr' add3 0) smallArray100+          func "smallArray1000: ifoldr' computes sum" (ifoldr' add3 0) smallArray1000++          func "primArray10: ifoldr' computes sum" (ifoldr' add3 0) primArray10+          func "primArray100: ifoldr' computes sum" (ifoldr' add3 0) primArray100+          func "primArray1000: ifoldr' computes sum" (ifoldr' add3 0) primArray1000+        wgroup "foldlMap'" $ do+          func "array10: foldlMap' computes sum" (foldMap' sum1) array10+          func "array100: foldlMap' computes sum" (foldMap' sum1) array100+          func "array1000: foldlMap' computes sum" (foldMap' sum1) array1000++          func "smallArray10: foldlMap' computes sum" (foldMap' sum1) smallArray10+          func "smallArray100: foldlMap' computes sum" (foldMap' sum1) smallArray100+          func "smallArray1000: foldlMap' computes sum" (foldMap' sum1) smallArray1000++          func "primArray10: foldlMap' computes sum" (foldMap' sum1) primArray10+          func "primArray100: foldlMap' computes sum" (foldMap' sum1) primArray100+          func "primArray1000: foldlMap' computes sum" (foldMap' sum1) primArray1000++        wgroup "ifoldlMap'" $ do+          func "array10: ifoldlMap' computes sum" (ifoldlMap' isumN) array10+          func "array100: ifoldlMap' computes sum" (ifoldlMap' isumN) array100+          func "array1000: ifoldlMap' computes sum" (ifoldlMap' isumN) array1000++          func "smallArray10: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray10+          func "smallArray100: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray100+          func "smallArray1000: ifoldlMap' computes sum" (ifoldlMap' isumN) smallArray1000++          func "primArray10: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray10+          func "primArray100: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray100+          func "primArray1000: ifoldlMap' computes sum" (ifoldlMap' isumN) primArray1000+        wgroup "ifoldlMap1'" $ do+          func "array10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array10+          func "array100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array100+          func "array1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) array1000++          func "smallArray10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray10+          func "smallArray100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray100+          func "smallArray1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) smallArray1000++          func "primArray10: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray10+          func "primArray100: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray100+          func "primArray1000: ifoldlMap1' computes sum" (ifoldlMap1' isumN) primArray1000+        wgroup "foldlM'" $ do+          func "array10: foldlM' computes sum" (foldlM' idM 0) array10+          func "array100: foldlM' computes sum" (foldlM' idM 0) array100+          func "array1000: foldlM' computes sum" (foldlM' idM 0) array1000++          func "smallArray10: foldlM' computes sum" (foldlM' idM 0) smallArray10+          func "smallArray100: foldlM' computes sum" (foldlM' idM 0) smallArray100+          func "smallArray1000: foldlM' computes sum" (foldlM' idM 0) smallArray1000++          func "primArray10: foldlM' computes sum" (foldlM' idM 0) primArray10+          func "primArray100: foldlM' computes sum" (foldlM' idM 0) primArray100+          func "primArray1000: foldlM' computes sum" (foldlM' idM 0) primArray1000+    wgroup "maps" $ do+      wgroup "map" $ do+        func "array10" mapPlus1 array10+        func "array100" mapPlus1 array100+        func "array1000" mapPlus1 array1000++        func "smallArray10" mapPlus1 smallArray10+        func "smallArray100" mapPlus1 smallArray100+        func "smallArray1000" mapPlus1 smallArray1000++        func "primArray10" mapPlus1 primArray10+        func "primArray100" mapPlus1 primArray100+        func "primArray1000" mapPlus1 primArray1000+      wgroup "map'" $ do+        func "array10" mapPlus1' array10+        func "array100" mapPlus1' array100+        func "array1000" mapPlus1' array1000++        func "smallArray10" mapPlus1' smallArray10+        func "smallArray100" mapPlus1' smallArray100+        func "smallArray1000" mapPlus1' smallArray1000++        func "primArray10" mapPlus1' primArray10+        func "primArray100" mapPlus1' primArray100+        func "primArray1000" mapPlus1' primArray1000+      wgroup "mapMaybe" $ do+        func "array10" mapMaybeJ array10+        func "array100" mapMaybeJ array100+        func "array1000" mapMaybeJ array1000++        func "smallArray10" mapMaybeJ smallArray10+        func "smallArray100" mapMaybeJ smallArray100+        func "smallArray1000" mapMaybeJ smallArray1000++        func "primArray10" mapMaybeJ primArray10+        func "primArray100" mapMaybeJ primArray100+        func "primArray1000" mapMaybeJ primArray1000++mapMaybeJ :: forall arr. (Contiguous arr, Element arr Int)+  => arr Int+  -> ()+mapMaybeJ arr =+  let !(arr' :: arr Int) = mapMaybe Just arr+   in ()++mapPlus1 :: forall arr. (Contiguous arr, Element arr Int)+  => arr Int -> ()+mapPlus1 arr = let !(arr' :: arr Int) = map (+1) arr in ()++mapPlus1' :: forall arr. (Contiguous arr, Element arr Int)+  => arr Int -> ()+mapPlus1' arr = let !(arr' :: arr Int) = map' (+1) arr in ()++plus1 :: Int -> Int+plus1 = (+1)++sum1 :: a -> Sum Int+sum1 = const (Sum 1)++isumN :: Int -> a -> Sum Int+isumN x = const (Sum x)++idM :: Int -> Int -> Identity Int+idM x y = Identity (x + y)++add3 :: Int -> Int -> Int -> Int+add3 x y z = x + y + z++index## :: (Contiguous arr, Element arr a) => Int -> arr a -> ()+index## ix arr = case index# arr ix of !(# _x #) -> ()++randomList :: Int -> IO [Int]+randomList sz = replicateM sz (randomRIO (minBound,maxBound))++randomC :: (Contiguous arr, Element arr Int)+  => Int+  -> IO (arr Int)+randomC sz = do+  rList <- randomList sz+  rList' <- shuffleM rList+  pure (fromListN sz rList')++randomCM :: (Contiguous arr, Element arr Int)+  => Int+  -> IO (Mutable arr RealWorld Int)+randomCM sz = do+  rList <- randomList sz+  rList' <- shuffleM rList+  fromListMutableN sz rList'+
contiguous.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: contiguous-version: 0.4.0.1+version: 0.5 homepage: https://github.com/andrewthad/contiguous bug-reports: https://github.com/andrewthad/contiguous/issues author: Andrew Martin@@ -46,3 +46,32 @@     , quickcheck-instances   default-language: Haskell2010   ghc-options: -O2 -Wall++test-suite laws+  type: exitcode-stdio-1.0+  main-is: Laws.hs+  hs-source-dirs: test+  build-depends:+      base+    , contiguous+    , primitive+    , vector+    , QuickCheck+    , quickcheck-instances+    , quickcheck-classes+  default-language: Haskell2010+  ghc-options: -O2 -Wall++benchmark weigh+  type: exitcode-stdio-1.0+  build-depends:+      base+    , primitive+    , contiguous+    , weigh+    , random+    , random-shuffle+  default-language: Haskell2010+  hs-source-dirs: bench+  main-is: Main.hs+  ghc-options: -O2
src/Data/Primitive/Contiguous.hs view
@@ -1,1543 +1,2139 @@-{-# language BangPatterns #-}-{-# language FlexibleInstances #-}-{-# language MagicHash #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language TypeFamilies #-}-{-# language TypeFamilyDependencies #-}-{-# language UnboxedTuples #-}---- | The contiguous typeclass parameterises over a contiguous array type.---   This allows us to have a common API to a number of contiguous---   array types and their mutable counterparts.-module Data.Primitive.Contiguous-  (-    -- * Accessors-    -- ** Length Information-    size-  , sizeMutable-  , null-    -- ** Indexing-  , index-  , index#-  , read-    -- ** Monadic indexing-  , indexM--    -- * Construction-    -- ** Initialisation-  , empty-  , new-  , singleton-  , doubleton-  , tripleton-  , replicate-  , replicateMutable-  , generate-  , generateMutable-  , iterateN-  , iterateMutableN-  , write-    -- ** Monadic initialisation-  , replicateMutableM-  , generateMutableM-  , iterateMutableNM-  , create-  , createT-    -- ** Unfolding-  , unfoldr-  , unfoldrN-  , unfoldrMutable-    -- ** Enumeration-  , enumFromN-  , enumFromMutableN-    -- ** Concatenation-  , append-    -- * Modifying arrays-    -- ** Permutations-  , reverse-  , reverseMutable-    -- ** Resizing-  , resize--    -- * Elementwise operations-    -- ** Mapping-  , map-  , map'-  , mapMutable-  , mapMutable'-  , imap-  , imap'-  , imapMutable-  , imapMutable'-  , modify-  , modify'-  , mapMaybe--    -- * Working with predicates-    -- ** Filtering-  , filter-  , ifilter-    -- ** Comparing for equality-  , equals-  , equalsMutable-  , same-    -- * Folds-  , foldl-  , foldl'-  , foldr-  , foldr'-  , foldMap-  , foldMap'-  , foldlMap'-  , ifoldl'-  , ifoldr'-  , ifoldlMap'-  , ifoldlMap1'-  , foldlM'--    -- * Traversals-  , traverse-  , traverse_-  , itraverse-  , itraverse_-  , traverseP--    -- * Conversions-    -- ** Lists-  , fromList-  , fromListN-  , fromListMutable-  , fromListMutableN-  , unsafeFromListN-  , unsafeFromListReverseN-  , unsafeFromListReverseMutableN-  , toList-  , toListMutable-    -- ** Other array types-  , convert-  , lift-  , unlift-    -- ** Between mutable and immutable variants-  , clone-  , cloneMutable-  , copy-  , copyMutable-  , freeze-  , thaw-  , unsafeFreeze--    -- * Hashing-  , liftHashWithSalt--    -- * Forcing an array and its contents-  , rnf--    -- * Classes-  , Contiguous(Mutable,Element)-  , Always-  ) where--import Prelude hiding (map,foldr,foldMap,traverse,read,filter,replicate,null,reverse,foldl,foldr)-import Control.Applicative (liftA2)-import Control.DeepSeq (NFData)-import Control.Monad.Primitive-import Control.Monad.ST (runST,ST)-import Data.Bits (xor)-import Data.Kind (Type)-import Data.Primitive hiding (fromList,fromListN)-import Data.Primitive.Unlifted.Array-import Data.Primitive.Unlifted.Class (PrimUnlifted)-import Data.Semigroup (Semigroup,(<>))-import Data.Word (Word8)-import GHC.Base (build)-import GHC.Exts (MutableArrayArray#,ArrayArray#,Constraint,sizeofByteArray#,sizeofArray#,sizeofArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#,dataToTag#,Int(..))--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---- | The 'Contiguous' typeclass as an interface to a multitude of---   contiguous structures.-class Contiguous (arr :: Type -> Type) where-  -- | The Mutable counterpart to the array.-  type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr-  -- | The constraint needed to store elements in the array.-  type family Element arr :: Type -> Constraint-  -- | The empty array.-  empty :: arr a-  -- | Test whether the array is empty.-  null :: arr b -> Bool-  -- | Allocate a new mutable array of the given size.-  new :: (PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b)-  -- | @'replicateMutable' n x@ is a mutable array of length @n@ with @x@ the value of every element.-  replicateMutable :: (PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)-  -- | Index into an array at the given index.-  index :: Element arr b => arr b -> Int -> b-  -- | Index into an array at the given index, yielding an unboxed one-tuple of the element.-  index# :: Element arr b => arr b -> Int -> (# b #)-  -- | Indexing in a monad.-  ---  --   The monad allows operations to be strict in the array-  --   when necessary. Suppose array copying is implemented like this:-  ---  --   > copy mv v = ... write mv i (v ! i) ...-  ---  --   For lazy arrays, @v ! i@ would not be not be evaluated,-  --   which means that @mv@ would unnecessarily retain a reference-  --   to @v@ in each element written.-  ---  --   With 'indexM', copying can be implemented like this instead:-  ---  --   > copy mv v = ... do-  --   >   x <- indexM v i-  --   >   write mv i x-  ---  --   Here, no references to @v@ are retained because indexing-  --   (but /not/ the elements) is evaluated eagerly.-  indexM :: (Element arr b, Monad m) => arr b -> Int -> m b-  -- | Read a mutable array at the given index.-  read :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m b-  -- | Write to a mutable array at the given index.-  write :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> b -> m ()-  -- | Resize an array into one with the given size.-  resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)-  -- | The size of the array-  size :: Element arr b => arr b -> Int-  -- | The size of the mutable array-  sizeMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int-  -- | Turn a mutable array into an immutable one without copying.-  --   The mutable array should not be used after this conversion.-  unsafeFreeze :: PrimMonad m => Mutable arr (PrimState m) b -> m (arr b)-  -- | Turn a mutable array into an immutable one with copying, using a slice of the mutable array.-  freeze :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)-  -- | Copy a slice of an immutable array into a new mutable array.-  thaw :: (PrimMonad m, Element arr b) => arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)-  -- | Copy a slice of an array into a mutable array.-  copy :: (PrimMonad m, Element arr b)-    => Mutable arr (PrimState m) b -- ^ destination array-    -> Int -- ^ offset into destination array-    -> arr b -- ^ source array-    -> Int -- ^ offset into source array-    -> Int -- ^ number of elements to copy-    -> m ()-  -- | Copy a slice of a mutable array into another mutable array.-  --   In the case that the destination and source arrays are the-  --   same, the regions may overlap.-  copyMutable :: (PrimMonad m, Element arr b)-    => Mutable arr (PrimState m) b -- ^ destination array-    -> Int -- ^ offset into destination array-    -> Mutable arr (PrimState m) b -- ^ source array-    -> Int -- ^ offset into source array-    -> Int -- ^ number of elements to copy-    -> m ()-  -- | Clone a slice of an array.-  clone :: Element arr b-    => arr b-    -> Int-    -> Int-    -> arr b-  -- | Clone a slice of a mutable array.-  cloneMutable :: (PrimMonad m, Element arr b)-    => Mutable arr (PrimState m) b-    -> Int-    -> Int-    -> m (Mutable arr (PrimState m) b)-  -- | Test the two arrays for equality.-  equals :: (Element arr b, Eq b) => arr b -> arr b -> Bool-  -- | Test the two mutable arrays for pointer equality.-  --   Does not check equality of elements.-  equalsMutable :: Mutable arr s a -> Mutable arr s a -> Bool-  -- | Unlift an array into an 'ArrayArray#'.-  unlift :: arr b -> ArrayArray#-  -- | Lift an 'ArrayArray#' into an array.-  lift :: ArrayArray# -> arr b-  -- | Create a singleton array.-  singleton :: Element arr a => a -> arr a-  -- | Create a doubleton array.-  doubleton :: Element arr a => a -> a -> arr a-  -- | Create a tripleton array.-  tripleton :: Element arr a => a -> a -> a -> arr a-  -- | Reduce the array and all of its elements to WHNF.-  rnf :: (NFData a, Element arr a) => arr a -> ()--instance Contiguous SmallArray where-  type Mutable SmallArray = SmallMutableArray-  type Element SmallArray = Always-  empty = mempty-  new n = newSmallArray n errorThunk-  index = indexSmallArray -  indexM = indexSmallArrayM-  index# = indexSmallArray##-  read = readSmallArray-  write = writeSmallArray-  null a = case sizeofSmallArray a of-    0 -> True-    _ -> False-  freeze = freezeSmallArray-  size = sizeofSmallArray-  sizeMutable = pure . sizeofSmallMutableArray-  unsafeFreeze = unsafeFreezeSmallArray-  thaw = thawSmallArray-  equals = (==)-  equalsMutable = (==)-  singleton a = runST $ do-    marr <- newSmallArray 1 errorThunk-    writeSmallArray marr 0 a-    unsafeFreezeSmallArray marr-  doubleton a b = runST $ do-    m <- newSmallArray 2 errorThunk-    writeSmallArray m 0 a-    writeSmallArray m 1 b-    unsafeFreezeSmallArray m-  tripleton a b c = runST $ do-    m <- newSmallArray 3 errorThunk-    writeSmallArray m 0 a-    writeSmallArray m 1 b-    writeSmallArray m 2 c-    unsafeFreezeSmallArray m-  rnf !ary = -    let !sz = sizeofSmallArray ary-        go !ix = if ix < sz-          then-            let !(# x #) = indexSmallArray## ary ix-             in DS.rnf x `seq` go (ix + 1)-          else ()-     in go 0-  clone = cloneSmallArray-  cloneMutable = cloneSmallMutableArray-  lift x = SmallArray (unsafeCoerce# x)-  unlift (SmallArray x) = unsafeCoerce# x-  copy = copySmallArray-  copyMutable = copySmallMutableArray-  replicateMutable = replicateSmallMutableArray-  resize = resizeSmallArray-  {-# inline empty #-}-  {-# inline null #-}-  {-# inline new #-}-  {-# inline replicateMutable #-}-  {-# inline index #-}-  {-# inline index# #-}-  {-# inline indexM #-}-  {-# inline read #-}-  {-# inline write #-}-  {-# inline resize #-}-  {-# inline size #-}-  {-# inline sizeMutable #-}-  {-# inline unsafeFreeze #-}-  {-# inline freeze #-}-  {-# inline thaw #-}-  {-# inline copy #-}-  {-# inline copyMutable #-}-  {-# inline clone #-}-  {-# inline cloneMutable #-}-  {-# inline equals #-}-  {-# inline equalsMutable #-}-  {-# inline unlift #-}-  {-# inline lift #-}-  {-# inline singleton #-}-  {-# inline doubleton #-}-  {-# inline tripleton #-}-  {-# inline rnf #-}--instance Contiguous PrimArray where-  type Mutable PrimArray = MutablePrimArray-  type Element PrimArray = Prim-  empty = mempty-  new = newPrimArray-  replicateMutable = replicateMutablePrimArray-  index = indexPrimArray-  index# arr ix = (# indexPrimArray arr ix #)-  indexM arr ix = pure (indexPrimArray arr ix)-  read = readPrimArray-  write = writePrimArray-  resize = resizeMutablePrimArray-  size = sizeofPrimArray-  sizeMutable = getSizeofMutablePrimArray-  freeze = freezePrimArray-  unsafeFreeze = unsafeFreezePrimArray-  thaw = thawPrimArray-  copy = copyPrimArray-  copyMutable = copyMutablePrimArray-  clone = clonePrimArray-  cloneMutable = cloneMutablePrimArray-  equals = (==)-  unlift (PrimArray x) = unsafeCoerce# x-  lift x = PrimArray (unsafeCoerce# x)-  null (PrimArray a) = case sizeofByteArray# a of-    0# -> True-    _ -> False-  equalsMutable = sameMutablePrimArray-  rnf (PrimArray !_) = ()-  singleton a = runST $ do-    marr <- newPrimArray 1-    writePrimArray marr 0 a-    unsafeFreezePrimArray marr-  doubleton a b = runST $ do-    m <- newPrimArray 2-    writePrimArray m 0 a-    writePrimArray m 1 b-    unsafeFreezePrimArray m-  tripleton a b c = runST $ do-    m <- newPrimArray 3-    writePrimArray m 0 a-    writePrimArray m 1 b-    writePrimArray m 2 c-    unsafeFreezePrimArray m-  {-# inline empty #-}-  {-# inline null #-}-  {-# inline new #-}-  {-# inline replicateMutable #-} -  {-# inline index #-}-  {-# inline index# #-}-  {-# inline indexM #-}-  {-# inline read #-}-  {-# inline write #-}-  {-# inline resize #-}-  {-# inline size #-}-  {-# inline sizeMutable #-}-  {-# inline unsafeFreeze #-}-  {-# inline freeze #-}-  {-# inline thaw #-}-  {-# inline copy #-}-  {-# inline copyMutable #-}-  {-# inline clone #-}-  {-# inline cloneMutable #-}-  {-# inline equals #-}-  {-# inline equalsMutable #-}-  {-# inline unlift #-}-  {-# inline lift #-}-  {-# inline singleton #-}-  {-# inline doubleton #-}-  {-# inline tripleton #-}-  {-# inline rnf #-}--instance Contiguous Array where-  type Mutable Array = MutableArray-  type Element Array = Always-  empty = mempty-  new n = newArray n errorThunk-  replicateMutable = newArray-  index = indexArray-  index# = indexArray##-  indexM = indexArrayM-  read = readArray-  write = writeArray-  resize = resizeArray-  size = sizeofArray-  sizeMutable = pure . sizeofMutableArray-  freeze = freezeArray-  unsafeFreeze = unsafeFreezeArray-  thaw = thawArray-  copy = copyArray-  copyMutable = copyMutableArray-  clone = cloneArray-  cloneMutable = cloneMutableArray-  equals = (==)-  unlift (Array x) = unsafeCoerce# x-  lift x = Array (unsafeCoerce# x)-  null (Array a) = case sizeofArray# a of-    0# -> True-    _ -> False-  equalsMutable = 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-  singleton a = runST (newArray 1 a >>= unsafeFreezeArray)-  doubleton a b = runST $ do-    m <- newArray 2 a-    writeArray m 1 b-    unsafeFreezeArray m-  tripleton a b c = runST $ do-    m <- newArray 3 a-    writeArray m 1 b-    writeArray m 2 c-    unsafeFreezeArray m-  {-# inline empty #-}-  {-# inline null #-}-  {-# inline new #-}-  {-# inline replicateMutable #-}-  {-# inline index #-}-  {-# inline index# #-}-  {-# inline indexM #-}-  {-# inline read #-}-  {-# inline write #-}-  {-# inline resize #-}-  {-# inline size #-}-  {-# inline sizeMutable #-}-  {-# inline unsafeFreeze #-}-  {-# inline freeze #-}-  {-# inline thaw #-}-  {-# inline copy #-}-  {-# inline copyMutable #-}-  {-# inline clone #-}-  {-# inline cloneMutable #-}-  {-# inline equals #-}-  {-# inline equalsMutable #-}-  {-# inline unlift #-}-  {-# inline lift #-}-  {-# inline singleton #-}-  {-# inline doubleton #-}-  {-# inline tripleton #-}-  {-# inline rnf #-}--instance Contiguous UnliftedArray where-  type Mutable UnliftedArray = MutableUnliftedArray-  type Element UnliftedArray = PrimUnlifted-  empty = emptyUnliftedArray-  new = unsafeNewUnliftedArray-  replicateMutable = newUnliftedArray-  index = indexUnliftedArray-  index# arr ix = (# indexUnliftedArray arr ix #)-  indexM arr ix = pure (indexUnliftedArray arr ix)-  read = readUnliftedArray-  write = writeUnliftedArray-  resize = resizeUnliftedArray-  size = sizeofUnliftedArray-  sizeMutable = pure . sizeofMutableUnliftedArray-  freeze = freezeUnliftedArray-  unsafeFreeze = unsafeFreezeUnliftedArray-  thaw = thawUnliftedArray-  copy = copyUnliftedArray-  copyMutable = copyMutableUnliftedArray-  clone = cloneUnliftedArray-  cloneMutable = cloneMutableUnliftedArray-  equals = (==)-  unlift (UnliftedArray x) = x-  lift x = UnliftedArray x-  null (UnliftedArray a) = case sizeofArrayArray# a of-    0# -> True-    _ -> False-  equalsMutable = 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-  singleton a = runST (newUnliftedArray 1 a >>= unsafeFreezeUnliftedArray)-  doubleton a b = runST $ do-    m <- newUnliftedArray 2 a-    writeUnliftedArray m 1 b-    unsafeFreezeUnliftedArray m-  tripleton a b c = runST $ do-    m <- newUnliftedArray 3 a-    writeUnliftedArray m 1 b-    writeUnliftedArray m 2 c-    unsafeFreezeUnliftedArray m-  {-# inline empty #-}-  {-# inline null #-}-  {-# inline new #-}-  {-# inline replicateMutable #-}-  {-# inline index #-}-  {-# inline index# #-}-  {-# inline indexM #-}-  {-# inline read #-}-  {-# inline write #-}-  {-# inline resize #-}-  {-# inline size #-}-  {-# inline sizeMutable #-}-  {-# inline unsafeFreeze #-}-  {-# inline freeze #-}-  {-# inline thaw #-}-  {-# inline copy #-}-  {-# inline copyMutable #-}-  {-# inline clone #-}-  {-# inline cloneMutable #-}-  {-# inline equals #-}-  {-# inline equalsMutable #-}-  {-# inline unlift #-}-  {-# inline lift #-}-  {-# inline singleton #-}-  {-# inline doubleton #-}-  {-# inline tripleton #-}-  {-# inline rnf #-}--errorThunk :: a-errorThunk = error "Contiguous typeclass: unitialized element"-{-# noinline errorThunk #-}--freezePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)-freezePrimArray !src !off !len = do-  dst <- newPrimArray len-  copyMutablePrimArray dst 0 src off len-  unsafeFreezePrimArray dst-{-# inline freezePrimArray #-}--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))-  pure dst-{-# inline resizeArray #-}--resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)-resizeSmallArray !src !sz = do-  dst <- newSmallArray sz errorThunk-  copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src))-  pure dst-{-# inline resizeSmallArray #-}--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))-  pure dst-{-# inline resizeUnliftedArray #-}---- | Append two arrays.-append :: (Contiguous arr, Element arr a) => arr a -> arr a -> arr a-append !a !b = runST $ do-  let !szA = size a-  let !szB = size b-  m <- new (szA + szB)-  copy m 0 a 0 szA-  copy m szA b 0 szB-  unsafeFreeze m-{-# inline append #-}---- | Map over the elements of an array with the index.-imap :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => (Int -> b -> c) -> arr1 b -> arr2 c-imap f a = runST $ do-  mb <- new (size a)-  let go !i-        | i == size a = pure ()-        | otherwise = do-            x <- indexM a i-            write mb i (f i x)-            go (i+1)-  go 0-  unsafeFreeze mb-{-# inline imap #-}---- | Map strictly over the elements of an array with the index.------   Note that because a new array must be created, the resulting---   array type can be /different/ than the original.-imap' :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => (Int -> b -> c) -> arr1 b -> arr2 c-imap' f a = runST $ do-  mb <- new (size a)-  let go !i-        | i == size a = pure ()-        | otherwise = do-            x <- indexM a i-            let !b = f i x-            write mb i b-            go (i + 1)-  go 0-  unsafeFreeze mb -{-# INLINABLE imap' #-}---- | Map over the elements of an array.------   Note that because a new array must be created, the resulting---   array type can be /different/ than the original.-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-        | i == size a = pure ()-        | otherwise = do-            x <- indexM a i-            write mb i (f x)-            go (i+1)-  go 0-  unsafeFreeze mb-{-# inline map #-}---- | Map strictly over the elements of an array.------   Note that because a new array must be created, the resulting---   array type can be /different/ than the original.-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-        | i == size a = pure ()-        | otherwise = do-            x <- indexM a i-            let !b = f x-            write mb i b-            go (i+1)-  go 0-  unsafeFreeze mb-{-# inline map' #-}---- | Convert one type of array into another.-convert :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 b) => arr1 b -> arr2 b-convert a = map id a-{-# inline convert #-}---- | Right fold over the element of an array.-foldr :: (Contiguous arr, Element arr a) => (a -> b -> b) -> b -> arr a -> b-{-# inline foldr #-}-foldr f z arr = go 0-  where-    !sz = size arr-    go !i-      | sz > i = case index# arr i of-          (# x #) -> f x (go (i+1))-      | otherwise = z---- | Strict right fold over the elements of an array.-foldr' :: (Contiguous arr, Element arr a) => (a -> b -> b) -> b -> arr a -> b-foldr' f !z !ary =-  let-    go i !acc-      | i == -1 = acc-      | !(# x #) <- index# ary i-      = go (i-1) (f x acc)-  in go (size ary - 1) z-{-# inline foldr' #-}---- | Left fold over the elements of an array.-foldl :: (Contiguous arr, Element arr a) => (b -> a -> b) -> b -> arr a -> b-foldl f z ary = go 0 z-  where-    !sz = size ary-    go !i acc-      | i == sz = acc-      | otherwise = let (# x #) = index# ary i in go (i+1) (f acc x)---- | Strict left fold over the elements of an array.-foldl' :: (Contiguous arr, Element arr a) => (b -> a -> b) -> b -> arr a -> b-foldl' f !z !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | !(# x #) <- index# ary i = go (i+1) (f acc x)-  in go 0 z-{-# inline foldl' #-}---- | Strict left fold over the elements of an array, where the accumulating---   function cares about the index of the element.-ifoldl' :: (Contiguous arr, Element arr a) => (b -> Int -> a -> b) -> b -> arr a -> b-ifoldl' f !z !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | (# x #) <- index# ary i = go (i+1) (f acc i x)-  in go 0 z-{-# inline ifoldl' #-}---- | Strict right fold over the elements of an array, where the accumulating---   function cares about the index of the element.-ifoldr' :: (Contiguous arr, Element arr a) => (Int -> a -> b -> b) -> b -> arr a -> b-ifoldr' f !z !arr =-  let !sz = size arr-      go !i !acc = if i == (-1)-        then acc-        else let !(# x #) = index# arr i in go (i-1) (f i x acc)-   in go (sz-1) z-{-# inline ifoldr' #-}-             --- | 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-{-# inline foldMap #-}---- | Strict monoidal fold over the elements of an array.-foldMap' :: (Contiguous arr, Element arr a, Monoid m)-  => (a -> m) -> arr a -> m-foldMap' f !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | (# x #) <- index# ary i = go (i+1) (mappend acc (f x))-  in go 0 mempty-{-# inline foldMap' #-}---- | Strict left monoidal fold over the elements of an array.-foldlMap' :: (Contiguous arr, Element arr a, Monoid m)-  => (a -> m) -> arr a -> m-foldlMap' f !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | (# x #) <- index# ary i = go (i+1) (mappend acc (f x))-  in go 0 mempty-{-# inline foldlMap' #-}---- | Strict monoidal fold over the elements of an array.-ifoldlMap' :: (Contiguous arr, Element arr a, Monoid m)-  => (Int -> a -> m)-  -> arr a-  -> m-ifoldlMap' f !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | (# x #) <- index# ary i = go (i+1) (mappend acc (f i x))-  in go 0 mempty-{-# inline ifoldlMap' #-}---- | Strict monoidal fold over the elements of an array.-ifoldlMap1' :: (Contiguous arr, Element arr a, Semigroup m)-  => (Int -> a -> m)-  -> arr a-  -> m-ifoldlMap1' f !ary =-  let-    !sz = size ary-    go !i !acc-      | i == sz = acc-      | (# x #) <- index# ary i = go (i+1) (acc <> f i x)-    !(# e0 #) = index# ary 0-  in go 1 (f 0 e0)-{-# inline ifoldlMap1' #-}---- | Strict left monadic fold over the elements of an array.-foldlM' :: (Contiguous arr, Element arr a, Monad m) => (b -> a -> m b) -> b -> arr a -> m b-foldlM' f z0 arr = go 0 z0-  where-    !sz = size arr-    go !i !acc1-      | i < sz = do-          let (# x #) = index# arr i-          acc2 <- f acc1 x-          go (i + 1) acc2-      | otherwise = pure acc1-{-# inline foldlM' #-}---- | Drop elements that do not satisfy the predicate.-filter :: (Contiguous arr, Element arr a)-  => (a -> Bool)-  -> arr a-  -> arr a-filter p arr = ifilter (\_ a -> p a) arr-{-# inline filter #-}---- | Drop elements that do not satisfy the predicate which---   is applied to values and their indices.-ifilter :: (Contiguous arr, Element arr a)-  => (Int -> a -> Bool)-  -> arr a-  -> arr a-ifilter p arr = runST $ do-  marr :: MutablePrimArray s Word8 <- newPrimArray sz-  let go1 :: Int -> Int -> ST s Int-      go1 !ix !numTrue = if ix < sz-        then do-          atIx <- indexM arr ix-          let !keep = p ix atIx-          let !keepTag = I# (dataToTag# keep)-          writePrimArray marr ix (fromIntegral keepTag)-          go1 (ix + 1) (numTrue + keepTag)-        else pure numTrue-  numTrue <- go1 0 0-  if numTrue == sz-    then pure arr-    else do-      marrTrues <- new numTrue-      let go2 !ixSrc !ixDst = if ixDst < numTrue-            then do-              atIxKeep <- readPrimArray marr ixSrc-              if isTrue atIxKeep-                then do-                  atIxVal <- indexM arr ixSrc-                  write marrTrues ixDst atIxVal-                  go2 (ixSrc + 1) (ixDst + 1)-                else go2 (ixSrc + 1) ixDst-            else pure ()-      go2 0 0-      unsafeFreeze marrTrues -  where-    !sz = size arr-{-# inline ifilter #-}---- | The 'mapMaybe' function is a version of 'map' which can throw out elements.---   In particular, the functional arguments returns something of type @'Maybe' b@.---   If this is 'Nothing', no element is added on to the result array. If it is---   @'Just' b@, then @b@ is included in the result array.-mapMaybe :: forall arr1 arr2 a b. (Contiguous arr1, Element arr1 a, Contiguous arr2, Element arr2 b)-  => (a -> Maybe b)-  -> arr1 a-  -> arr2 b-mapMaybe f arr = runST $ do-  let !sz = size arr -  let go :: Int -> Int -> [b] -> ST s ([b],Int)-      go !ix !numJusts justs = if ix < sz-        then do-          atIx <- indexM arr ix-          case f atIx of-            Nothing -> go (ix+1) numJusts justs-            Just x -> go (ix+1) (numJusts+1) (x:justs) -        else pure (justs,numJusts)-  !(bs,!numJusts) <- go 0 0 []-  !marr <- unsafeFromListReverseMutableN numJusts bs-  unsafeFreeze marr -{-# inline mapMaybe #-}--{-# inline isTrue #-}-isTrue :: Word8 -> Bool-isTrue 0 = False-isTrue _ = True--thawPrimArray :: (PrimMonad m, Prim a) => PrimArray a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)-thawPrimArray !arr !off !len = do-  marr <- newPrimArray len-  copyPrimArray marr 0 arr off len-  pure marr-{-# inline thawPrimArray #-}--clonePrimArray :: Prim a => PrimArray a -> Int -> Int -> PrimArray a-clonePrimArray !arr !off !len = runST $ do-  marr <- newPrimArray len-  copyPrimArray marr 0 arr off len-  unsafeFreezePrimArray marr-{-# inline clonePrimArray #-}--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-  pure marr-{-# inline cloneMutablePrimArray #-}---- | @'replicate' n x@ is an array of length @n@ with @x@ the value of every element.-replicate :: (Contiguous arr, Element arr a) => Int -> a -> arr a-replicate n x = create (replicateMutable n x)-{-# inline replicate #-}---- | @'replicateMutableM' n act@ performs the action n times, gathering the results.-replicateMutableM :: (PrimMonad m, Contiguous arr, Element arr a)-  => Int-  -> m a-  -> m (Mutable arr (PrimState m) a)-replicateMutableM len act = do-  marr <- new len-  let go !ix = if ix < len-        then do-          x <- act-          write marr ix x-          go (ix + 1)-        else pure ()-  go 0-  pure marr-{-# inline replicateMutableM #-}--replicateMutablePrimArray :: (PrimMonad m, Prim a)-  => Int -- ^ length-  -> a -- ^ element-  -> m (MutablePrimArray (PrimState m) a)-replicateMutablePrimArray len a = do-  marr <- newPrimArray len-  setPrimArray marr 0 len a-  pure marr-{-# inline replicateMutablePrimArray #-}--replicateSmallMutableArray :: (PrimMonad m)-  => Int-  -> a-  -> m (SmallMutableArray (PrimState m) a)-replicateSmallMutableArray len a = do-  marr <- newSmallArray len errorThunk-  let go !ix = if ix < len-        then writeSmallArray marr ix a >> go (ix + 1)-        else pure ()-  go 0-  pure marr-{-# inline replicateSmallMutableArray #-}---- | Create an array from a list. If the given length does--- not match the actual length, this function has undefined--- behavior.-unsafeFromListN :: (Contiguous arr, Element arr a)-  => Int -- ^ length of list-  -> [a] -- ^ list-  -> arr a-unsafeFromListN n l = create (unsafeFromListMutableN n l)-{-# inline unsafeFromListN #-}--unsafeFromListMutableN :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> [a]-  -> m (Mutable arr (PrimState m) a)-unsafeFromListMutableN n l = do-  m <- new n-  let go !_ [] = pure m-      go !ix (x : xs) = do-        write m ix x-        go (ix+1) xs-  go 0 l-{-# inline unsafeFromListMutableN #-}---- | Create a mutable array from a list, reversing the order of---   the elements. If the given length does not match the actual length,---   this function has undefined behavior.-unsafeFromListReverseMutableN :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> [a]-  -> m (Mutable arr (PrimState m) a)-unsafeFromListReverseMutableN n l = do-  m <- new n-  let go !_ [] = pure m-      go !ix (x : xs) = do-        write m ix x-        go (ix-1) xs-  go (n - 1) l-{-# inline unsafeFromListReverseMutableN #-}- --- | Create an array from a list, reversing the order of the--- elements. If the given length does not match the actual length,--- this function has undefined behavior.-unsafeFromListReverseN :: (Contiguous arr, Element arr a)-  => Int-  -> [a]-  -> arr a-unsafeFromListReverseN n l = create (unsafeFromListReverseMutableN n l)-{-# inline unsafeFromListReverseN #-}---- | Map over a mutable array, modifying the elements in place.-mapMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => (a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-mapMutable f = \ !mary -> do-  !sz <- sizeMutable mary-  let go !ix = if ix < sz-        then do-          a <- read mary ix-          write mary ix (f a)-          go (ix + 1)-        else pure ()-  go 0-{-# inline mapMutable #-}---- | Strictly map over a mutable array, modifying the elements in place.-mapMutable' :: (PrimMonad m, Contiguous arr, Element arr a)-  => (a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-mapMutable' f = \ !mary -> do-  !sz <- sizeMutable mary-  let-    go !i-      | i == sz = pure ()-      | otherwise = do-          a <- read mary i-          let !b = f a-          write mary i b-          go (i + 1)-  go 0-{-# inline mapMutable' #-}---- | Map over a mutable array with indices, modifying the elements in place.-imapMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => (Int -> a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-imapMutable f = \ !mary -> do-  !sz <- sizeMutable mary-  let go !ix = if ix < sz-        then do-          a <- read mary ix-          write mary ix (f ix a)-          go (ix + 1)-        else pure ()-  go 0-{-# inline imapMutable #-}---- | Strictly map over a mutable array with indices, modifying the elements in place.-imapMutable' :: (PrimMonad m, Contiguous arr, Element arr a)-  => (Int -> a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-imapMutable' f = \ !mary -> do-  !sz <- sizeMutable mary-  let-    go !i-      | i == sz = pure ()-      | otherwise = do-          a <- read mary i-          let !b = f i a-          write mary i b-          go (i + 1)-  go 0-{-# inline imapMutable' #-}---- | Map each element of the array to an action, evaluate these---   actions from left to right, and collect the results in a---   new array.-traverseP :: (PrimMonad m, Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b)-  => (a -> m b)-  -> arr1 a-  -> m (arr2 b)-traverseP f = \ !ary ->-  let-    !sz = size ary-    go !i !mary-      | i == sz = unsafeFreeze mary-      | otherwise = do-          a <- indexM ary i-          b <- f a-          write mary i b-          go (i + 1) mary-  in do-      mary <- new sz-      go 0 mary-{-# inline traverseP #-}--newtype STA v a = STA {_runSTA :: forall s. Mutable v s a -> ST s (v a)}--runSTA :: (Contiguous v, Element v a) => Int -> STA v a -> v a-runSTA !sz (STA m) = runST $ new sz >>= \ ar -> m ar-{-# inline runSTA #-}---- | Map each element of the array to an action, evaluate these---   actions from left to right, and collect the results.---   For a version that ignores the results, see 'traverse_'.-traverse :: (Contiguous arr, Element arr a, Element arr b, Applicative f)-  => (a -> f b)-  -> arr a-  -> f (arr b)-traverse f = \ !ary ->-  let-    !len = size ary-    go !i-      | i == len = pure $ STA $ \mary -> unsafeFreeze mary-      | (# x #) <- index# ary i-      = liftA2 (\b (STA m) -> STA $ \mary ->-                  write mary i b >> m mary)-               (f x) (go (i + 1))-  in if len == 0-     then pure empty-     else runSTA len <$> go 0-{-# inline traverse #-}---- | Map each element of the array to an action, evaluate these---   actions from left to right, and ignore the results.---   For a version that doesn't ignore the results, see 'traverse'.-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 ()-{-# inline traverse_ #-}---- | Map each element of the array and its index to an action,---   evaluating these actions from left to right.-itraverse ::-     (Contiguous arr, Element arr a, Element arr b, Applicative f)-  => (Int -> a -> f b)-  -> arr a-  -> f (arr b)-itraverse f ary =-  let !len = size ary-      go !ix-        | ix == len = pure $ STA $ \mary -> unsafeFreeze mary-        | (# x #) <- index# ary ix-        = liftA2 (\b (STA m) -> STA $ \mary ->-                   write mary ix b >> m mary)-                 (f ix x) (go (ix + 1))-   in if len == 0-        then pure empty-        else runSTA len <$> go 0-{-# inline itraverse #-}---- | Map each element of the array and its index to an action,---   evaluate these actions from left to right, and ignore the results.---   For a version that doesn't ignore the results, see 'itraverse'.-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 ()-{-# inline itraverse_ #-}---- | Construct an array of the given length by applying---   the function to each index.-generate :: (Contiguous arr, Element arr a)-  => Int-  -> (Int -> a)-  -> arr a-generate len f = runST (generateMutable len f >>= unsafeFreeze)-{-# inline generate #-}---- | Construct a mutable array of the given length by applying---   the function to each index.-generateMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> (Int -> a)-  -> m (Mutable arr (PrimState m) a)-generateMutable len f = generateMutableM len (pure . f)-{-# inline generateMutable #-}---- | Construct a mutable array of the given length by applying---   the monadic action to each index.-generateMutableM :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> (Int -> m a)-  -> m (Mutable arr (PrimState m) a)-generateMutableM !len f = do-  marr <- new len-  let go !ix = if ix < len-        then do-          x <- f ix-          write marr ix x-          go (ix + 1)-        else pure ()-  go 0-  pure marr-{-# inline generateMutableM #-}---- | Apply a function @n@ times to a value and construct an array---   where each consecutive element is the result of an additional---   application of this function. The zeroth element is the original value.------   @'iterateN' 5 ('+' 1) 0 = 'fromListN' 5 [0,1,2,3,4]@-iterateN :: (Contiguous arr, Element arr a)-  => Int-  -> (a -> a)-  -> a-  -> arr a-iterateN len f z0 = runST (iterateMutableN len f z0 >>= unsafeFreeze)-{-# inline iterateN #-}---- | Apply a function @n@ times to a value and construct a mutable array---   where each consecutive element is the result of an additional---   application of this function. The zeroth element is the original value.-iterateMutableN :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> (a -> a)-  -> a -  -> m (Mutable arr (PrimState m) a)-iterateMutableN len f z0 = iterateMutableNM len (pure . f) z0-{-# inline iterateMutableN #-}---- | Apply a monadic function @n@ times to a value and construct a mutable array---   where each consecutive element is the result of an additional---   application of this function. The zeroth element is the original value.-iterateMutableNM :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> (a -> m a)-  -> a-  -> m (Mutable arr (PrimState m) a)-iterateMutableNM !len f z0 = do-  marr <- new len-  -- we are strict in the accumulator because-  -- otherwise we could build up a ton of `f (f (f (f .. (f a))))`-  -- thunks for no reason.-  let go !ix !acc-        | ix <= 0 = write marr ix z0 >> go (ix + 1) z0-        | ix == len = pure ()-        | otherwise = do-            a <- f acc-            write marr ix a-            go (ix + 1) a-  go 0 z0-  pure marr-{-# inline iterateMutableNM #-}---- | Execute the monad action and freeze the resulting array.-create :: (Contiguous arr, Element arr a)-  => (forall s. ST s (Mutable arr s a))-  -> arr a-create x = runST (unsafeFreeze =<< x)-{-# inline create #-}---- | Execute the monadic action and freeze the resulting array.-createT :: (Contiguous arr, Element arr a, Traversable f)-  => (forall s. ST s (f (Mutable arr s a)))-  -> f (arr a)-createT p = runST (mapM unsafeFreeze =<< p)-{-# inline createT #-}---- | Construct an array by repeatedly applying a generator---   function to a seed. The generator function yields 'Just' the---   next element and the new seed or 'Nothing' if there are no more---   elements.------ >>> unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1) 10---     <10,9,8,7,6,5,4,3,2,1>---- Unfortunately, because we don't know ahead of time when to stop,--- we need to construct a list and then turn it into an array.-unfoldr :: (Contiguous arr, Element arr a)-  => (b -> Maybe (a,b))-  -> b-  -> arr a-unfoldr f z0 = create (unfoldrMutable f z0)-{-# inline unfoldr #-}---- | Construct a mutable array by repeatedly applying a generator---   function to a seed. The generator function yields 'Just' the---   next element and the new seed or 'Nothing' if there are no more---   elements.------ >>> unfoldrMutable (\n -> if n == 0 then Nothing else Just (n,n-1) 10---     <10,9,8,7,6,5,4,3,2,1>---- Unfortunately, because we don't know ahead of time when to stop,--- we need to construct a list and then turn it into an array.-unfoldrMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => (b -> Maybe (a,b))-  -> b-  -> m (Mutable arr (PrimState m) a)-unfoldrMutable f z0 = do-  let go !sz s !xs = case f s of-        Nothing -> pure (sz,xs)-        Just (x,s') -> go (sz + 1) s' (x : xs)-  (sz,xs) <- go 0 z0 []-  unsafeFromListReverseMutableN sz xs-{-# inline unfoldrMutable #-}---- | Construct an array with at most n elements by repeatedly---   applying the generator function to a seed. The generator function---   yields 'Just' the next element and the new seed or 'Nothing' if---   there are no more elements.-unfoldrN :: (Contiguous arr, Element arr a)-  => Int-  -> (b -> Maybe (a, b))-  -> b-  -> arr a-unfoldrN maxSz f z0 = create (unfoldrMutableN maxSz f z0)-{-# inline unfoldrN #-}---- | Construct a mutable array with at most n elements by repeatedly---   applying the generator function to a seed. The generator function---   yields 'Just' the next element and the new seed or 'Nothing' if---   there are no more elements.-unfoldrMutableN :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> (b -> Maybe (a, b))-  -> b-  -> m (Mutable arr (PrimState m) a)-unfoldrMutableN !maxSz f z0 = do-  m <- new maxSz-  let go !ix s = if ix < maxSz-        then case f s of-          Nothing -> pure ix-          Just (x,s') -> do-            write m ix x-            go (ix + 1) s'-        else pure ix-  sz <- go 0 z0-  case compare maxSz sz of-    EQ -> pure m-    GT -> resize m sz-    LT -> error "Data.Primitive.Contiguous.unfoldrMutableN: internal error"-{-# inline unfoldrMutableN #-}---- | Convert an array to a list.-toList :: (Contiguous arr, Element arr a)-  => arr a-  -> [a]-toList arr = build (\c n -> foldr c n arr)-{-# inline toList #-}---- | Convert a mutable array to a list.---- I don't think this can be expressed in terms of foldr/build,--- so we just loop through the array. -toListMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => Mutable arr (PrimState m) a-  -> m [a]-toListMutable marr = do-  sz <- sizeMutable marr-  let go !ix !acc = if ix >= 0-        then do-          x <- read marr ix-          go (ix - 1) (x : acc)-        else pure acc-  go (sz - 1) []-{-# inline toListMutable #-}---- | Given an 'Int' that is representative of the length of---   the list, convert the list into a mutable array of the---   given length.------   /Note/: calls 'error' if the given length is incorrect.-fromListMutableN :: (Contiguous arr, Element arr a, PrimMonad m)-  => Int-  -> [a]-  -> m (Mutable arr (PrimState m) a)-fromListMutableN len vs = do-  marr <- new len-  let go [] !ix = if ix == len-        then pure ()-        else error "Data.Primitive.Contiguous.fromListN: list length less than specified size."-      go (a:as) !ix = if ix < len-        then do-          write marr ix a-          go as (ix + 1)-        else error "Data.Primitive.Contiguous.fromListN: list length greater than specified size."-  go vs 0-  pure marr -{-# inline fromListMutableN #-}---- | Convert a list into a mutable array of the given length.-fromListMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => [a]-  -> m (Mutable arr (PrimState m) a)-fromListMutable xs = fromListMutableN (length xs) xs-{-# inline fromListMutable #-}---- | Given an 'Int' that is representative of the length of---   the list, convert the list into a mutable array of the---   given length.------   /Note/: calls 'error' if the given length is incorrect.-fromListN :: (Contiguous arr, Element arr a)-  => Int-  -> [a]-  -> arr a-fromListN len vs = create (fromListMutableN len vs)-{-# inline fromListN #-}---- | Convert a list into an array.-fromList :: (Contiguous arr, Element arr a)-  => [a]-  -> arr a-fromList vs = create (fromListMutable vs)-{-# inline fromList #-}---- | Modify the elements of a mutable array in-place.-modify :: (Contiguous arr, Element arr a, PrimMonad m)-  => (a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-modify f marr = do-  !sz <- sizeMutable marr-  let go !ix = if ix < sz-        then do-          x <- read marr ix-          write marr ix (f x)-          go (ix + 1)-        else pure ()-  go 0-{-# inline modify #-}---- | Strictly modify the elements of a mutable array in-place.-modify' :: (Contiguous arr, Element arr a, PrimMonad m)-  => (a -> a)-  -> Mutable arr (PrimState m) a-  -> m ()-modify' f marr = do-  !sz <- sizeMutable marr-  let go !ix = if ix < sz-        then do-          x <- read marr ix-          let !y = f x-          write marr ix y-          go (ix + 1)-        else pure ()-  go 0-{-# inline modify' #-}---- | Yield an array of the given length containing the values---   @x, 'succ' x, 'succ' ('succ' x)@ etc.-enumFromN :: (Contiguous arr, Element arr a, Enum a)-  => a-  -> Int-  -> arr a-enumFromN z0 sz = create (enumFromMutableN z0 sz)-{-# inline enumFromN #-}---- | Yield a mutable array of the given length containing the values---   @x, 'succ' x, 'succ' ('succ' x)@ etc.-enumFromMutableN :: (Contiguous arr, Element arr a, PrimMonad m, Enum a)-  => a-  -> Int-  -> m (Mutable arr (PrimState m) a)-enumFromMutableN z0 !sz = do-  m <- new sz-  let go !ix z = if ix < sz-        then do-          write m ix z-          go (ix + 1) (succ z)-        else pure m-  go 0 z0-{-# inline enumFromMutableN #-}---- | Lift an accumulating hash function over the elements of the array,---   returning the final accumulated hash.-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-{-# inline liftHashWithSalt #-}---- | Reverse the elements of an array.-reverse :: (Contiguous arr, Element arr a)-  => arr a-  -> arr a-reverse arr = runST $ do-  marr <- new sz-  copy marr 0 arr 0 sz-  reverseMutable marr-  unsafeFreeze marr-  where-    !sz = size arr-{-# inline reverse #-}---- | Reverse the elements of a mutable array, in-place.-reverseMutable :: (Contiguous arr, Element arr a, PrimMonad m)-  => Mutable arr (PrimState m) a-  -> m ()-reverseMutable marr = do-  !sz <- sizeMutable marr-  let go !start !end = if start >= end-        then pure ()-        else do-          tmp <- read marr start-          write marr start =<< read marr end-          write marr end tmp-          go (start+1) (end-1)-  go 0 (sz-1)-{-# inline reverseMutable #-}---- | 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-{-# inline hashIntWithSalt #-}--combine :: Int -> Int -> Int-combine h1 h2 = (h1 * 16777619) `xor` h2-{-# inline combine #-}+{-# language+        BangPatterns+      , FlexibleInstances+      , LambdaCase+      , MagicHash+      , RankNTypes+      , ScopedTypeVariables+      , TypeFamilies+      , TypeFamilyDependencies+      , UnboxedTuples+  #-}++-- | The contiguous typeclass parameterises over a contiguous array type.+--   This allows us to have a common API to a number of contiguous+--   array types and their mutable counterparts.+module Data.Primitive.Contiguous+  (+    -- * Accessors+    -- ** Length Information+    size+  , sizeMutable+  , null+    -- ** Indexing+  , index+  , index#+  , read+    -- ** Monadic indexing+  , indexM++    -- * Construction+    -- ** Initialisation+  , empty+  , new+  , singleton+  , doubleton+  , tripleton+  , replicate+  , replicateMutable+  , generate+  , generateM+  , generateMutable+  , iterateN+  , iterateMutableN+  , write+    -- ** Monadic initialisation+  , replicateMutableM+  , generateMutableM+  , iterateMutableNM+  , create+  , createT+    -- ** Unfolding+  , unfoldr+  , unfoldrN+  , unfoldrMutable+    -- ** Enumeration+  , enumFromN+  , enumFromMutableN+    -- ** Concatenation+  , append+    -- * Modifying arrays+    -- ** Permutations+  , reverse+  , reverseMutable+  , reverseSlice++    -- ** Resizing+  , resize++    -- * Elementwise operations+    -- ** Mapping+  , map+  , map'+  , mapMutable+  , mapMutable'+  , imap+  , imap'+  , imapMutable+  , imapMutable'+  , modify+  , modify'+  , mapMaybe++    -- ** Zipping+  , zip+  , zipWith++    -- ** Specific elements+  , swap++    -- * Working with predicates+    -- ** Filtering+  , filter+  , ifilter+  , catMaybes+  , lefts+  , rights+  , partitionEithers+    -- ** Searching+  , find+  , elem+  , maximum+  , minimum+  , maximumBy+  , minimumBy+    -- ** Comparing for equality+  , equals+  , equalsMutable+  , same++    -- * Folds+  , foldl+  , foldl'+  , foldr+  , foldr'+  , foldMap+  , foldMap'+  , foldlMap'+  , ifoldl'+  , ifoldr'+  , ifoldlMap'+  , ifoldlMap1'+  , foldlM'+  , asum++    -- * Traversals+  , traverse+  , traverse_+  , itraverse+  , itraverse_+  , traverseP+  , mapM+  , forM+  , mapM_+  , forM_+  , for+  , for_+  , sequence+  , sequence_++    -- * Typeclass method defaults+  , (<$)+  , ap++    -- * Prefix sums (scans)+  , scanl+  , scanl'+  , iscanl+  , iscanl'+  , prescanl+  , prescanl'+  , iprescanl+  , iprescanl'+  --, postscanl+  --, ipostscanl++    -- * Conversions+    -- ** Lists+  , fromList+  , fromListN+  , fromListMutable+  , fromListMutableN+  , unsafeFromListN+  , unsafeFromListReverseN+  , unsafeFromListReverseMutableN+  , toList+  , toListMutable+    -- ** Other array types+  , convert+  , lift+  , unlift+    -- ** Between mutable and immutable variants+  , clone+  , cloneMutable+  , copy+  , copyMutable+  , freeze+  , thaw+  , unsafeFreeze++    -- * Hashing+  , liftHashWithSalt++    -- * Forcing an array and its contents+  , rnf++    -- * Classes+  , Contiguous(Mutable,Element)+  , Always++    -- * Re-Exports+  , Array+  , MutableArray+  , SmallArray+  , SmallMutableArray+  , PrimArray+  , MutablePrimArray+  , UnliftedArray+  , MutableUnliftedArray+  ) where++import Prelude hiding (map,foldr,foldMap,traverse,read,filter,replicate,null,reverse,foldl,foldr,zip,zipWith,scanl,(<$),elem,maximum,minimum,mapM,mapM_,sequence,sequence_)+import Control.Applicative (liftA2)+import Control.DeepSeq (NFData)+import Control.Monad (when)+import Control.Monad.Primitive+import Control.Monad.ST (runST,ST)+import Data.Bits (xor)+import Data.Coerce (coerce)+import Data.Kind (Type)+import Data.Primitive hiding (fromList,fromListN)+import Data.Primitive.Unlifted.Array+import Data.Primitive.Unlifted.Class (PrimUnlifted)+import Data.Semigroup (Semigroup,(<>),First(..))+import Data.Word (Word8)+import GHC.Base (build)+import GHC.Exts (MutableArrayArray#,ArrayArray#,Constraint,sizeofByteArray#,sizeofArray#,sizeofArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#,dataToTag#,Int(..))++import qualified Control.DeepSeq as DS+import qualified Control.Applicative as A+import qualified Prelude++-- | 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++-- | The 'Contiguous' typeclass as an interface to a multitude of+--   contiguous structures.+class Contiguous (arr :: Type -> Type) where+  -- | The Mutable counterpart to the array.+  type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr+  -- | The constraint needed to store elements in the array.+  type family Element arr :: Type -> Constraint+  -- | The empty array.+  empty :: arr a+  -- | Test whether the array is empty.+  null :: arr b -> Bool+  -- | Allocate a new mutable array of the given size.+  new :: (PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b)+  -- | @'replicateMutable' n x@ is a mutable array of length @n@ with @x@ the value of every element.+  replicateMutable :: (PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)+  -- | Index into an array at the given index.+  index :: Element arr b => arr b -> Int -> b+  -- | Index into an array at the given index, yielding an unboxed one-tuple of the element.+  index# :: Element arr b => arr b -> Int -> (# b #)+  -- | Indexing in a monad.+  --+  --   The monad allows operations to be strict in the array+  --   when necessary. Suppose array copying is implemented like this:+  --+  --   > copy mv v = ... write mv i (v ! i) ...+  --+  --   For lazy arrays, @v ! i@ would not be not be evaluated,+  --   which means that @mv@ would unnecessarily retain a reference+  --   to @v@ in each element written.+  --+  --   With 'indexM', copying can be implemented like this instead:+  --+  --   > copy mv v = ... do+  --   >   x <- indexM v i+  --   >   write mv i x+  --+  --   Here, no references to @v@ are retained because indexing+  --   (but /not/ the elements) is evaluated eagerly.+  indexM :: (Element arr b, Monad m) => arr b -> Int -> m b+  -- | Read a mutable array at the given index.+  read :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m b+  -- | Write to a mutable array at the given index.+  write :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> b -> m ()+  -- | Resize an array into one with the given size.+  resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)+  -- | The size of the array+  size :: Element arr b => arr b -> Int+  -- | The size of the mutable array+  sizeMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int+  -- | Turn a mutable array into an immutable one without copying.+  --   The mutable array should not be used after this conversion.+  unsafeFreeze :: PrimMonad m => Mutable arr (PrimState m) b -> m (arr b)+  -- | Turn a mutable array into an immutable one with copying, using a slice of the mutable array.+  freeze :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)+  -- | Copy a slice of an immutable array into a new mutable array.+  thaw :: (PrimMonad m, Element arr b) => arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)+  -- | Copy a slice of an array into a mutable array.+  copy :: (PrimMonad m, Element arr b)+    => Mutable arr (PrimState m) b -- ^ destination array+    -> Int -- ^ offset into destination array+    -> arr b -- ^ source array+    -> Int -- ^ offset into source array+    -> Int -- ^ number of elements to copy+    -> m ()+  -- | Copy a slice of a mutable array into another mutable array.+  --   In the case that the destination and source arrays are the+  --   same, the regions may overlap.+  copyMutable :: (PrimMonad m, Element arr b)+    => Mutable arr (PrimState m) b -- ^ destination array+    -> Int -- ^ offset into destination array+    -> Mutable arr (PrimState m) b -- ^ source array+    -> Int -- ^ offset into source array+    -> Int -- ^ number of elements to copy+    -> m ()+  -- | Clone a slice of an array.+  clone :: Element arr b+    => arr b+    -> Int+    -> Int+    -> arr b+  -- | Clone a slice of a mutable array.+  cloneMutable :: (PrimMonad m, Element arr b)+    => Mutable arr (PrimState m) b+    -> Int+    -> Int+    -> m (Mutable arr (PrimState m) b)+  -- | Test the two arrays for equality.+  equals :: (Element arr b, Eq b) => arr b -> arr b -> Bool+  -- | Test the two mutable arrays for pointer equality.+  --   Does not check equality of elements.+  equalsMutable :: Mutable arr s a -> Mutable arr s a -> Bool+  -- | Unlift an array into an 'ArrayArray#'.+  unlift :: arr b -> ArrayArray#+  -- | Lift an 'ArrayArray#' into an array.+  lift :: ArrayArray# -> arr b+  -- | Create a singleton array.+  singleton :: Element arr a => a -> arr a+  -- | Create a doubleton array.+  doubleton :: Element arr a => a -> a -> arr a+  -- | Create a tripleton array.+  tripleton :: Element arr a => a -> a -> a -> arr a+  -- | Reduce the array and all of its elements to WHNF.+  rnf :: (NFData a, Element arr a) => arr a -> ()++instance Contiguous SmallArray where+  type Mutable SmallArray = SmallMutableArray+  type Element SmallArray = Always+  empty = mempty+  new n = newSmallArray n errorThunk+  index = indexSmallArray+  indexM = indexSmallArrayM+  index# = indexSmallArray##+  read = readSmallArray+  write = writeSmallArray+  null a = case sizeofSmallArray a of+    0 -> True+    _ -> False+  freeze = freezeSmallArray+  size = sizeofSmallArray+  sizeMutable = (\x -> pure $! sizeofSmallMutableArray x)+  unsafeFreeze = unsafeFreezeSmallArray+  thaw = thawSmallArray+  equals = (==)+  equalsMutable = (==)+  singleton a = runST $ do+    marr <- newSmallArray 1 errorThunk+    writeSmallArray marr 0 a+    unsafeFreezeSmallArray marr+  doubleton a b = runST $ do+    m <- newSmallArray 2 errorThunk+    writeSmallArray m 0 a+    writeSmallArray m 1 b+    unsafeFreezeSmallArray m+  tripleton a b c = runST $ do+    m <- newSmallArray 3 errorThunk+    writeSmallArray m 0 a+    writeSmallArray m 1 b+    writeSmallArray m 2 c+    unsafeFreezeSmallArray m+  rnf !ary =+    let !sz = sizeofSmallArray ary+        go !ix = if ix < sz+          then+            let !(# x #) = indexSmallArray## ary ix+             in DS.rnf x `seq` go (ix + 1)+          else ()+     in go 0+  clone = cloneSmallArray+  cloneMutable = cloneSmallMutableArray+  lift x = SmallArray (unsafeCoerce# x)+  unlift (SmallArray x) = unsafeCoerce# x+  copy = copySmallArray+  copyMutable = copySmallMutableArray+  replicateMutable = replicateSmallMutableArray+  resize = resizeSmallArray+  {-# inline empty #-}+  {-# inline null #-}+  {-# inline new #-}+  {-# inline replicateMutable #-}+  {-# inline index #-}+  {-# inline index# #-}+  {-# inline indexM #-}+  {-# inline read #-}+  {-# inline write #-}+  {-# inline resize #-}+  {-# inline size #-}+  {-# inline sizeMutable #-}+  {-# inline unsafeFreeze #-}+  {-# inline freeze #-}+  {-# inline thaw #-}+  {-# inline copy #-}+  {-# inline copyMutable #-}+  {-# inline clone #-}+  {-# inline cloneMutable #-}+  {-# inline equals #-}+  {-# inline equalsMutable #-}+  {-# inline unlift #-}+  {-# inline lift #-}+  {-# inline singleton #-}+  {-# inline doubleton #-}+  {-# inline tripleton #-}+  {-# inline rnf #-}++instance Contiguous PrimArray where+  type Mutable PrimArray = MutablePrimArray+  type Element PrimArray = Prim+  empty = mempty+  new = newPrimArray+  replicateMutable = replicateMutablePrimArray+  index = indexPrimArray+  index# arr ix = (# indexPrimArray arr ix #)+  indexM arr ix = pure (indexPrimArray arr ix)+  read = readPrimArray+  write = writePrimArray+  resize = resizeMutablePrimArray+  size = sizeofPrimArray+  sizeMutable = getSizeofMutablePrimArray+  freeze = freezePrimArray+  unsafeFreeze = unsafeFreezePrimArray+  thaw = thawPrimArray+  copy = copyPrimArray+  copyMutable = copyMutablePrimArray+  clone = clonePrimArray+  cloneMutable = cloneMutablePrimArray+  equals = (==)+  unlift (PrimArray x) = unsafeCoerce# x+  lift x = PrimArray (unsafeCoerce# x)+  null (PrimArray a) = case sizeofByteArray# a of+    0# -> True+    _ -> False+  equalsMutable = sameMutablePrimArray+  rnf (PrimArray !_) = ()+  singleton a = runST $ do+    marr <- newPrimArray 1+    writePrimArray marr 0 a+    unsafeFreezePrimArray marr+  doubleton a b = runST $ do+    m <- newPrimArray 2+    writePrimArray m 0 a+    writePrimArray m 1 b+    unsafeFreezePrimArray m+  tripleton a b c = runST $ do+    m <- newPrimArray 3+    writePrimArray m 0 a+    writePrimArray m 1 b+    writePrimArray m 2 c+    unsafeFreezePrimArray m+  {-# inline empty #-}+  {-# inline null #-}+  {-# inline new #-}+  {-# inline replicateMutable #-}+  {-# inline index #-}+  {-# inline index# #-}+  {-# inline indexM #-}+  {-# inline read #-}+  {-# inline write #-}+  {-# inline resize #-}+  {-# inline size #-}+  {-# inline sizeMutable #-}+  {-# inline unsafeFreeze #-}+  {-# inline freeze #-}+  {-# inline thaw #-}+  {-# inline copy #-}+  {-# inline copyMutable #-}+  {-# inline clone #-}+  {-# inline cloneMutable #-}+  {-# inline equals #-}+  {-# inline equalsMutable #-}+  {-# inline unlift #-}+  {-# inline lift #-}+  {-# inline singleton #-}+  {-# inline doubleton #-}+  {-# inline tripleton #-}+  {-# inline rnf #-}++instance Contiguous Array where+  type Mutable Array = MutableArray+  type Element Array = Always+  empty = mempty+  new n = newArray n errorThunk+  replicateMutable = newArray+  index = indexArray+  index# = indexArray##+  indexM = indexArrayM+  read = readArray+  write = writeArray+  resize = resizeArray+  size = sizeofArray+  sizeMutable = (\x -> pure $! sizeofMutableArray x)+  freeze = freezeArray+  unsafeFreeze = unsafeFreezeArray+  thaw = thawArray+  copy = copyArray+  copyMutable = copyMutableArray+  clone = cloneArray+  cloneMutable = cloneMutableArray+  equals = (==)+  unlift (Array x) = unsafeCoerce# x+  lift x = Array (unsafeCoerce# x)+  null (Array a) = case sizeofArray# a of+    0# -> True+    _ -> False+  equalsMutable = 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+  singleton a = runST (newArray 1 a >>= unsafeFreezeArray)+  doubleton a b = runST $ do+    m <- newArray 2 a+    writeArray m 1 b+    unsafeFreezeArray m+  tripleton a b c = runST $ do+    m <- newArray 3 a+    writeArray m 1 b+    writeArray m 2 c+    unsafeFreezeArray m+  {-# inline empty #-}+  {-# inline null #-}+  {-# inline new #-}+  {-# inline replicateMutable #-}+  {-# inline index #-}+  {-# inline index# #-}+  {-# inline indexM #-}+  {-# inline read #-}+  {-# inline write #-}+  {-# inline resize #-}+  {-# inline size #-}+  {-# inline sizeMutable #-}+  {-# inline unsafeFreeze #-}+  {-# inline freeze #-}+  {-# inline thaw #-}+  {-# inline copy #-}+  {-# inline copyMutable #-}+  {-# inline clone #-}+  {-# inline cloneMutable #-}+  {-# inline equals #-}+  {-# inline equalsMutable #-}+  {-# inline unlift #-}+  {-# inline lift #-}+  {-# inline singleton #-}+  {-# inline doubleton #-}+  {-# inline tripleton #-}+  {-# inline rnf #-}++instance Contiguous UnliftedArray where+  type Mutable UnliftedArray = MutableUnliftedArray+  type Element UnliftedArray = PrimUnlifted+  empty = emptyUnliftedArray+  new = unsafeNewUnliftedArray+  replicateMutable = newUnliftedArray+  index = indexUnliftedArray+  index# arr ix = (# indexUnliftedArray arr ix #)+  indexM arr ix = pure (indexUnliftedArray arr ix)+  read = readUnliftedArray+  write = writeUnliftedArray+  resize = resizeUnliftedArray+  size = sizeofUnliftedArray+  sizeMutable = pure . sizeofMutableUnliftedArray+  freeze = freezeUnliftedArray+  unsafeFreeze = unsafeFreezeUnliftedArray+  thaw = thawUnliftedArray+  copy = copyUnliftedArray+  copyMutable = copyMutableUnliftedArray+  clone = cloneUnliftedArray+  cloneMutable = cloneMutableUnliftedArray+  equals = (==)+  unlift (UnliftedArray x) = x+  lift x = UnliftedArray x+  null (UnliftedArray a) = case sizeofArrayArray# a of+    0# -> True+    _ -> False+  equalsMutable = 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+  singleton a = runST (newUnliftedArray 1 a >>= unsafeFreezeUnliftedArray)+  doubleton a b = runST $ do+    m <- newUnliftedArray 2 a+    writeUnliftedArray m 1 b+    unsafeFreezeUnliftedArray m+  tripleton a b c = runST $ do+    m <- newUnliftedArray 3 a+    writeUnliftedArray m 1 b+    writeUnliftedArray m 2 c+    unsafeFreezeUnliftedArray m+  {-# inline empty #-}+  {-# inline null #-}+  {-# inline new #-}+  {-# inline replicateMutable #-}+  {-# inline index #-}+  {-# inline index# #-}+  {-# inline indexM #-}+  {-# inline read #-}+  {-# inline write #-}+  {-# inline resize #-}+  {-# inline size #-}+  {-# inline sizeMutable #-}+  {-# inline unsafeFreeze #-}+  {-# inline freeze #-}+  {-# inline thaw #-}+  {-# inline copy #-}+  {-# inline copyMutable #-}+  {-# inline clone #-}+  {-# inline cloneMutable #-}+  {-# inline equals #-}+  {-# inline equalsMutable #-}+  {-# inline unlift #-}+  {-# inline lift #-}+  {-# inline singleton #-}+  {-# inline doubleton #-}+  {-# inline tripleton #-}+  {-# inline rnf #-}++errorThunk :: a+errorThunk = error "Contiguous typeclass: unitialized element"+{-# noinline errorThunk #-}++freezePrimArray :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)+freezePrimArray !src !off !len = do+  dst <- newPrimArray len+  copyMutablePrimArray dst 0 src off len+  unsafeFreezePrimArray dst+{-# inline freezePrimArray #-}++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))+  pure dst+{-# inline resizeArray #-}++resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)+resizeSmallArray !src !sz = do+  dst <- newSmallArray sz errorThunk+  copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src))+  pure dst+{-# inline resizeSmallArray #-}++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))+  pure dst+{-# inline resizeUnliftedArray #-}++-- | Append two arrays.+append :: (Contiguous arr, Element arr a) => arr a -> arr a -> arr a+append !a !b = runST $ do+  let !szA = size a+  let !szB = size b+  m <- new (szA + szB)+  copy m 0 a 0 szA+  copy m szA b 0 szB+  unsafeFreeze m+{-# inline append #-}++-- | Map over the elements of an array with the index.+imap :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => (Int -> b -> c) -> arr1 b -> arr2 c+imap f a = runST $ do+  mb <- new (size a)+  let go !i+        | i == size a = pure ()+        | otherwise = do+            x <- indexM a i+            write mb i (f i x)+            go (i+1)+  go 0+  unsafeFreeze mb+{-# inline imap #-}++-- | Map strictly over the elements of an array with the index.+--+--   Note that because a new array must be created, the resulting+--   array type can be /different/ than the original.+imap' :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => (Int -> b -> c) -> arr1 b -> arr2 c+imap' f a = runST $ do+  mb <- new (size a)+  let go !i+        | i == size a = pure ()+        | otherwise = do+            x <- indexM a i+            let !b = f i x+            write mb i b+            go (i + 1)+  go 0+  unsafeFreeze mb+{-# inline imap' #-}++-- | Map over the elements of an array.+--+--   Note that because a new array must be created, the resulting+--   array type can be /different/ than the original.+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+        | i == size a = pure ()+        | otherwise = do+            x <- indexM a i+            write mb i (f x)+            go (i+1)+  go 0+  unsafeFreeze mb+{-# inline map #-}++-- | Map strictly over the elements of an array.+--+--   Note that because a new array must be created, the resulting+--   array type can be /different/ than the original.+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+        | i == size a = pure ()+        | otherwise = do+            x <- indexM a i+            let !b = f x+            write mb i b+            go (i+1)+  go 0+  unsafeFreeze mb+{-# inline map' #-}++-- | Convert one type of array into another.+convert :: (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 b) => arr1 b -> arr2 b+convert a = map id a+{-# inline convert #-}++-- | Right fold over the element of an array.+foldr :: (Contiguous arr, Element arr a) => (a -> b -> b) -> b -> arr a -> b+{-# inline foldr #-}+foldr f z = \arr ->+  let !sz = size arr+      go !ix = if sz > ix+        then case index# arr ix of+          (# x #) -> f x (go (ix + 1))+        else z+  in go 0++-- | Strict right fold over the elements of an array.+foldr' :: (Contiguous arr, Element arr a) => (a -> b -> b) -> b -> arr a -> b+foldr' f !z = \arr ->+  let go !ix !acc = if ix == -1+        then acc+        else case index# arr ix of+          (# x #) -> go (ix - 1) (f x acc)+  in go (size arr - 1) z+{-# inline foldr' #-}++-- | Left fold over the elements of an array.+foldl :: (Contiguous arr, Element arr a) => (b -> a -> b) -> b -> arr a -> b+foldl f z = \arr ->+  let !sz = size arr+      go !ix acc = if ix == sz+        then acc+        else case index# arr ix of+          (# x #) -> go (ix + 1) (f acc x)+  in go 0 z+{-# inline foldl #-}++-- | Strict left fold over the elements of an array.+foldl' :: (Contiguous arr, Element arr a) => (b -> a -> b) -> b -> arr a -> b+foldl' f !z = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == sz+        then acc+        else case index# arr ix of+          (# x #) -> go (ix + 1) (f acc x)+  in go 0 z+{-# inline foldl' #-}++-- | Strict left fold over the elements of an array, where the accumulating+--   function cares about the index of the element.+ifoldl' :: (Contiguous arr, Element arr a) => (b -> Int -> a -> b) -> b -> arr a -> b+ifoldl' f !z = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == sz+        then acc+        else case index# arr ix of+          (# x #) -> go (ix + 1) (f acc ix x)+  in go 0 z+{-# inline ifoldl' #-}++-- | Strict right fold over the elements of an array, where the accumulating+--   function cares about the index of the element.+ifoldr' :: (Contiguous arr, Element arr a) => (Int -> a -> b -> b) -> b -> arr a -> b+ifoldr' f !z = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == (-1)+        then acc+        else case index# arr ix of+          (# x #) -> go (ix - 1) (f ix x acc)+  in go (sz - 1) z+{-# inline ifoldr' #-}++-- | Monoidal fold over the element of an array.+foldMap :: (Contiguous arr, Element arr a, Monoid m) => (a -> m) -> arr a -> m+foldMap f = \arr ->+  let !sz = size arr+      go !ix = if sz > ix+        then case index# arr ix of+          (# x #) -> mappend (f x) (go (ix + 1))+        else mempty+  in go 0+{-# inline foldMap #-}++-- | Strict monoidal fold over the elements of an array.+foldMap' :: (Contiguous arr, Element arr a, Monoid m)+  => (a -> m) -> arr a -> m+foldMap' f = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == sz+        then acc+        else case index# arr ix+          of (# x #) -> go (ix + 1) (mappend acc (f x))+  in go 0 mempty+{-# inline foldMap' #-}++-- | Strict left monoidal fold over the elements of an array.+foldlMap' :: (Contiguous arr, Element arr a, Monoid m)+  => (a -> m) -> arr a -> m+foldlMap' = foldMap'+{-# inline foldlMap' #-}++-- | Strict monoidal fold over the elements of an array.+ifoldlMap' :: (Contiguous arr, Element arr a, Monoid m)+  => (Int -> a -> m)+  -> arr a+  -> m+ifoldlMap' f = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == sz+        then acc+        else case index# arr ix of+          (# x #) -> go (ix + 1) (mappend acc (f ix x))+  in go 0 mempty+{-# inline ifoldlMap' #-}++-- | Strict monoidal fold over the elements of an array.+ifoldlMap1' :: (Contiguous arr, Element arr a, Semigroup m)+  => (Int -> a -> m)+  -> arr a+  -> m+ifoldlMap1' f = \arr ->+  let !sz = size arr+      go !ix !acc = if ix == sz+        then acc+        else case index# arr ix of+          (# x #) -> go (ix + 1) (acc <> f ix x)+      !(# e0 #) = index# arr 0+  in go 1 (f 0 e0)+{-# inline ifoldlMap1' #-}++-- | Strict left monadic fold over the elements of an array.+foldlM' :: (Contiguous arr, Element arr a, Monad m) => (b -> a -> m b) -> b -> arr a -> m b+foldlM' f z0 = \arr ->+  let !sz = size arr+      go !ix !acc1 = if ix < sz+        then do+          let (# x #) = index# arr ix+          acc2 <- f acc1 x+          go (ix + 1) acc2+        else pure acc1+  in go 0 z0+{-# inline foldlM' #-}++-- | Drop elements that do not satisfy the predicate.+filter :: (Contiguous arr, Element arr a)+  => (a -> Bool)+  -> arr a+  -> arr a+filter p arr = ifilter (const p) arr+{-# inline filter #-}++-- | Drop elements that do not satisfy the predicate which+--   is applied to values and their indices.+ifilter :: (Contiguous arr, Element arr a)+  => (Int -> a -> Bool)+  -> arr a+  -> arr a+ifilter p arr = runST $ do+  marr :: MutablePrimArray s Word8 <- newPrimArray sz+  let go1 :: Int -> Int -> ST s Int+      go1 !ix !numTrue = if ix < sz+        then do+          atIx <- indexM arr ix+          let !keep = p ix atIx+          let !keepTag = I# (dataToTag# keep)+          writePrimArray marr ix (fromIntegral keepTag)+          go1 (ix + 1) (numTrue + keepTag)+        else pure numTrue+  numTrue <- go1 0 0+  if numTrue == sz+    then pure arr+    else do+      marrTrues <- new numTrue+      let go2 !ixSrc !ixDst = when (ixDst < numTrue) $ do+            atIxKeep <- readPrimArray marr ixSrc+            if isTrue atIxKeep+              then do+                atIxVal <- indexM arr ixSrc+                write marrTrues ixDst atIxVal+                go2 (ixSrc + 1) (ixDst + 1)+              else go2 (ixSrc + 1) ixDst+      go2 0 0+      unsafeFreeze marrTrues+  where+    !sz = size arr+{-# inline ifilter #-}++-- | The 'mapMaybe' function is a version of 'map' which can throw out elements.+--   In particular, the functional arguments returns something of type @'Maybe' b@.+--   If this is 'Nothing', no element is added on to the result array. If it is+--   @'Just' b@, then @b@ is included in the result array.+mapMaybe :: forall arr1 arr2 a b. (Contiguous arr1, Element arr1 a, Contiguous arr2, Element arr2 b)+  => (a -> Maybe b)+  -> arr1 a+  -> arr2 b+mapMaybe f arr = runST $ do+  let !sz = size arr+  let go :: Int -> Int -> [b] -> ST s ([b],Int)+      go !ix !numJusts justs = if ix < sz+        then do+          atIx <- indexM arr ix+          case f atIx of+            Nothing -> go (ix+1) numJusts justs+            Just x -> go (ix+1) (numJusts+1) (x:justs)+        else pure (justs,numJusts)+  !(bs,!numJusts) <- go 0 0 []+  !marr <- unsafeFromListReverseMutableN numJusts bs+  unsafeFreeze marr+{-# inline mapMaybe #-}++{-# inline isTrue #-}+isTrue :: Word8 -> Bool+isTrue 0 = False+isTrue _ = True++-- | The 'catMaybes' function takes a list of 'Maybe's and returns a+--   list of all the 'Just' values.+catMaybes :: (Contiguous arr, Element arr a, Element arr (Maybe a))+  => arr (Maybe a)+  -> arr a+catMaybes = mapMaybe id+{-# inline catMaybes #-}++thawPrimArray :: (PrimMonad m, Prim a) => PrimArray a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)+thawPrimArray !arr !off !len = do+  marr <- newPrimArray len+  copyPrimArray marr 0 arr off len+  pure marr+{-# inline thawPrimArray #-}++clonePrimArray :: Prim a => PrimArray a -> Int -> Int -> PrimArray a+clonePrimArray !arr !off !len = runST $ do+  marr <- newPrimArray len+  copyPrimArray marr 0 arr off len+  unsafeFreezePrimArray marr+{-# inline clonePrimArray #-}++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+  pure marr+{-# inline cloneMutablePrimArray #-}++-- | @'replicate' n x@ is an array of length @n@ with @x@ the value of every element.+replicate :: (Contiguous arr, Element arr a) => Int -> a -> arr a+replicate n x = create (replicateMutable n x)+{-# inline replicate #-}++-- | @'replicateMutableM' n act@ performs the action n times, gathering the results.+replicateMutableM :: (PrimMonad m, Contiguous arr, Element arr a)+  => Int+  -> m a+  -> m (Mutable arr (PrimState m) a)+replicateMutableM len act = do+  marr <- new len+  let go !ix = when (ix < len) $ do+        x <- act+        write marr ix x+        go (ix + 1)+  go 0+  pure marr+{-# inline replicateMutableM #-}++replicateMutablePrimArray :: (PrimMonad m, Prim a)+  => Int -- ^ length+  -> a -- ^ element+  -> m (MutablePrimArray (PrimState m) a)+replicateMutablePrimArray len a = do+  marr <- newPrimArray len+  setPrimArray marr 0 len a+  pure marr+{-# inline replicateMutablePrimArray #-}++replicateSmallMutableArray :: (PrimMonad m)+  => Int+  -> a+  -> m (SmallMutableArray (PrimState m) a)+replicateSmallMutableArray len a = do+  marr <- newSmallArray len errorThunk+  let go !ix = when (ix < len) $ do+        writeSmallArray marr ix a+        go (ix + 1)+  go 0+  pure marr+{-# inline replicateSmallMutableArray #-}++-- | Create an array from a list. If the given length does+-- not match the actual length, this function has undefined+-- behavior.+unsafeFromListN :: (Contiguous arr, Element arr a)+  => Int -- ^ length of list+  -> [a] -- ^ list+  -> arr a+unsafeFromListN n l = create (unsafeFromListMutableN n l)+{-# inline unsafeFromListN #-}++unsafeFromListMutableN :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> [a]+  -> m (Mutable arr (PrimState m) a)+unsafeFromListMutableN n l = do+  m <- new n+  let go !_ [] = pure m+      go !ix (x : xs) = do+        write m ix x+        go (ix+1) xs+  go 0 l+{-# inline unsafeFromListMutableN #-}++-- | Create a mutable array from a list, reversing the order of+--   the elements. If the given length does not match the actual length,+--   this function has undefined behavior.+unsafeFromListReverseMutableN :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> [a]+  -> m (Mutable arr (PrimState m) a)+unsafeFromListReverseMutableN n l = do+  m <- new n+  let go !_ [] = pure m+      go !ix (x : xs) = do+        write m ix x+        go (ix-1) xs+  go (n - 1) l+{-# inline unsafeFromListReverseMutableN #-}++-- | Create an array from a list, reversing the order of the+-- elements. If the given length does not match the actual length,+-- this function has undefined behavior.+unsafeFromListReverseN :: (Contiguous arr, Element arr a)+  => Int+  -> [a]+  -> arr a+unsafeFromListReverseN n l = create (unsafeFromListReverseMutableN n l)+{-# inline unsafeFromListReverseN #-}++-- | Map over a mutable array, modifying the elements in place.+mapMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => (a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+mapMutable f !marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        a <- read marr ix+        write marr ix (f a)+        go (ix + 1)+  go 0+{-# inline mapMutable #-}++-- | Strictly map over a mutable array, modifying the elements in place.+mapMutable' :: (PrimMonad m, Contiguous arr, Element arr a)+  => (a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+mapMutable' f !marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        a <- read marr ix+        let !b = f a+        write marr ix b+        go (ix + 1)+  go 0+{-# inline mapMutable' #-}++-- | Map over a mutable array with indices, modifying the elements in place.+imapMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => (Int -> a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+imapMutable f !marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        a <- read marr ix+        write marr ix (f ix a)+        go (ix + 1)+  go 0+{-# inline imapMutable #-}++-- | Strictly map over a mutable array with indices, modifying the elements in place.+imapMutable' :: (PrimMonad m, Contiguous arr, Element arr a)+  => (Int -> a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+imapMutable' f !marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        a <- read marr ix+        let !b = f ix a+        write marr ix b+        go (ix + 1)+  go 0+{-# inline imapMutable' #-}++-- | Map each element of the array to an action, evaluate these+--   actions from left to right, and collect the results in a+--   new array.+traverseP :: (PrimMonad m, Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b)+  => (a -> m b)+  -> arr1 a+  -> m (arr2 b)+traverseP f !arr = do+  let !sz = size arr+  !marr <- new sz+  let go !ix = when (ix < sz) $ do+        a <- indexM arr ix+        b <- f a+        write marr ix b+        go (ix + 1)+  go 0+  unsafeFreeze marr+{-# inline traverseP #-}++newtype STA v a = STA {_runSTA :: forall s. Mutable v s a -> ST s (v a)}++runSTA :: (Contiguous v, Element v a) => Int -> STA v a -> v a+runSTA !sz (STA m) = runST $ new sz >>= m+{-# inline runSTA #-}++-- | Map each element of the array to an action, evaluate these+--   actions from left to right, and collect the results.+--   For a version that ignores the results, see 'traverse_'.+traverse ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  , Applicative f+  )+  => (a -> f b)+  -> arr1 a+  -> f (arr2 b)+traverse f = itraverse (const f)+{-# inline traverse #-}++-- | Map each element of the array to an action, evaluate these+--   actions from left to right, and ignore the results.+--   For a version that doesn't ignore the results, see 'traverse'.+traverse_ ::+     (Contiguous arr, Element arr a, Applicative f)+  => (a -> f b)+  -> arr a+  -> f ()+traverse_ f = itraverse_ (const f)++-- | Map each element of the array and its index to an action,+--   evaluating these actions from left to right.+itraverse ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  , Applicative f+  )+  => (Int -> a -> f b)+  -> arr1 a+  -> f (arr2 b)+itraverse f = \arr ->+  let !sz = size arr+      go !ix = if ix == sz+        then pure (STA unsafeFreeze)+        else case index# arr ix of+          (# x #) -> liftA2+            (\b (STA m) -> STA $ \marr -> do+              write marr ix b+              m marr+            )+            (f ix x)+            (go (ix + 1))+  in if sz == 0+    then pure empty+    else runSTA sz <$> go 0+{-# inline itraverse #-}++-- | Map each element of the array and its index to an action,+--   evaluate these actions from left to right, and ignore the results.+--   For a version that doesn't ignore the results, see 'itraverse'.+itraverse_ ::+     (Contiguous arr, Element arr a, Applicative f)+  => (Int -> a -> f b)+  -> arr a+  -> f ()+itraverse_ f = \arr ->+  let !sz = size arr+      go !ix = when (ix < sz) $+        f ix (index arr ix) *> go (ix + 1)+  in go 0+{-# inline itraverse_ #-}++-- | 'for' is 'traverse' with its arguments flipped. For a version+--   that ignores the results see 'for_'.+for ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  , Applicative f+  )+  => arr1 a+  -> (a -> f b)+  -> f (arr2 b)+for = flip traverse+{-# inline for #-}++-- | 'for_' is 'traverse_' with its arguments flipped. For a version+--   that doesn't ignore the results see 'for'.+--+--   >>> for_ (C.fromList [1..4] :: PrimArray Int) print+--   1+--   2+--   3+--   4+for_ :: (Contiguous arr, Element arr a, Applicative f)+  => arr a+  -> (a -> f b)+  -> f ()+for_ = flip traverse_+{-# inline for_ #-}++-- | Map each element of a structure to a monadic action,+--   evaluate these actions from left to right, and collect+--   the results. for a version that ignores the results see+--   'mapM_'.+mapM ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  , Monad m+  ) => (a -> m b)+    -> arr1 a+    -> m (arr2 b)+mapM f arr =+  let !sz = size arr+  in generateM sz $ \ix -> indexM arr ix >>= f+{-# inline mapM #-}++-- | Map each element of a structure to a monadic action,+--   evaluate these actions from left to right, and ignore+--   the results. For a version that doesn't ignore the results+--   see 'mapM'.+--+--   'mapM_' = 'traverse_'+mapM_ :: (Contiguous arr, Element arr a, Element arr b, Applicative f)+  => (a -> f b)+  -> arr a+  -> f ()+mapM_ = traverse_+{-# inline mapM_ #-}++-- | 'forM' is 'mapM' with its arguments flipped. For a version that+--   ignores its results, see 'forM_'.+forM ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  , Monad m+  ) => arr1 a+    -> (a -> m b)+    -> m (arr2 b)+forM = flip mapM+{-# inline forM #-}++-- | 'forM_' is 'mapM_' with its arguments flipped. For a version that+--   doesn't ignore its results, see 'forM'.+forM_ :: (Contiguous arr, Element arr a, Element arr b, Applicative f)+  => (a -> f b)+  -> arr a+  -> f ()+forM_ = traverse_+{-# inline forM_ #-}++-- | Evaluate each action in the structure from left to right+--   and collect the results. For a version that ignores the+--   results see 'sequence_'.+sequence ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 (f a)+  , Element arr2 a+  , Applicative f+  ) => arr1 (f a) -> f (arr2 a)+sequence = traverse id+{-# inline sequence #-}++-- | Evaluate each action in the structure from left to right+--   and ignore the results. For a version that doesn't ignore+--   the results see 'sequence'.+sequence_ ::+  ( Contiguous arr+  , Element arr (f a)+  , Applicative f+  ) => arr (f a) -> f ()+sequence_ = foldr (*>) (pure ())+{-# inline sequence_ #-}++-- | The sum of a collection of actions, generalizing 'concat'.+--+--   >>> asum (C.fromList ['Just' "Hello", 'Nothing', Just "World"] :: Array String)+--   Just "Hello"+asum ::+  ( Contiguous arr+  , Element arr (f a)+  , A.Alternative f+  ) => arr (f a) -> f a+asum = foldr (A.<|>) A.empty+{-# inline asum #-}++-- | Construct an array of the given length by applying+--   the function to each index.+generate :: (Contiguous arr, Element arr a)+  => Int+  -> (Int -> a)+  -> arr a+generate len f = create (generateMutable len f)+{-# inline generate #-}++-- | Construct an array of the given length by applying+--   the monadic actino to each index.+generateM :: (Contiguous arr, Element arr a, Monad m)+  => Int+  -> (Int -> m a)+  -> m (arr a)+generateM !sz f =+  let go !ix = if ix < sz+        then liftA2+          (\b (STA m) -> STA $ \marr -> do+              write marr ix b+              m marr+          )+          (f ix)+          (go (ix + 1))+        else pure $ STA unsafeFreeze+  in if sz == 0+    then pure empty+    else runSTA sz <$> go 0++-- | Construct a mutable array of the given length by applying+--   the function to each index.+generateMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> (Int -> a)+  -> m (Mutable arr (PrimState m) a)+generateMutable len f = generateMutableM len (pure . f)+{-# inline generateMutable #-}++-- | Construct a mutable array of the given length by applying+--   the monadic action to each index.+generateMutableM :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> (Int -> m a)+  -> m (Mutable arr (PrimState m) a)+generateMutableM !len f = do+  marr <- new len+  let go !ix = when (ix < len) $ do+        x <- f ix+        write marr ix x+        go (ix + 1)+  go 0+  pure marr+{-# inline generateMutableM #-}++-- | Apply a function @n@ times to a value and construct an array+--   where each consecutive element is the result of an additional+--   application of this function. The zeroth element is the original value.+--+--   @'iterateN' 5 ('+' 1) 0 = 'fromListN' 5 [0,1,2,3,4]@+iterateN :: (Contiguous arr, Element arr a)+  => Int+  -> (a -> a)+  -> a+  -> arr a+iterateN len f z0 = runST (iterateMutableN len f z0 >>= unsafeFreeze)+{-# inline iterateN #-}++-- | Apply a function @n@ times to a value and construct a mutable array+--   where each consecutive element is the result of an additional+--   application of this function. The zeroth element is the original value.+iterateMutableN :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> (a -> a)+  -> a+  -> m (Mutable arr (PrimState m) a)+iterateMutableN len f z0 = iterateMutableNM len (pure . f) z0+{-# inline iterateMutableN #-}++-- | Apply a monadic function @n@ times to a value and construct a mutable array+--   where each consecutive element is the result of an additional+--   application of this function. The zeroth element is the original value.+iterateMutableNM :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> (a -> m a)+  -> a+  -> m (Mutable arr (PrimState m) a)+iterateMutableNM !len f z0 = do+  marr <- new len+  -- we are strict in the accumulator because+  -- otherwise we could build up a ton of `f (f (f (f .. (f a))))`+  -- thunks for no reason.+  let go !ix !acc+        | ix <= 0 = write marr ix z0 >> go (ix + 1) z0+        | ix == len = pure ()+        | otherwise = do+            a <- f acc+            write marr ix a+            go (ix + 1) a+  go 0 z0+  pure marr+{-# inline iterateMutableNM #-}++-- | Execute the monad action and freeze the resulting array.+create :: (Contiguous arr, Element arr a)+  => (forall s. ST s (Mutable arr s a))+  -> arr a+create x = runST (unsafeFreeze =<< x)+{-# inline create #-}++-- | Execute the monadic action and freeze the resulting array.+createT :: (Contiguous arr, Element arr a, Traversable f)+  => (forall s. ST s (f (Mutable arr s a)))+  -> f (arr a)+createT p = runST (Prelude.mapM unsafeFreeze =<< p)+{-# inline createT #-}++-- | Construct an array by repeatedly applying a generator+--   function to a seed. The generator function yields 'Just' the+--   next element and the new seed or 'Nothing' if there are no more+--   elements.+--+-- >>> unfoldr (\n -> if n == 0 then Nothing else Just (n,n-1) 10+--     <10,9,8,7,6,5,4,3,2,1>++-- Unfortunately, because we don't know ahead of time when to stop,+-- we need to construct a list and then turn it into an array.+unfoldr :: (Contiguous arr, Element arr a)+  => (b -> Maybe (a,b))+  -> b+  -> arr a+unfoldr f z0 = create (unfoldrMutable f z0)+{-# inline unfoldr #-}++-- | Construct a mutable array by repeatedly applying a generator+--   function to a seed. The generator function yields 'Just' the+--   next element and the new seed or 'Nothing' if there are no more+--   elements.+--+-- >>> unfoldrMutable (\n -> if n == 0 then Nothing else Just (n,n-1) 10+--     <10,9,8,7,6,5,4,3,2,1>++-- Unfortunately, because we don't know ahead of time when to stop,+-- we need to construct a list and then turn it into an array.+unfoldrMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => (b -> Maybe (a,b))+  -> b+  -> m (Mutable arr (PrimState m) a)+unfoldrMutable f z0 = do+  let go !sz s !xs = case f s of+        Nothing -> pure (sz,xs)+        Just (x,s') -> go (sz + 1) s' (x : xs)+  (sz,xs) <- go 0 z0 []+  unsafeFromListReverseMutableN sz xs+{-# inline unfoldrMutable #-}++-- | Construct an array with at most n elements by repeatedly+--   applying the generator function to a seed. The generator function+--   yields 'Just' the next element and the new seed or 'Nothing' if+--   there are no more elements.+unfoldrN :: (Contiguous arr, Element arr a)+  => Int+  -> (b -> Maybe (a, b))+  -> b+  -> arr a+unfoldrN maxSz f z0 = create (unfoldrMutableN maxSz f z0)+{-# inline unfoldrN #-}++-- | Construct a mutable array with at most n elements by repeatedly+--   applying the generator function to a seed. The generator function+--   yields 'Just' the next element and the new seed or 'Nothing' if+--   there are no more elements.+unfoldrMutableN :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> (b -> Maybe (a, b))+  -> b+  -> m (Mutable arr (PrimState m) a)+unfoldrMutableN !maxSz f z0 = do+  m <- new maxSz+  let go !ix s = if ix < maxSz+        then case f s of+          Nothing -> pure ix+          Just (x,s') -> do+            write m ix x+            go (ix + 1) s'+        else pure ix+  sz <- go 0 z0+  case compare maxSz sz of+    EQ -> pure m+    GT -> resize m sz+    LT -> error "Data.Primitive.Contiguous.unfoldrMutableN: internal error"+{-# inline unfoldrMutableN #-}++-- | Convert an array to a list.+toList :: (Contiguous arr, Element arr a)+  => arr a+  -> [a]+toList arr = build (\c n -> foldr c n arr)+{-# inline toList #-}++-- | Convert a mutable array to a list.++-- I don't think this can be expressed in terms of foldr/build,+-- so we just loop through the array.+toListMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => Mutable arr (PrimState m) a+  -> m [a]+toListMutable marr = do+  sz <- sizeMutable marr+  let go !ix !acc = if ix >= 0+        then do+          x <- read marr ix+          go (ix - 1) (x : acc)+        else pure acc+  go (sz - 1) []+{-# inline toListMutable #-}++-- | Given an 'Int' that is representative of the length of+--   the list, convert the list into a mutable array of the+--   given length.+--+--   /Note/: calls 'error' if the given length is incorrect.+fromListMutableN :: (Contiguous arr, Element arr a, PrimMonad m)+  => Int+  -> [a]+  -> m (Mutable arr (PrimState m) a)+fromListMutableN len vs = do+  marr <- new len+  let go [] !ix = if ix == len+        then pure ()+        else error "Data.Primitive.Contiguous.fromListN: list length less than specified size."+      go (a:as) !ix = if ix < len+        then do+          write marr ix a+          go as (ix + 1)+        else error "Data.Primitive.Contiguous.fromListN: list length greater than specified size."+  go vs 0+  pure marr+{-# inline fromListMutableN #-}++-- | Convert a list into a mutable array of the given length.+fromListMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => [a]+  -> m (Mutable arr (PrimState m) a)+fromListMutable xs = fromListMutableN (length xs) xs+{-# inline fromListMutable #-}++-- | Given an 'Int' that is representative of the length of+--   the list, convert the list into a mutable array of the+--   given length.+--+--   /Note/: calls 'error' if the given length is incorrect.+fromListN :: (Contiguous arr, Element arr a)+  => Int+  -> [a]+  -> arr a+fromListN len vs = create (fromListMutableN len vs)+{-# inline fromListN #-}++-- | Convert a list into an array.+fromList :: (Contiguous arr, Element arr a)+  => [a]+  -> arr a+fromList vs = create (fromListMutable vs)+{-# inline fromList #-}++-- | Modify the elements of a mutable array in-place.+modify :: (Contiguous arr, Element arr a, PrimMonad m)+  => (a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+modify f marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        x <- read marr ix+        write marr ix (f x)+        go (ix + 1)+  go 0+{-# inline modify #-}++-- | Strictly modify the elements of a mutable array in-place.+modify' :: (Contiguous arr, Element arr a, PrimMonad m)+  => (a -> a)+  -> Mutable arr (PrimState m) a+  -> m ()+modify' f marr = do+  !sz <- sizeMutable marr+  let go !ix = when (ix < sz) $ do+        x <- read marr ix+        let !y = f x+        write marr ix y+        go (ix + 1)+  go 0+{-# inline modify' #-}++-- | Yield an array of the given length containing the values+--   @x, 'succ' x, 'succ' ('succ' x)@ etc.+enumFromN :: (Contiguous arr, Element arr a, Enum a)+  => a+  -> Int+  -> arr a+enumFromN z0 sz = create (enumFromMutableN z0 sz)+{-# inline enumFromN #-}++-- | Yield a mutable array of the given length containing the values+--   @x, 'succ' x, 'succ' ('succ' x)@ etc.+enumFromMutableN :: (Contiguous arr, Element arr a, PrimMonad m, Enum a)+  => a+  -> Int+  -> m (Mutable arr (PrimState m) a)+enumFromMutableN z0 !sz = do+  m <- new sz+  let go !ix z = if ix < sz+        then do+          write m ix z+          go (ix + 1) (succ z)+        else pure m+  go 0 z0+{-# inline enumFromMutableN #-}++-- | Lift an accumulating hash function over the elements of the array,+--   returning the final accumulated hash.+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+{-# inline liftHashWithSalt #-}++-- | Reverse the elements of an array.+reverse :: (Contiguous arr, Element arr a)+  => arr a+  -> arr a+reverse arr = runST $ do+  marr <- new sz+  copy marr 0 arr 0 sz+  reverseMutable marr+  unsafeFreeze marr+  where+    !sz = size arr+{-# inline reverse #-}++-- | Reverse the elements of a mutable array, in-place.+reverseMutable :: (Contiguous arr, Element arr a, PrimMonad m)+  => Mutable arr (PrimState m) a+  -> m ()+reverseMutable marr = do+  !sz <- sizeMutable marr+  reverseSlice marr 0 (sz - 1)+{-# inline reverseMutable #-}++-- | Reverse the elements of a slice of a mutable array, in-place.+reverseSlice :: (Contiguous arr, Element arr a, PrimMonad m)+  => Mutable arr (PrimState m) a+  -> Int -- ^ start index+  -> Int -- ^ end index+  -> m ()+reverseSlice !marr !start !end = do+  let go !s !e = if s >= e+        then pure ()+        else do+          tmp <- read marr s+          write marr s =<< read marr e+          write marr e tmp+          go (s+1) (e-1)+  go start end+{-# inline reverseSlice #-}++-- | 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+{-# inline hashIntWithSalt #-}++combine :: Int -> Int -> Int+combine h1 h2 = (h1 * 16777619) `xor` h2+{-# inline combine #-}++-- | Does the element occur in the structure?+elem :: (Contiguous arr, Element arr a, Eq a) => a -> arr a -> Bool+elem a !arr =+  let !sz = size arr+      go !ix+        | ix < sz = case index# arr ix of+            !(# x #) -> if a == x+              then True+              else go (ix + 1)+        | otherwise = False+  in go 0+{-# inline elem #-}++-- | The largest element of a structure.+maximum :: (Contiguous arr, Element arr a, Ord a) => arr a -> Maybe a+maximum = maximumBy compare+{-# inline maximum #-}++-- | The least element of a structure.+minimum :: (Contiguous arr, Element arr a, Ord a) => arr a -> Maybe a+minimum = minimumBy compare+{-# inline minimum #-}++-- | The largest element of a structure with respect to the+--   given comparison function.+maximumBy :: (Contiguous arr, Element arr a)+  => (a -> a -> Ordering)+  -> arr a+  -> Maybe a+maximumBy f arr =+  let !sz = size arr+      go !ix o = if ix < sz+        then case index# arr ix of+          !(# x #) -> go (ix + 1) (case f x o of { GT -> x; _ -> o; })+        else o+  in if sz == 0+    then Nothing+    else Just (go 0 (index arr 0))+{-# inline maximumBy #-}++-- | The least element of a structure with respect to the+--   given comparison function.+minimumBy :: (Contiguous arr, Element arr a)+  => (a -> a -> Ordering)+  -> arr a+  -> Maybe a+minimumBy f arr =+  let !sz = size arr+      go !ix o = if ix < sz+        then case index# arr ix of+          !(# x #) -> go (ix + 1) (case f x o of { GT -> o; _ -> x; })+        else o+  in if sz == 0+    then Nothing+    else Just (go 0 (index arr 0))+{-# inline minimumBy #-}++-- | 'find' takes a predicate and an array, and returns the leftmost+--   element of the array matching the prediate, or 'Nothing' if there+--   is no such predicate.+find :: (Contiguous arr, Element arr a)+  => (a -> Bool)+  -> arr a+  -> Maybe a+find p = coerce . (foldMap (\x -> if p x then Just (First x) else Nothing))+{-# inline find #-}++-- | Swap the elements of the mutable array at the given indices.+swap :: (Contiguous arr, Element arr a, PrimMonad m)+  => Mutable arr (PrimState m) a+  -> Int+  -> Int+  -> m ()+swap !marr !ix1 !ix2 = do+  atIx1 <- read marr ix1+  atIx2 <- read marr ix2+  write marr ix1 atIx2+  write marr ix2 atIx1+{-# inline swap #-}++-- | Extracts from an array of 'Either' all the 'Left' elements.+-- All the 'Left' elements are extracted in order.+lefts :: forall arr a b.+  ( Contiguous arr+  , Element arr a+  , Element arr (Either a b)+  ) => arr (Either a b)+    -> arr a+lefts !arr = create $ do+  let !sz = size arr+      go :: Int -> [a] -> Int -> ST s (Int, [a])+      go !ix !as !acc = if ix < sz+        then do+          indexM arr ix >>= \case+            Left a -> go (ix + 1) (a:as) (acc + 1)+            Right _ -> go (ix + 1) as acc+        else pure (acc, as)+  (len, as) <- go 0 [] 0+  unsafeFromListReverseMutableN len as+{-# inline lefts #-}++-- | Extracts from an array of 'Either' all the 'Right' elements.+-- All the 'Right' elements are extracted in order.+rights :: forall arr a b.+  ( Contiguous arr+  , Element arr b+  , Element arr (Either a b)+  ) => arr (Either a b)+    -> arr b+rights !arr = create $ do+  let !sz = size arr+      go :: Int -> [b] -> Int -> ST s (Int, [b])+      go !ix !bs !acc = if ix < sz+        then do+          indexM arr ix >>= \case+            Left _ -> go (ix + 1) bs acc+            Right b -> go (ix + 1) (b:bs) (acc + 1)+        else pure (acc, bs)+  (len, bs) <- go 0 [] 0+  unsafeFromListReverseMutableN len bs+{-# inline rights #-}++-- | Partitions an array of 'Either' into two arrays.+-- All the 'Left' elements are extracted, in order, to the first+-- component of the output. Similarly the 'Right' elements are extracted+-- to the second component of the output.+partitionEithers :: forall arr a b.+  ( Contiguous arr+  , Element arr a+  , Element arr b+  , Element arr (Either a b)+  ) => arr (Either a b)+    -> (arr a, arr b)+partitionEithers !arr = runST $ do+  let !sz = size arr+      go :: Int -> [a] -> [b] -> Int -> Int -> ST s (Int, Int, [a], [b])+      go !ix !as !bs !accA !accB = if ix < sz+        then do+          indexM arr ix >>= \case+            Left a -> go (ix + 1) (a:as) bs (accA + 1) accB+            Right b -> go (ix + 1) as (b:bs) accA (accB + 1)+          else pure (accA, accB, as, bs)+  (lenA, lenB, as, bs) <- go 0 [] [] 0 0+  arrA <- unsafeFreeze =<< unsafeFromListReverseMutableN lenA as+  arrB <- unsafeFreeze =<< unsafeFromListReverseMutableN lenB bs+  pure (arrA, arrB)+{-# inline partitionEithers #-}++-- | 'scanl' is similar to 'foldl', but returns an array of+--   successive reduced values from the left:+--+--   > scanl f z [x1, x2, ...] = [z, f z x1, f (f z x1) x2, ...]+--+--   Note that+--+--   > last (toList (scanl f z xs)) == foldl f z xs.+scanl ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+scanl f = iscanl (const f)+{-# inline scanl #-}++-- | A variant of 'scanl' whose function argument takes the current+--   index as an argument.+iscanl ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+iscanl f q as = internalScanl (size as + 1) f q as+{-# inline iscanl #-}++-- | A strictly accumulating version of 'scanl'.+scanl' ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+scanl' f = iscanl' (const f)+{-# inline scanl' #-}++-- | A strictly accumulating version of 'iscanl'.+iscanl' ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+iscanl' f !q as = internalScanl' (size as + 1) f q as+{-# inline iscanl' #-}++-- Internal only. The first argument is the size of the array+-- argument. This function helps prevent duplication.+internalScanl ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => Int+    -> (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+internalScanl !sz f !q as = create $ do+  !marr <- new sz+  let go !ix acc = when (ix < sz) $ do+        write marr ix acc+        x <- indexM as ix+        go (ix + 1) (f ix acc x)+  go 0 q+  pure marr+{-# inline internalScanl #-}++-- Internal only. The first argument is the size of the array+-- argument. This function helps prevent duplication.+internalScanl' ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => Int+    -> (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+internalScanl' !sz f !q as = create $ do+  !marr <- new sz+  let go !ix !acc = when (ix < sz) $ do+        write marr ix acc+        x <- indexM as ix+        go (ix + 1) (f ix acc x)+  go 0 q+  pure marr+{-# inline internalScanl' #-}++-- | A prescan.+--+--   @prescanl f z = init . scanl f z@+--+--   Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@+prescanl ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+prescanl f = iprescanl (const f)+{-# inline prescanl #-}++-- | A variant of 'prescanl' where the function argument takes+--   the current index of the array as an additional argument.+iprescanl ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+iprescanl f q as = internalScanl (size as) f q as+{-# inline iprescanl #-}++-- | Like 'prescanl', but with a strict accumulator.+prescanl' ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+prescanl' f = iprescanl (const f)+{-# inline prescanl' #-}++-- | Like 'iprescanl', but with a strict accumulator.+iprescanl' ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 a+  , Element arr2 b+  ) => (Int -> b -> a -> b)+    -> b+    -> arr1 a+    -> arr2 b+iprescanl' f !q as = internalScanl' (size as) f q as+{-# inline iprescanl' #-}++-- | 'zipWith' generalises 'zip' by zipping with the function+--   given as the first argument, instead of a tupling function.+--   For example, 'zipWith' (+) is applied to two arrays to produce+--   an array of the corresponding sums.+zipWith ::+  ( Contiguous arr1+  , Contiguous arr2+  , Contiguous arr3+  , Element arr1 a+  , Element arr2 b+  , Element arr3 c+  ) => (a -> b -> c)+    -> arr1 a+    -> arr2 b+    -> arr3 c+zipWith f as bs = create $ do+  let !sz = min (size as) (size bs)+  !marr <- new sz+  let go !ix = when (ix < sz) $ do+        a <- indexM as ix+        b <- indexM bs ix+        let !g = f a b+        write marr ix g+        go (ix + 1)+  go 0+  pure marr+{-# inline zipWith #-}++-- | 'zip' takes two arrays and returns an array of+--   corresponding pairs.+--+--   > zip [1, 2] ['a', 'b'] = [(1, 'a'), (2, 'b')]+--+--   If one input array is shorter than the other, excess+--   elements of the longer array are discarded:+--+--   > zip [1] ['a', 'b'] = [(1, 'a')]+--   > zip [1, 2] ['a'] = [(1, 'a')]+--+zip ::+  ( Contiguous arr1+  , Contiguous arr2+  , Contiguous arr3+  , Element arr1 a+  , Element arr2 b+  , Element arr3 (a, b)+  ) => arr1 a+    -> arr2 b+    -> arr3 (a, b)+zip = zipWith (,)+{-# inline zip #-}++-- | Replace all locations in the input with the same value.+--+--   Equivalent to Data.Functor.'Data.Functor.<$'.+(<$) ::+  ( Contiguous arr1+  , Contiguous arr2+  , Element arr1 b+  , Element arr2 a+  ) => a -> arr1 b -> arr2 a+a <$ barr = create (replicateMutable (size barr) a)+{-# inline (<$) #-}++-- | Sequential application.+--+--   Equivalent to Control.Applicative.'Control.Applicative.<*>'.+ap ::+  ( Contiguous arr1+  , Contiguous arr2+  , Contiguous arr3+  , Element arr1 (a -> b)+  , Element arr2 a+  , Element arr3 b+  ) => arr1 (a -> b) -> arr2 a -> arr3 b+ap fs xs = create $ do+  marr <- new (szfs * szxs)+  let go1 !ix = when (ix < szfs) $ do+        f <- indexM fs ix+        go2 (ix * szxs) f 0+        go1 (ix + 1)+      go2 !off f !j = when (j < szxs) $ do+        x <- indexM xs j+        write marr (off + j) (f x)+        go2 off f (j + 1)+  go1 0+  pure marr+  where+    !szfs = size fs+    !szxs = size xs+{-# inline ap #-}+
+ test/Laws.hs view
@@ -0,0 +1,74 @@+{-# language InstanceSigs, TypeFamilies, UndecidableInstances #-}++-- We define a newtype around `Array a` for the purpose of testing+-- the definitions of many typeclass methods from `Data.Primitive.Contiguous`.+-- Testing the lawfulness of such a proxy lets us establish a higher+-- level of confidence that these implementations are correct.+module Main (main) where++import Data.Foldable+import Data.Primitive.Contiguous+import Data.Proxy+import Test.QuickCheck+import Test.QuickCheck.Classes+import qualified Data.Primitive.Contiguous as C+import qualified GHC.Exts as Exts++main :: IO ()+main = lawsCheckMany laws++laws :: [(String, [Laws])]+laws =+  [ ("Arr", [ functorLaws arr+            , applicativeLaws arr+            , foldableLaws arr+            , traversableLaws arr+            , isListLaws arr1+            ]+    )+  ]++newtype Arr a = Arr (Array a)+  deriving (Eq, Show)++instance Arbitrary a => Arbitrary (Arr a) where+  arbitrary = fmap (Arr . Exts.fromList) arbitrary++arr :: Proxy Arr+arr = Proxy++arr1 :: Proxy (Arr Int)+arr1 = Proxy++instance Functor Arr where+  fmap f (Arr a) = Arr (C.map f a)+  a <$ (Arr bs) = Arr (a C.<$ bs)++instance Applicative Arr where+  pure = Arr . C.singleton+  Arr f <*> Arr x = Arr (C.ap f x)++instance Foldable Arr where+  foldMap f (Arr a) = C.foldMap f a+  foldr f z0 (Arr a) = C.foldr f z0 a+  foldr' f z0 (Arr a) = C.foldr' f z0 a+  foldl f z0 (Arr a) = C.foldl f z0 a+  foldl' f z0 (Arr a) = C.foldl' f z0 a+  toList (Arr a) = C.toList a+  null (Arr a) = C.null a+  length (Arr a) = C.size a++instance Traversable Arr where+  traverse :: Applicative f => (a -> f b) -> Arr a -> f (Arr b)+  traverse f (Arr a) = fmap Arr (C.traverse f a)++  sequenceA :: Applicative f => Arr (f a) -> f (Arr a)+  sequenceA (Arr f) = fmap Arr (C.sequence f)++instance Exts.IsList (Arr a) where+  type Item (Arr a) = a+  fromList = Arr . C.fromList+  fromListN len = Arr . C.fromListN len+  toList (Arr a) = Exts.toList a++
test/UnitTests.hs view
@@ -1,3 +1,4 @@+{-# language ExistentialQuantification #-} {-# language GeneralizedNewtypeDeriving #-} {-# language ScopedTypeVariables #-} {-# language UndecidableInstances #-}@@ -14,40 +15,77 @@ import qualified Data.Primitive.Contiguous as C import qualified GHC.Exts as Exts import qualified Prelude as P+import qualified Data.Either as P import qualified Data.List as P import qualified Data.Vector as V  main :: IO ()-main = do-  putStr "\n"-  unitTests  +main = unitTests  unitTests :: IO ()-unitTests = mapM_ printAndTest-  [ ("Contiguous.filter = Data.List.filter", prop_filter)-  , ("Contiguous.mapMaybe = Data.Maybe.mapMaybe",prop_mapMaybe)-  , ("Reverse: reverse . reverse = id", prop_reverse1)-  , ("Contiguous.reverse = Data.List.reverse", prop_reverse2)-  , ("Contiguous.map = Data.List.map", prop_map)-  , ("Contiguous.unfoldr = Data.List.unfoldr", \_ -> prop_unfoldr)-  , ("Contiguous.unfoldrN = Data.Vector.unfoldrN", \_ -> prop_unfoldrN)-  , ("Contiguous.traverse = Data.Traversable.traverse", prop_traverse)+unitTests = mapM_ testC+  [ quiet "Contiguous.filter = Data.List.filter" prop_filter+  , quiet "Contiguous.mapMaybe = Data.Maybe.mapMaybe" prop_mapMaybe+  , quiet "Reverse: reverse . reverse = id" prop_reverse1+  , quiet "Contiguous.reverse = Data.List.reverse" prop_reverse2+  , quiet "Contiguous.map = Data.List.map" prop_map+  , quiet "Contiguous.unfoldr = Data.List.unfoldr" prop_unfoldr+  , quiet "Contiguous.unfoldrN = Data.Vector.unfoldrN" prop_unfoldrN+  , quiet "Contiguous.traverse = Data.Traversable.traverse" prop_traverse+  , quiet "Contiguous.find = Data.Foldable.find" prop_find+  , quiet "Contiguous.scanl = Data.List.scanl" prop_scanl+  , quiet "Contiguous.scanl' = Data.List.scanl'" prop_scanl'+  , quiet "Contiguous.prescanl = Data.Vector.prescanl" prop_prescanl+  , quiet "Contiguous.prescanl' = Data.Vector.prescanl'" prop_prescanl'+  , quiet "Contiguous.generate = Data.Vector.generate" prop_generate+  , quiet "Contiguous.generateM = Data.Vector.generateM" prop_generateM+  , quiet "Contiguous.minimum = Data.Foldable.minimum" prop_minimum+  , quiet "Contiguous.maximum = Data.Foldable.maximum" prop_maximum+  , quiet "Contiguous.zipWith = Data.List.zipWith" prop_zipWith+  , quiet "Contiguous.zip = Data.List.zip" prop_zip+  , quiet "Contiguous.lefts = Data.Either.lefts" prop_lefts+  , quiet "Contiguous.rights = Data.Either.rights" prop_rights+  , quiet "Contiguous.partitionEithers = Data.Either.partitionEithers" prop_partitionEithers   ] -printAndTest :: (Testable prop) => (String, prop) -> IO ()-printAndTest (x,y) = do-  putStrLn $ P.replicate (length x + 6) '-'-  putStrLn $ "-- " ++ x ++ " --"-  putStrLn $ P.replicate (length x + 6) '-'+-- Verbosity with which to run tests.+data Verbosity = Quiet | Verbose++-- | Hide the prop type.+data Prop = forall prop. Testable prop => Prop prop+++-- hack to let us get away with stuffing different+-- prop types in a list+data CTest = CTest+  { _verbosity :: Verbosity+  , _label :: String+  , _prop :: Prop+  }++-- quiet output of a test+quiet :: Testable prop => String -> prop -> CTest+quiet l p = CTest Quiet l (Prop p)++-- verbose output of a test+-- Useful for failing tests+_verbose :: Testable prop => String -> prop -> CTest+_verbose l p = CTest Verbose l (Prop p)++testC :: CTest -> IO ()+testC (CTest v lbl (Prop p)) = do+  putStrLn $ P.replicate (length lbl + 6) '-'+  putStrLn $ "-- " ++ lbl ++ " --"+  putStrLn $ P.replicate (length lbl + 6) '-'   putStr "\n"-  quickCheck y +  ($ p) $ case v of { Verbose -> verboseCheck; Quiet -> quickCheck }   putStr "\n"  newtype Arr = Arr (Array L)   deriving (Eq,Show)  newtype L = L [Int]-  deriving (Eq,Exts.IsList)+  deriving (Eq,Ord,Exts.IsList)  instance Show L where   show (L x) = show x@@ -111,10 +149,111 @@ prop_traverse (Arr arr) = property $   let arrList = C.toList arr       f = \(L xs) -> Identity (sum xs)-   in runIdentity (P.traverse f arrList) == C.toList (runIdentity (C.traverse f arr))+   in runIdentity (P.traverse f arrList) == C.toList (runIdentity (C.traverse f arr :: Identity (Array Int))) ---prop_itraverse :: Arr -> Property---prop_itraverse (Arr arr) = property $---  let arrVec = V.fromList (C.toList arr)---      f = \i (L xs) -> Identity (i + sum xs)---   in V.toList (V.itraverse f arrVec) == C.toList (C.itraverse f arr)+prop_generate :: Property+prop_generate = property $+  let f = \i -> if even i then Just i else Nothing+  in V.toList (V.generate 20 f) == C.toList (C.generate 20 f :: Array (Maybe Int))++prop_generateM :: Property+prop_generateM = property $+  let f = \i -> if even i then Just i else Nothing+  in fmap V.toList (V.generateM 20 f) == fmap C.toList (C.generateM 20 f :: Maybe (Array Int))++{-+prop_postscanl :: Arr -> Property+prop_postscanl (Arr arr) = property $+  let arrList = V.fromList (C.toList arr)+      f = \b (L a) -> b ++ a+  in V.toList (V.postscanl f [] arrList) == C.toList (C.postscanl f [] arr :: Array [Int])+-}++prop_prescanl :: Arr -> Property+prop_prescanl (Arr arr) = property $+  let arrList = V.fromList (C.toList arr)+      f = \b (L a) -> b ++ a+  in V.toList (V.prescanl f [] arrList) == C.toList (C.prescanl f [] arr :: Array [Int])++prop_prescanl' :: Arr -> Property+prop_prescanl' (Arr arr) = property $+  let arrList = V.fromList (C.toList arr)+      f = \b (L a) -> b ++ a+  in V.toList (V.prescanl' f [] arrList) == C.toList (C.prescanl' f [] arr :: Array [Int])++prop_find :: Arr -> Property+prop_find (Arr arr) = property $+  let arrList = C.toList arr+      f = \(L xs) -> even (sum xs)+   in P.find f arrList == C.find f arr++prop_zipWith :: Arr -> Arr -> Property+prop_zipWith (Arr arr1) (Arr arr2) = property $+  let arrList1 = C.toList arr1+      arrList2 = C.toList arr2+      f = \(L xs) (L ys) -> xs ++ ys+  in P.zipWith f arrList1 arrList2 == C.toList (C.zipWith f arr1 arr2 :: Array [Int])++prop_zip :: Arr -> Arr -> Property+prop_zip (Arr arr1) (Arr arr2) = property $+  let arrList1 = C.toList arr1+      arrList2 = C.toList arr2+  in P.zip arrList1 arrList2 == C.toList (C.zip arr1 arr2 :: Array (L, L))+prop_scanl :: Arr -> Property+prop_scanl (Arr arr) = property $+  let arrList = C.toList arr+      f = \b (L a) -> b ++ a+  in P.scanl f [] arrList == C.toList (C.scanl f [] arr :: Array [Int])++prop_scanl' :: Arr -> Property+prop_scanl' (Arr arr) = property $+  let arrList = C.toList arr+      f = \b (L a) -> b ++ a+  in P.scanl' f [] arrList == C.toList (C.scanl' f [] arr :: Array [Int])++prop_partitionEithers :: Array' (Either Int Bool) -> Property+prop_partitionEithers (Array' arr) = property $+  let arrList = C.toList arr+      rhs = case C.partitionEithers arr of (as,bs) -> (C.toList as, C.toList bs)+  in P.partitionEithers arrList == rhs++prop_rights :: Array' (Either Int Bool) -> Property+prop_rights (Array' arr) = property $+  let arrList = C.toList arr+  in P.rights arrList == C.toList (C.rights arr)++prop_lefts :: Array' (Either Int Bool) -> Property+prop_lefts (Array' arr) = property $+  let arrList = C.toList arr+  in P.lefts arrList == C.toList (C.lefts arr)++prop_minimum :: Arr -> Property+prop_minimum (Arr arr) = property $+  let arrList = C.toList arr+  in Just (minimum arrList) == C.minimum arr++prop_maximum :: Arr -> Property+prop_maximum (Arr arr) = property $+  let arrList = C.toList arr+  in Just (maximum arrList) == C.maximum arr++newtype Array' a = Array' { getArray' :: Array a }+  deriving (Eq, Show, Exts.IsList)++instance Arbitrary a => Arbitrary (Array' a) where+  arbitrary = do+    k <- choose (2,20)+    fmap Exts.fromList $ vectorOf k arbitrary+  shrink xs = fmap Exts.fromList $ shrink $ Exts.toList xs++-- Get around quickcheck not generating multiple arrays+--newtype GenArrM = GenArr { getGenArrM :: Array Int }+--  deriving (Eq, Show, Exts.IsList)++--instance Arbitrary GenArrM where+--  arbitrary = do+--    k <- choose (2,20)+--    GenArrM <$> C.generateM k (const arbitrary)+--  shrink xs = fmap Exts.fromList $ shrink $ Exts.toList xs++