From 0caa736a9072d83926c78fd9b709f0f5a4f248f7 Mon Sep 17 00:00:00 2001 From: Brian McKeon <135748266+brianjosephmckeon@users.noreply.github.com> Date: Mon, 5 Feb 2024 16:24:24 -0500 Subject: [PATCH] Prepare 0.6.4.1 release Reformatted. Added workflows. Updated package metadata. --- .github/CODEOWNERS | 1 + .github/workflows/build.yaml | 12 + .github/workflows/release.yaml | 12 + .gitignore | 1 + changelog.md => CHANGELOG.md | 84 +- Setup.hs | 2 - bench/Main.hs | 70 +- cabal.project | 2 + contiguous.cabal | 102 +- fourmolu.yaml | 51 + src/Data/Primitive/Contiguous.hs | 2422 ++++++++++++++---------- src/Data/Primitive/Contiguous/Class.hs | 762 +++++--- src/Data/Primitive/Contiguous/Shim.hs | 51 +- test/Laws.hs | 31 +- test/UnitTests.hs | 289 +-- 15 files changed, 2256 insertions(+), 1636 deletions(-) create mode 100644 .github/CODEOWNERS create mode 100644 .github/workflows/build.yaml create mode 100644 .github/workflows/release.yaml rename changelog.md => CHANGELOG.md (80%) delete mode 100644 Setup.hs create mode 100644 cabal.project create mode 100644 fourmolu.yaml diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS new file mode 100644 index 0000000..f6c0b22 --- /dev/null +++ b/.github/CODEOWNERS @@ -0,0 +1 @@ +@byteverse/l3c diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml new file mode 100644 index 0000000..085bbaf --- /dev/null +++ b/.github/workflows/build.yaml @@ -0,0 +1,12 @@ +name: build +on: + pull_request: + branches: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/build.yaml@main + secrets: inherit + with: + release: false diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml new file mode 100644 index 0000000..bd0bbd5 --- /dev/null +++ b/.github/workflows/release.yaml @@ -0,0 +1,12 @@ +name: release +on: + push: + tags: + - "*" + +jobs: + call-workflow: + uses: byteverse/.github/.github/workflows/build.yaml@main + secrets: inherit + with: + release: true diff --git a/.gitignore b/.gitignore index 16a0342..5ec9422 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.vscode/ dist dist-* cabal-dev diff --git a/changelog.md b/CHANGELOG.md similarity index 80% rename from changelog.md rename to CHANGELOG.md index 098c680..b123f9d 100644 --- a/changelog.md +++ b/CHANGELOG.md @@ -1,53 +1,59 @@ -0.6.4.0: [2023.06.28] ---------------------- +# Revision history for contiguous + +## 0.6.4.1 -- 2024-02-05 + +* Update package metadata. + +## 0.6.4.0 -- 2023-06-28 + * Make it work with primitive-unlifted-2.1, which drops support for older primitive-unlifted. * Add `quintupleton` and `sextupleton`. * Add `construct(1|2|3|4|5|6)` aliases for constructing arrays with a small known number of elements. -0.6.3.0: [2022.12.07] ---------------------- -* Add strict foldrM +## 0.6.3.0 -- 2022-12-07 + +* Add strict `foldrM` + +## 0.6.2.0 -- 2022-04-13 -0.6.2.0: [2022.04.13] ---------------------- * Make benchmarks build -* Add strict ifoldlZipWith and foldlZipWith +* Add strict `ifoldlZipWith` and `foldlZipWith` + +## 0.6.1.1 -- 2022-02-16 -0.6.1.1: [2022.02.16] ---------------------- * Allow building with GHC 9.2.1. * Drop support for GHC 8.8 and earlier. -0.6.1.0: [2021.09.01] ---------------------- +## 0.6.1.0 -- 2021-09-01 + * Add `itraverseP` * Add `deleteAt` and `ifoldr` -0.6.0: [2021.XX.XX] -------------------- +## 0.6.0 -- 2021-08-28 + * Add `Slice`, `MutableSlice`. * Split `Contiguous` into `ContiguousSlice` and `Contiguous`. * Add `shrink` and `unsafeShrinkAndFreeze` -0.5.2: [2021.08.11] -------------------- +## 0.5.2 -- 2021-08-11 + * Add `ifoldlM'`. * Add `foldrZipWith` and `ifoldrZipWith`. * Add `foldlZipWithM'` and `ifoldlZipWithM'`. * Add `all` and `any`. * Add `run`. Use it internally to accerelate prevent GHC from - boxing results in `runST`. + boxing results in `runST`. * Add `quadrupleton`. -0.5.1: [2020.06.30] ------------------ +## 0.5.1 -- 2020-06-30 + * Add `izipWith`. * Compatibility with `primitive-0.7.1.0`. -0.5: [2019.07.23] ------------------ +## 0.5 -- 2019-07-23 + * Add `generateM`, `reverseSlice`, `swap`, `catMaybes`, `zipWith`, `zip`, `lefts`, `rights`, `partitionEithers`, `elem`, `find`, `maximum`/`minimum`, `maximumBy`/`minimumBy`, `asum`, @@ -65,14 +71,14 @@ * Make sure all functions are marked INLINE. Last function not marked as inline was `imap'`. -0.4.0.1: [2019.05.17] ---------------------- +## 0.4.0.1 -- 2019-05-17 + * Allow building with `primitive-0.7`. This required depending on the `primitive-unlifted` package to provide the removed `UnliftedArray` api. -0.4: [2019.05.16] ----------- +## 0.4 -- 2019-05-16 + * Add `convert`, `filter`, `ifilter`, `itraverse(_)` (#6), `imap'`, `unsafeFromListN`, `unsafeFromListReverseMutableN`, `ifoldr'`, `foldl`, `mapMutable`, `imapMutable`, `reverse`, `reverseMutable`, @@ -90,26 +96,26 @@ * Change all instances of `return` to `pure` * Add initial test suite (some unit tests that check implementations against base/vector versions of the same functions) -* Export `unsafeFreeze`, `copy`, `write`, +* Export `unsafeFreeze`, `copy`, `write`, * Rename `sameMutable` to `equalsMutable` -0.3.3.0: [2019.03.24] ---------------------- +## 0.3.3.0 -- 2019-03-24 + * Add `freeze` as a method to `Contiguous` * Add more folds * Mark more functions as INLINEABLE -0.3.2.0: [2019.01.02] ---------------------- +## 0.3.2.0 -- 2019-01-02 + * Add `thaw` as a method to `Contiguous` -0.3.1.0: [2018.10.19] ---------------------- +## 0.3.1.0 -- 2018-10-19 + * Add `singleton`,`doubleton`,`tripleton` as methods to `Contiguous` * Add `map'`, `imap`, `mapMutable'`, `imapMutable'` -0.3.0.0: [2018.09.06] ---------------------- +## 0.3.0.0 -- 2018-09-06 + * Document the need for `Always` * Generalise API: from `ST s` to `PrimMonad m` * Add NFData `rnf` function for deeply evaluating @@ -121,11 +127,11 @@ * Add `replicate`, `null` as methods to `Contiguous`. * Add `traverse`, `itraverse`, `traverseP`, `foldMap` -0.2.0.0: [2018.06.07] ---------------------- +## 0.2.0.0 -- 2018-06-07 + * Add cabal metadata: category, proper synopsis/description * Use primitive-0.6.4.0 -0.1.0.0: [2018.05.31] ---------------------- -Initial version. Released on an unsuspecting world. +## 0.1.0.0 -- 2018-05-31 + +* Initial version. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/bench/Main.hs b/bench/Main.hs index 3b2b415..cb33826 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,20 +1,21 @@ -{-# language - BangPatterns - , MagicHash - , ScopedTypeVariables - , TypeApplications - , UnboxedTuples - #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UnboxedTuples #-} module Main (main) where import Prelude hiding - ( null, read, Foldable(..), map + ( Foldable (..) + , map + , null + , read ) import Control.Monad -import Data.Functor.Identity (Identity(..)) -import Data.Monoid (Sum(..)) +import Data.Functor.Identity (Identity (..)) +import Data.Monoid (Sum (..)) import Data.Primitive.Contiguous import GHC.Exts (RealWorld) import System.Random @@ -301,23 +302,31 @@ main = do func "primArray100" mapMaybeJ primArray100 func "primArray1000" mapMaybeJ primArray1000 -mapMaybeJ :: forall arr. (Contiguous arr, Element arr Int) - => arr Int - -> () +mapMaybeJ :: + forall arr. + (Contiguous arr, Element arr Int) => + arr Int -> + () mapMaybeJ arr = - let !(arr' :: arr Int) = mapMaybe Just 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 () -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) +_plus1 :: Int -> Int +_plus1 = (+ 1) sum1 :: a -> Sum Int sum1 = const (Sum 1) @@ -335,21 +344,22 @@ 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)) +randomList sz = replicateM sz (randomRIO (minBound, maxBound)) -randomC :: (Contiguous arr, Element arr Int) - => Int - -> IO (arr Int) +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 :: + (Contiguous arr, Element arr Int) => + Int -> + IO (Mutable arr RealWorld Int) randomCM sz = do rList <- randomList sz rList' <- shuffleM rList fromListMutableN sz rList' - diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..7ef286b --- /dev/null +++ b/cabal.project @@ -0,0 +1,2 @@ +packages: . +tests: True diff --git a/contiguous.cabal b/contiguous.cabal index 2cf3cc0..501f138 100644 --- a/contiguous.cabal +++ b/contiguous.cabal @@ -1,81 +1,87 @@ -cabal-version: 2.0 -name: contiguous -version: 0.6.4.0 -homepage: https://github.com/andrewthad/contiguous -bug-reports: https://github.com/andrewthad/contiguous/issues -author: Andrew Martin -maintainer: andrew.thaddeus@gmail.com -copyright: 2018 Andrew Martin -license: BSD3 -license-file: LICENSE -build-type: Simple -extra-source-files: README.md -synopsis: Unified interface for primitive arrays -category: Array,Data,Primitive +cabal-version: 2.4 +name: contiguous +version: 0.6.4.1 +homepage: https://github.com/byteverse/contiguous +bug-reports: https://github.com/byteverse/contiguous/issues +author: Andrew Martin +maintainer: amartin@layer3com.com +copyright: 2018 Andrew Martin +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md + +extra-source-files: cabal.project +synopsis: Unified interface for primitive arrays +category: Array,Data,Primitive description: This package provides a typeclass `Contiguous` that offers a unified interface to working with `Array`, `SmallArray`, `PrimArray`, and `UnliftedArray`. -source-repository head - type: git - location: https://github.com/andrewthad/contiguous +common build-settings + default-language: Haskell2010 + ghc-options: -Wall -Wunused-packages library + import: build-settings exposed-modules: Data.Primitive.Contiguous Data.Primitive.Contiguous.Class - other-modules: - Data.Primitive.Contiguous.Shim - hs-source-dirs: src + + other-modules: Data.Primitive.Contiguous.Shim + hs-source-dirs: src build-depends: - base >=4.14 && <5 - , primitive >= 0.7.2 && < 0.10 - , primitive-unlifted >= 2.1 - , deepseq >= 1.4 - , run-st >= 0.1.3.2 - default-language: Haskell2010 - ghc-options: -O2 -Wall + , base >=4.14 && <5 + , deepseq >=1.4 + , primitive >=0.7.2 && <0.10 + , primitive-unlifted >=2.1 + , run-st >=0.1.3.2 + + ghc-options: -O2 test-suite unit-tests - type: exitcode-stdio-1.0 - main-is: UnitTests.hs + import: build-settings + type: exitcode-stdio-1.0 + main-is: UnitTests.hs hs-source-dirs: test build-depends: - base + , base , contiguous , primitive - , vector , QuickCheck , quickcheck-instances - default-language: Haskell2010 - ghc-options: -O2 -Wall + , vector test-suite laws - type: exitcode-stdio-1.0 - main-is: Laws.hs + import: build-settings + type: exitcode-stdio-1.0 + main-is: Laws.hs hs-source-dirs: test build-depends: - base + , base , contiguous - , primitive - , vector , QuickCheck - , quickcheck-instances , quickcheck-classes - default-language: Haskell2010 - ghc-options: -O2 -Wall + + ghc-options: -O2 benchmark weigh - type: exitcode-stdio-1.0 + import: build-settings + type: exitcode-stdio-1.0 build-depends: - base - , primitive + , base , contiguous - , weigh , random , random-shuffle - default-language: Haskell2010 + , weigh + hs-source-dirs: bench - main-is: Main.hs - ghc-options: -O2 + main-is: Main.hs + ghc-options: -O2 + +source-repository head + type: git + location: git://github.com/byteverse/contiguous.git diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..40cd005 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,51 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: 200 + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: trailing + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: leading + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: true + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: auto + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: right-align + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] + diff --git a/src/Data/Primitive/Contiguous.hs b/src/Data/Primitive/Contiguous.hs index 231df86..ea20f55 100644 --- a/src/Data/Primitive/Contiguous.hs +++ b/src/Data/Primitive/Contiguous.hs @@ -1,35 +1,39 @@ -{-# language BangPatterns #-} -{-# language FlexibleInstances #-} -{-# language LambdaCase #-} -{-# language MagicHash #-} -{-# language RankNTypes #-} -{-# language ScopedTypeVariables #-} -{-# language TypeFamilies #-} -{-# language TypeFamilyDependencies #-} -{-# language UnboxedTuples #-} - --- | The contiguous package presents a common API to a number of contiguous --- array types and their mutable counterparts. This is enabled with the --- 'Contiguous' typeclass, which parameterises over a contiguous array type and --- defines the core operations. However, the stable part of the interface is --- contained in this module, which combines those primitives into common, --- efficient array algorithms suitable for replacing pointer-heavy list --- manipulations. +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | The contiguous package presents a common API to a number of contiguous +array types and their mutable counterparts. This is enabled with the +'Contiguous' typeclass, which parameterises over a contiguous array type and +defines the core operations. However, the stable part of the interface is +contained in this module, which combines those primitives into common, +efficient array algorithms suitable for replacing pointer-heavy list +manipulations. +-} module Data.Primitive.Contiguous - ( - -- * Accessors + ( -- * Accessors + -- ** Length Information size , sizeMut , null + -- ** Indexing , index , index# , read + -- ** Monadic indexing , indexM -- * Construction + -- ** Initialisation , empty , new @@ -47,6 +51,7 @@ module Data.Primitive.Contiguous , iterateN , iterateMutableN , write + -- ** Fixed Length , construct1 , construct2 @@ -54,23 +59,29 @@ module Data.Primitive.Contiguous , construct4 , construct5 , construct6 + -- ** Running , run + -- ** Monadic initialisation , replicateMutM , generateMutableM , iterateMutableNM , create , createT + -- ** Unfolding , unfoldr , unfoldrN , unfoldrMutable + -- ** Enumeration , enumFromN , enumFromMutableN + -- ** Concatenation , append + -- ** Splitting and Splicing , insertAt @@ -89,6 +100,7 @@ module Data.Primitive.Contiguous , modifyAtF , modifyAtF' , deleteAt + -- ** Permutations , reverse , reverseMutable @@ -100,6 +112,7 @@ module Data.Primitive.Contiguous , unsafeShrinkAndFreeze -- * Elementwise operations + -- ** Mapping , map , map' @@ -122,6 +135,7 @@ module Data.Primitive.Contiguous , swap -- * Working with predicates + -- ** Filtering , filter , ifilter @@ -129,6 +143,7 @@ module Data.Primitive.Contiguous , lefts , rights , partitionEithers + -- ** Searching , find , findIndex @@ -137,6 +152,7 @@ module Data.Primitive.Contiguous , minimum , maximumBy , minimumBy + -- ** Comparing for equality , equals , equalsMut @@ -161,6 +177,7 @@ module Data.Primitive.Contiguous , asum , all , any + -- ** Zipping Folds , foldrZipWith , ifoldrZipWith @@ -198,13 +215,14 @@ module Data.Primitive.Contiguous , prescanl' , iprescanl , iprescanl' - --, postscanl - --, ipostscanl + -- , postscanl + -- , ipostscanl , mapAccum' , mapAccumLM' -- * Conversions + -- ** Lists , fromList , fromListN @@ -215,12 +233,14 @@ module Data.Primitive.Contiguous , unsafeFromListReverseMutableN , toList , toListMutable + -- ** Other array types , convert , lift , liftMut , unlift , unliftMut + -- ** Between mutable and immutable variants , clone , cloneMut @@ -237,7 +257,7 @@ module Data.Primitive.Contiguous , rnf -- * Classes - , Contiguous(Mutable,Element,Sliced,MutableSliced) + , Contiguous (Mutable, Element, Sliced, MutableSliced) , ContiguousU , Always @@ -253,53 +273,79 @@ module Data.Primitive.Contiguous ) where import Control.Monad.Primitive -import Data.Primitive hiding (fromList,fromListN) +import Data.Primitive hiding (fromList, fromListN) import Data.Primitive.Unlifted.Array -import Prelude hiding (Foldable(..),map,all,any,traverse,read,filter,replicate,reverse,zip,zipWith,scanl,(<$),mapM,mapM_,sequence,sequence_) +import Prelude hiding (Foldable (..), all, any, filter, map, mapM, mapM_, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$)) -import Control.Applicative (liftA2) import Control.Monad (when) -import Control.Monad.ST (runST,ST) +import Control.Monad.ST (ST, runST) import Data.Bits (xor) import Data.Coerce (coerce) import Data.Foldable (length) -import Data.Primitive.Contiguous.Class (Contiguous(..), ContiguousU(..), Slice, MutableSlice, Always) -import Data.Semigroup (First(..)) +import Data.Primitive.Contiguous.Class (Always, Contiguous (..), ContiguousU (..), MutableSlice, Slice) +import Data.Semigroup (First (..)) import Data.Word (Word8) import GHC.Base (build) -import GHC.Exts (MutableArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#,dataToTag#,Int(..)) +import GHC.Exts (Int (..), MutableArrayArray#, dataToTag#, isTrue#, sameMutableArrayArray#, unsafeCoerce#) import qualified Control.Applicative as A import qualified Prelude -construct1 :: (Contiguous arr, Element arr a) - => a -> arr a -{-# inline construct1 #-} +construct1 :: + (Contiguous arr, Element arr a) => + a -> + arr a +{-# INLINE construct1 #-} construct1 = singleton -construct2 :: (Contiguous arr, Element arr a) - => a -> a -> arr a -{-# inline construct2 #-} +construct2 :: + (Contiguous arr, Element arr a) => + a -> + a -> + arr a +{-# INLINE construct2 #-} construct2 = doubleton -construct3 :: (Contiguous arr, Element arr a) - => a -> a -> a -> arr a -{-# inline construct3 #-} +construct3 :: + (Contiguous arr, Element arr a) => + a -> + a -> + a -> + arr a +{-# INLINE construct3 #-} construct3 = tripleton -construct4 :: (Contiguous arr, Element arr a) - => a -> a -> a -> a -> arr a -{-# inline construct4 #-} +construct4 :: + (Contiguous arr, Element arr a) => + a -> + a -> + a -> + a -> + arr a +{-# INLINE construct4 #-} construct4 = quadrupleton -construct5 :: (Contiguous arr, Element arr a) - => a -> a -> a -> a -> a -> arr a -{-# inline construct5 #-} +construct5 :: + (Contiguous arr, Element arr a) => + a -> + a -> + a -> + a -> + a -> + arr a +{-# INLINE construct5 #-} construct5 = quintupleton -construct6 :: (Contiguous arr, Element arr a) - => a -> a -> a -> a -> a -> a -> arr a -{-# inline construct6 #-} +construct6 :: + (Contiguous arr, Element arr a) => + a -> + a -> + a -> + a -> + a -> + a -> + arr a +{-# INLINE construct6 #-} construct6 = sextupleton -- | Append two arrays. @@ -309,7 +355,7 @@ append !a !b = run $ do copy m 0 (toSlice a) copy m (size a) (toSlice b) unsafeFreeze m -{-# inline append #-} +{-# INLINE append #-} -- | Delete the element at the given position. deleteAt :: (Contiguous arr, Element arr a) => arr a -> Int -> arr a @@ -318,47 +364,69 @@ deleteAt src i = run $ do let !i' = i + 1 copy dst i (slice src i' (size src - i')) unsafeFreeze dst -{-# inline deleteAt #-} +{-# INLINE deleteAt #-} --- | Create a copy of an array except the element at the index is replaced with --- the given value. +{- | Create a copy of an array except the element at the index is replaced with + the given value. +-} replaceAt :: (Contiguous arr, Element arr a) => arr a -> Int -> a -> arr a replaceAt src i x = create $ do dst <- thaw (toSlice src) write dst i x pure dst -{-# inline replaceAt #-} - -modifyAt :: (Contiguous arr, Element arr a) - => (a -> a) -> arr a -> Int -> arr a +{-# INLINE replaceAt #-} + +modifyAt :: + (Contiguous arr, Element arr a) => + (a -> a) -> + arr a -> + Int -> + arr a modifyAt f src i = replaceAt src i $ f (index src i) -{-# inline modifyAt #-} - --- | Variant of modifyAt that forces the result before installing it in the --- array. -modifyAt' :: (Contiguous arr, Element arr a) - => (a -> a) -> arr a -> Int -> arr a +{-# INLINE modifyAt #-} + +{- | Variant of modifyAt that forces the result before installing it in the +array. +-} +modifyAt' :: + (Contiguous arr, Element arr a) => + (a -> a) -> + arr a -> + Int -> + arr a modifyAt' f src i = replaceAt src i $! f (index src i) -{-# inline modifyAt' #-} - -modifyAtF :: (Contiguous arr, Element arr a, Functor f) - => (a -> f a) -> arr a -> Int -> f (arr a) +{-# INLINE modifyAt' #-} + +modifyAtF :: + (Contiguous arr, Element arr a, Functor f) => + (a -> f a) -> + arr a -> + Int -> + f (arr a) modifyAtF f src i = replaceAt src i <$> f (index src i) -{-# inline modifyAtF #-} - --- | Variant of modifyAtF that forces the result before installing it in the --- array. Note that this requires 'Monad' rather than 'Functor'. -modifyAtF' :: (Contiguous arr, Element arr a, Monad f) - => (a -> f a) -> arr a -> Int -> f (arr a) +{-# INLINE modifyAtF #-} + +{- | Variant of modifyAtF that forces the result before installing it in the +array. Note that this requires 'Monad' rather than 'Functor'. +-} +modifyAtF' :: + (Contiguous arr, Element arr a, Monad f) => + (a -> f a) -> + arr a -> + Int -> + f (arr a) modifyAtF' f src i = do !r <- f (index src i) let !dst = replaceAt src i r pure dst -{-# inline modifyAtF' #-} +{-# INLINE modifyAtF' #-} -- | 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 :: + (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 c) => + (Int -> b -> c) -> + arr1 b -> + arr2 c imap f a = run $ do mb <- new (size a) let go !i @@ -366,17 +434,21 @@ imap f a = run $ do | otherwise = do x <- indexM a i write mb i (f i x) - go (i+1) + 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 +{-# 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 = run $ do mb <- new (size a) let go !i @@ -388,14 +460,18 @@ imap' f a = run $ do 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 +{-# 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 = run $ do mb <- new (size a) let go !i @@ -403,17 +479,21 @@ map f a = run $ do | otherwise = do x <- indexM a i write mb i (f x) - go (i+1) + 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 +{-# 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 = run $ do mb <- new (size a) let go !i @@ -422,223 +502,274 @@ map' f a = run $ do x <- indexM a i let !b = f x write mb i b - go (i+1) + go (i + 1) go 0 unsafeFreeze mb -{-# inline map' #-} +{-# 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 :: + (Contiguous arr1, Element arr1 b, Contiguous arr2, Element arr2 b) => + arr1 b -> + arr2 b convert a = map id a -{-# inline convert #-} +{-# 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 #-} +{-# 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 - --- | Right fold over the element of an array, lazy in the accumulator, --- provides index to the step function. + go !ix = + if sz > ix + then case index# arr ix of + (# x #) -> f x (go (ix + 1)) + else z + in go 0 + +{- | Right fold over the element of an array, lazy in the accumulator, +provides index to the step function. +-} ifoldr :: (Contiguous arr, Element arr a) => (Int -> a -> b -> b) -> b -> arr a -> b -{-# inline ifoldr #-} +{-# INLINE ifoldr #-} ifoldr f z = \arr -> let !sz = size arr - go !ix = if sz > ix - then case index# arr ix of - (# x #) -> f ix x (go (ix + 1)) - else z - in go 0 + go !ix = + if sz > ix + then case index# arr ix of + (# x #) -> f ix 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' #-} + 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 #-} + 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 + 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 + 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' #-} + 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 #-} + 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' :: + (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' #-} + 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' :: + (Contiguous arr, Element arr a, Monoid m) => + (a -> m) -> + arr a -> + m foldlMap' = foldMap' -{-# inline foldlMap' #-} +{-# 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' :: + (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' #-} + 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' :: + (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) + 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' #-} + in go 1 (f 0 e0) +{-# INLINE ifoldlMap1' #-} -- | Strict right monadic fold over the elements of an array. -foldrM' :: (Contiguous arr, Element arr a, Monad m) - => (a -> b -> m b) -> b -> arr a -> m b +foldrM' :: + (Contiguous arr, Element arr a, Monad m) => + (a -> b -> m b) -> + b -> + arr a -> + m b foldrM' f !z0 = \arr -> let !sz = size arr - go !ix !acc1 = if ix >= 0 - then do - let (# x #) = index# arr ix - acc2 <- f x acc1 - go (ix - 1) acc2 - else pure acc1 - in go (sz - 1) z0 -{-# inline foldrM' #-} + go !ix !acc1 = + if ix >= 0 + then do + let (# x #) = index# arr ix + acc2 <- f x acc1 + go (ix - 1) acc2 + else pure acc1 + in go (sz - 1) z0 +{-# INLINE foldrM' #-} -- | 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' :: + (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' #-} + 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' #-} -- | Strict left monadic fold over the elements of an array. -ifoldlM' :: (Contiguous arr, Element arr a, Monad m) - => (b -> Int -> a -> m b) -> b -> arr a -> m b +ifoldlM' :: + (Contiguous arr, Element arr a, Monad m) => + (b -> Int -> a -> m b) -> + b -> + arr a -> + m b ifoldlM' f z0 = \arr -> let !sz = size arr - go !ix !acc1 = if ix < sz - then do - let (# x #) = index# arr ix - acc2 <- f acc1 ix x - go (ix + 1) acc2 - else pure acc1 - in go 0 z0 -{-# inline ifoldlM' #-} + go !ix !acc1 = + if ix < sz + then do + let (# x #) = index# arr ix + acc2 <- f acc1 ix x + go (ix + 1) acc2 + else pure acc1 + in go 0 z0 +{-# INLINE ifoldlM' #-} -- | Drop elements that do not satisfy the predicate. -filter :: (Contiguous arr, Element arr a) - => (a -> Bool) - -> arr a - -> arr a +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 +{-# 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 = run $ 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 + 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 @@ -654,59 +785,67 @@ ifilter p arr = run $ do 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 + 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 = run $ 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 [] + 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 mapMaybe #-} -{-# inline isTrue #-} +{-# 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 +{- | 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 #-} +{-# INLINE catMaybes #-} -- | @'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 (replicateMut n x) -{-# inline replicate #-} +{-# INLINE replicate #-} -- | @'replicateMutM' n act@ performs the action n times, gathering the results. -replicateMutM :: (PrimMonad m, Contiguous arr, Element arr a) - => Int - -> m a - -> m (Mutable arr (PrimState m) a) +replicateMutM :: + (PrimMonad m, Contiguous arr, Element arr a) => + Int -> + m a -> + m (Mutable arr (PrimState m) a) replicateMutM len act = do marr <- new len let go !ix = when (ix < len) $ do @@ -715,63 +854,72 @@ replicateMutM len act = do go (ix + 1) go 0 pure marr -{-# inline replicateMutM #-} - - --- | 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 +{-# INLINE replicateMutM #-} + +{- | 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) => + -- | length of list + Int -> + -- | list + [a] -> + arr a unsafeFromListN n l = create (unsafeFromListMutableN n l) -{-# inline unsafeFromListN #-} +{-# INLINE unsafeFromListN #-} -unsafeFromListMutableN :: (Contiguous arr, Element arr a, PrimMonad m) - => Int - -> [a] - -> m (Mutable arr (PrimState m) a) +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 (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) +{-# 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 (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 +{-# 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 #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + (a -> a) -> + Mutable arr (PrimState m) a -> + m () mapMutable f !marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -779,13 +927,14 @@ mapMutable f !marr = do write marr ix (f a) go (ix + 1) go 0 -{-# inline mapMutable #-} +{-# 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' :: + (PrimMonad m, Contiguous arr, Element arr a) => + (a -> a) -> + Mutable arr (PrimState m) a -> + m () mapMutable' f !marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -794,13 +943,14 @@ mapMutable' f !marr = do write marr ix b go (ix + 1) go 0 -{-# inline mapMutable' #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + (Int -> a -> a) -> + Mutable arr (PrimState m) a -> + m () imapMutable f !marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -808,13 +958,14 @@ imapMutable f !marr = do write marr ix (f ix a) go (ix + 1) go 0 -{-# inline imapMutable #-} +{-# 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' :: + (PrimMonad m, Contiguous arr, Element arr a) => + (Int -> a -> a) -> + Mutable arr (PrimState m) a -> + m () imapMutable' f !marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -823,19 +974,22 @@ imapMutable' f !marr = do write marr ix b go (ix + 1) go 0 -{-# inline imapMutable' #-} +{-# 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. +{- | 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, Element arr1 a - , Contiguous arr2, Element arr2 b - ) - => (a -> m b) - -> arr1 a - -> m (arr2 b) + ( PrimMonad m + , Contiguous arr1 + , Element arr1 a + , Contiguous arr2 + , Element arr2 b + ) => + (a -> m b) -> + arr1 a -> + m (arr2 b) traverseP f !arr = do let !sz = size arr !marr <- new sz @@ -846,19 +1000,22 @@ traverseP f !arr = do go (ix + 1) go 0 unsafeFreeze marr -{-# inline traverseP #-} +{-# INLINE traverseP #-} --- | Map each element of the array to an action, evaluate these --- actions from left to right, and collect the results in a --- new array. +{- | Map each element of the array to an action, evaluate these + actions from left to right, and collect the results in a + new array. +-} itraverseP :: - ( PrimMonad m - , Contiguous arr1, Element arr1 a - , Contiguous arr2, Element arr2 b - ) - => (Int -> a -> m b) - -> arr1 a - -> m (arr2 b) + ( PrimMonad m + , Contiguous arr1 + , Element arr1 a + , Contiguous arr2 + , Element arr2 b + ) => + (Int -> a -> m b) -> + arr1 a -> + m (arr2 b) itraverseP f !arr = do let !sz = size arr !marr <- new sz @@ -869,292 +1026,341 @@ itraverseP f !arr = do go (ix + 1) go 0 unsafeFreeze marr -{-# inline itraverseP #-} +{-# INLINE itraverseP #-} 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 #-} +{-# 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_'. +{- | 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) + ) => + (a -> f b) -> + arr1 a -> + f (arr2 b) traverse f = itraverse (const f) -{-# inline traverse #-} +{-# 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'. +{- | 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 () + (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. +{- | 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) + ) => + (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'. + 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 () + (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_'. + 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) + ) => + 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 () +{-# 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_ #-} +{-# INLINE for_ #-} --- | Monadic accumulating strict left fold over the elements on an --- array. +{- | Monadic accumulating strict left fold over the elements on an +array. +-} mapAccumLM' :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 b , Element arr2 c , Monad m - ) => (a -> b -> m (a, c)) -> a -> arr1 b -> m (a, arr2 c) -{-# inline mapAccumLM' #-} -mapAccumLM' f a0 src = go 0 [] a0 where + ) => + (a -> b -> m (a, c)) -> + a -> + arr1 b -> + m (a, arr2 c) +{-# INLINE mapAccumLM' #-} +mapAccumLM' f a0 src = go 0 [] a0 + where !sz = size src - go !ix !xs !acc = if ix < sz - then do - (!acc',!x) <- f acc (index src ix) - go (ix + 1) (x : xs) acc' - else - let !xs' = unsafeFromListReverseN sz xs - in pure (acc,xs') - -mapAccum' :: forall arr1 arr2 a b c. + go !ix !xs !acc = + if ix < sz + then do + (!acc', !x) <- f acc (index src ix) + go (ix + 1) (x : xs) acc' + else + let !xs' = unsafeFromListReverseN sz xs + in pure (acc, xs') + +mapAccum' :: + forall arr1 arr2 a b c. ( Contiguous arr1 , Contiguous arr2 , Element arr1 b , Element arr2 c , Monoid a - ) => (b -> (a, c)) -> arr1 b -> (a, arr2 c) -{-# inline mapAccum' #-} + ) => + (b -> (a, c)) -> + arr1 b -> + (a, arr2 c) +{-# INLINE mapAccum' #-} mapAccum' f !src = runST $ do dst <- new sz acc <- go 0 dst mempty dst' <- unsafeFreeze dst - pure (acc,dst') - where + pure (acc, dst') + where !sz = size src go :: Int -> Mutable arr2 s c -> a -> ST s a - go !ix !dst !accA = if ix < sz - then do - let (!accB,!x) = f (index src ix) - write dst ix x - go (ix + 1) dst (accA <> accB) - else pure accA - --- | 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_'. + go !ix !dst !accA = + if ix < sz + then do + let (!accB, !x) = f (index src ix) + write dst ix x + go (ix + 1) dst (accA <> accB) + else pure accA + +{- | 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) + ) => + (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 () + 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_ #-} +{-# INLINE mapM_ #-} --- | 'forM' is 'mapM' with its arguments flipped. For a version that --- ignores its results, see 'forM_'. +{- | '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) + ) => + 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) - => arr a - -> (a -> f b) - -> f () +{-# 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) => + arr a -> + (a -> f b) -> + f () forM_ = flip traverse_ -{-# inline forM_ #-} +{-# 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_'. +{- | 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) + ) => + arr1 (f a) -> + f (arr2 a) sequence = traverse id -{-# inline sequence #-} +{-# 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'. +{- | 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 () + ) => + arr (f a) -> + f () sequence_ = foldr (*>) (pure ()) -{-# inline sequence_ #-} +{-# INLINE sequence_ #-} --- | The sum of a collection of actions, generalizing 'concat'. --- --- >>> asum (C.fromList ['Just' "Hello", 'Nothing', Just "World"] :: Array String) --- Just "Hello" +{- | 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 + ) => + 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 +{-# 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 action to each index. -generateM :: (Contiguous arr, Element arr a, Monad m) - => Int - -> (Int -> m a) - -> m (arr a) -{-# inline generateM #-} +{-# INLINE generate #-} + +{- | Construct an array of the given length by applying + the monadic action to each index. +-} +generateM :: + (Contiguous arr, Element arr a, Monad m) => + Int -> + (Int -> m a) -> + m (arr a) +{-# INLINE generateM #-} 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) + 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) +{-# 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 @@ -1163,40 +1369,46 @@ generateMutableM !len f = do 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 +{-# 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) +{-# 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) +{-# 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 @@ -1211,173 +1423,196 @@ iterateMutableNM !len f z0 = do go (ix + 1) a go 0 z0 pure marr -{-# inline iterateMutableNM #-} +{-# 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 :: + (Contiguous arr, Element arr a) => + (forall s. ST s (Mutable arr s a)) -> + arr a create x = run (unsafeFreeze =<< x) -{-# inline create #-} +{-# 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 :: + (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 #-} +{-# 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. --- | 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> +>>> 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 :: + (Contiguous arr, Element arr a) => + (b -> Maybe (a, b)) -> + b -> + arr a unfoldr f z0 = create (unfoldrMutable f z0) -{-# inline unfoldr #-} +{-# 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> +{- | 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 :: + (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 [] + 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 +{-# 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) +{-# 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 + 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 shrink m sz -{-# inline unfoldrMutableN #-} +{-# INLINE unfoldrMutableN #-} -- | Convert an array to a list. -toList :: (Contiguous arr, Element arr a) - => arr a - -> [a] +toList :: + (Contiguous arr, Element arr a) => + arr a -> + [a] toList arr = build (\c n -> foldr c n arr) -{-# inline toList #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + Mutable arr (PrimState m) a -> + m [a] toListMutable marr = do sz <- sizeMut marr - let go !ix !acc = if ix >= 0 - then do - x <- read marr ix - go (ix - 1) (x : acc) - else pure acc + 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) +{-# 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." + 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 #-} +{-# 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 :: + (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 +{-# 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 #-} +{-# INLINE fromListN #-} -- | Convert a list into an array. -fromList :: (Contiguous arr, Element arr a) - => [a] - -> arr a +fromList :: + (Contiguous arr, Element arr a) => + [a] -> + arr a fromList vs = create (fromListMutable vs) -{-# inline fromList #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + (a -> a) -> + Mutable arr (PrimState m) a -> + m () modify f marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -1385,13 +1620,14 @@ modify f marr = do write marr ix (f x) go (ix + 1) go 0 -{-# inline modify #-} +{-# 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' :: + (Contiguous arr, Element arr a, PrimMonad m) => + (a -> a) -> + Mutable arr (PrimState m) a -> + m () modify' f marr = do !sz <- sizeMut marr let go !ix = when (ix < sz) $ do @@ -1400,103 +1636,122 @@ modify' f marr = do 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 +{-# 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) +{-# 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 + 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 +{-# 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 #-} + 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 :: + (Contiguous arr, Element arr a) => + arr a -> + arr a reverse arr = run $ do marr <- new (size arr) copy marr 0 (toSlice arr) reverseMutable marr unsafeFreeze marr -{-# inline reverse #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + Mutable arr (PrimState m) a -> + m () reverseMutable marr = do !sz <- sizeMut marr reverseSlice marr 0 (sz - 1) -{-# inline reverseMutable #-} +{-# 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 :: + (Contiguous arr, Element arr a, PrimMonad m) => + Mutable arr (PrimState m) a -> + -- | start index + Int -> + -- | end index + Int -> + 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) + 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 :: ContiguousU arr => arr a -> arr a -> Bool -same a b = isTrue# (sameMutableArrayArray# - (unsafeCoerce# (unlift a) :: MutableArrayArray# s) - (unsafeCoerce# (unlift b) :: MutableArrayArray# s)) +{-# 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 :: (ContiguousU 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 #-} +{-# INLINE hashIntWithSalt #-} combine :: Int -> Int -> Int combine h1 h2 = (h1 * 16777619) `xor` h2 -{-# inline combine #-} +{-# INLINE combine #-} -- | Does the element occur in the structure? elem :: (Contiguous arr, Element arr a, Eq a) => a -> arr a -> Bool @@ -1504,195 +1759,223 @@ 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) + !(# x #) -> + if a == x + then True + else go (ix + 1) | otherwise = False - in go 0 -{-# inline elem #-} + 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 #-} +{-# 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 +{-# 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 + 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 element. -find :: (Contiguous arr, Element arr a) - => (a -> Bool) - -> arr a - -> Maybe a + 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 element. +-} +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 #-} - --- | 'findIndex' takes a predicate and an array, and returns the index of --- the leftmost element of the array matching the prediate, or 'Nothing' --- if there is no such element. -findIndex :: (Contiguous arr, Element arr a) - => (a -> Bool) - -> arr a - -> Maybe Int +{-# INLINE find #-} + +{- | 'findIndex' takes a predicate and an array, and returns the index of + the leftmost element of the array matching the prediate, or 'Nothing' + if there is no such element. +-} +findIndex :: + (Contiguous arr, Element arr a) => + (a -> Bool) -> + arr a -> + Maybe Int findIndex p xs = loop 0 - where + where loop i | i < size xs = if p (index xs i) then Just i else loop (i + 1) | otherwise = Nothing -{-# inline findIndex #-} +{-# INLINE findIndex #-} -- | 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 :: + (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 #-} +{-# 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. +{- | 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 + ) => + 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) + 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 #-} +{-# 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. +{- | 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 + ) => + 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) + 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. +{-# 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) + ) => + 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) + 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. +{-# 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 + ) => + (b -> a -> b) -> + b -> + arr1 a -> + arr2 b scanl f = iscanl (const f) -{-# inline scanl #-} +{-# INLINE scanl #-} --- | A variant of 'scanl' whose function argument takes the current --- index as an argument. +{- | 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 + ) => + (Int -> b -> a -> b) -> + b -> + arr1 a -> + arr2 b iscanl f q as = internalScanl (size as + 1) f q as -{-# inline iscanl #-} +{-# INLINE iscanl #-} -- | A strictly accumulating version of 'scanl'. scanl' :: @@ -1700,12 +1983,13 @@ scanl' :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (b -> a -> b) - -> b - -> arr1 a - -> arr2 b + ) => + (b -> a -> b) -> + b -> + arr1 a -> + arr2 b scanl' f = iscanl' (const f) -{-# inline scanl' #-} +{-# INLINE scanl' #-} -- | A strictly accumulating version of 'iscanl'. iscanl' :: @@ -1713,12 +1997,13 @@ iscanl' :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (Int -> b -> a -> b) - -> b - -> arr1 a - -> arr2 b + ) => + (Int -> b -> a -> b) -> + b -> + arr1 a -> + arr2 b iscanl' f !q as = internalScanl' (size as + 1) f q as -{-# inline iscanl' #-} +{-# INLINE iscanl' #-} -- Internal only. The first argument is the size of the array -- argument. This function helps prevent duplication. @@ -1727,11 +2012,12 @@ internalScanl :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => Int - -> (Int -> b -> a -> b) - -> b - -> arr1 a - -> 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 @@ -1740,7 +2026,7 @@ internalScanl !sz f !q as = create $ do go (ix + 1) (f ix acc x) go 0 q pure marr -{-# inline internalScanl #-} +{-# INLINE internalScanl #-} -- Internal only. The first argument is the size of the array -- argument. This function helps prevent duplication. @@ -1749,11 +2035,12 @@ internalScanl' :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => Int - -> (Int -> b -> a -> b) - -> b - -> arr1 a - -> 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 @@ -1762,38 +2049,42 @@ internalScanl' !sz f !q as = create $ do go (ix + 1) (f ix acc x) go 0 q pure marr -{-# inline internalScanl' #-} +{-# INLINE internalScanl' #-} + +{- | A prescan. --- | A prescan. --- --- @prescanl f z = init . scanl f z@ --- --- Example: @prescanl (+) 0 \<1,2,3,4\> = \<0,1,3,6\>@ + @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 + ) => + (b -> a -> b) -> + b -> + arr1 a -> + arr2 b prescanl f = iprescanl (const f) -{-# inline prescanl #-} +{-# INLINE prescanl #-} --- | A variant of 'prescanl' where the function argument takes --- the current index of the array as an additional argument. +{- | 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 + ) => + (Int -> b -> a -> b) -> + b -> + arr1 a -> + arr2 b iprescanl f q as = internalScanl (size as) f q as -{-# inline iprescanl #-} +{-# INLINE iprescanl #-} -- | Like 'prescanl', but with a strict accumulator. prescanl' :: @@ -1801,12 +2092,13 @@ prescanl' :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (b -> a -> b) - -> b - -> arr1 a - -> arr2 b + ) => + (b -> a -> b) -> + b -> + arr1 a -> + arr2 b prescanl' f = iprescanl (const f) -{-# inline prescanl' #-} +{-# INLINE prescanl' #-} -- | Like 'iprescanl', but with a strict accumulator. iprescanl' :: @@ -1814,17 +2106,19 @@ iprescanl' :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (Int -> b -> a -> b) - -> b - -> arr1 a - -> arr2 b + ) => + (Int -> b -> a -> b) -> + b -> + arr1 a -> + arr2 b iprescanl' f !q as = internalScanl' (size as) f q as -{-# inline iprescanl' #-} +{-# 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' 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 @@ -1832,12 +2126,13 @@ zipWith :: , Element arr1 a , Element arr2 b , Element arr3 c - ) => (a -> b -> c) - -> arr1 a - -> arr2 b - -> arr3 c + ) => + (a -> b -> c) -> + arr1 a -> + arr2 b -> + arr3 c zipWith f = izipWith (\_ a b -> f a b) -{-# inline zipWith #-} +{-# INLINE zipWith #-} -- | Variant of 'zipWith' that provides the index of each pair of elements. izipWith :: @@ -1847,10 +2142,11 @@ izipWith :: , Element arr1 a , Element arr2 b , Element arr3 c - ) => (Int -> a -> b -> c) - -> arr1 a - -> arr2 b - -> arr3 c + ) => + (Int -> a -> b -> c) -> + arr1 a -> + arr2 b -> + arr3 c izipWith f as bs = create $ do let !sz = min (size as) (size bs) !marr <- new sz @@ -1862,38 +2158,42 @@ izipWith f as bs = create $ do go (ix + 1) go 0 pure marr -{-# inline izipWith #-} +{-# INLINE izipWith #-} --- | Variant of 'zipWith' that accepts an accumulator, performing a lazy --- right fold over both arrays. +{- | Variant of 'zipWith' that accepts an accumulator, performing a lazy +right fold over both arrays. +-} foldrZipWith :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (a -> b -> c -> c) - -> c - -> arr1 a - -> arr2 b - -> c + ) => + (a -> b -> c -> c) -> + c -> + arr1 a -> + arr2 b -> + c foldrZipWith f = ifoldrZipWith (\_ x y c -> f x y c) -{-# inline foldrZipWith #-} +{-# INLINE foldrZipWith #-} --- | Variant of 'zipWith' that accepts an accumulator, performing a strict --- left monadic fold over both arrays. +{- | Variant of 'zipWith' that accepts an accumulator, performing a strict +left monadic fold over both arrays. +-} foldlZipWithM' :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 a , Element arr2 b , Monad m - ) => (c -> a -> b -> m c) - -> c - -> arr1 a - -> arr2 b - -> m c + ) => + (c -> a -> b -> m c) -> + c -> + arr1 a -> + arr2 b -> + m c foldlZipWithM' f = ifoldlZipWithM' (\_ x y c -> f x y c) -{-# inline foldlZipWithM' #-} +{-# INLINE foldlZipWithM' #-} -- | Variant of 'foldrZipWith' that provides the index of each pair of elements. ifoldrZipWith :: @@ -1901,53 +2201,58 @@ ifoldrZipWith :: , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (Int -> a -> b -> c -> c) - -> c - -> arr1 a - -> arr2 b - -> c + ) => + (Int -> a -> b -> c -> c) -> + c -> + arr1 a -> + arr2 b -> + c ifoldrZipWith f z = \arr1 arr2 -> let !sz = min (size arr1) (size arr2) - go !ix = if sz > ix - then case index# arr1 ix of - (# x #) -> case index# arr2 ix of - (# y #) -> f ix x y (go (ix + 1)) - else z - in go 0 -{-# inline ifoldrZipWith #-} + go !ix = + if sz > ix + then case index# arr1 ix of + (# x #) -> case index# arr2 ix of + (# y #) -> f ix x y (go (ix + 1)) + else z + in go 0 +{-# INLINE ifoldrZipWith #-} foldlZipWith' :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (c -> a -> b -> c) - -> c - -> arr1 a - -> arr2 b - -> c + ) => + (c -> a -> b -> c) -> + c -> + arr1 a -> + arr2 b -> + c foldlZipWith' f = ifoldlZipWith' (\_ x y c -> f x y c) -{-# inline foldlZipWith' #-} +{-# INLINE foldlZipWith' #-} ifoldlZipWith' :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 a , Element arr2 b - ) => (Int -> c -> a -> b -> c) - -> c - -> arr1 a - -> arr2 b - -> c + ) => + (Int -> c -> a -> b -> c) -> + c -> + arr1 a -> + arr2 b -> + c ifoldlZipWith' f !z !arr1 !arr2 = let !sz = min (size arr1) (size arr2) - go !ix !acc = if ix == sz - then acc - else case index# arr1 ix of - (# x #) -> case index# arr2 ix of - (# y #) -> go (ix + 1) (f ix acc x y) - in go 0 z -{-# inline ifoldlZipWith' #-} + go !ix !acc = + if ix == sz + then acc + else case index# arr1 ix of + (# x #) -> case index# arr2 ix of + (# y #) -> go (ix + 1) (f ix acc x y) + in go 0 z +{-# INLINE ifoldlZipWith' #-} -- | Variant of 'foldlZipWithM\'' that provides the index of each pair of elements. ifoldlZipWithM' :: @@ -1956,34 +2261,36 @@ ifoldlZipWithM' :: , Element arr1 a , Element arr2 b , Monad m - ) => (Int -> c -> a -> b -> m c) - -> c - -> arr1 a - -> arr2 b - -> m c + ) => + (Int -> c -> a -> b -> m c) -> + c -> + arr1 a -> + arr2 b -> + m c ifoldlZipWithM' f z = \arr1 arr2 -> let !sz = min (size arr1) (size arr2) - go !ix !acc = if sz > ix - then case index# arr1 ix of - (# x #) -> case index# arr2 ix of - (# y #) -> do - acc' <- f ix acc x y - go (ix + 1) acc' - else pure acc - in go 0 z -{-# inline ifoldlZipWithM' #-} - --- | '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')] --- + go !ix !acc = + if sz > ix + then case index# arr1 ix of + (# x #) -> case index# arr2 ix of + (# y #) -> do + acc' <- f ix acc x y + go (ix + 1) acc' + else pure acc + in go 0 z +{-# INLINE ifoldlZipWithM' #-} + +{- | '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 @@ -1991,27 +2298,33 @@ zip :: , Element arr1 a , Element arr2 b , Element arr3 (a, b) - ) => arr1 a - -> arr2 b - -> arr3 (a, b) + ) => + arr1 a -> + arr2 b -> + arr3 (a, b) zip = zipWith (,) -{-# inline zip #-} +{-# INLINE zip #-} + +{- | Replace all locations in the input with the same value. --- | Replace all locations in the input with the same value. --- --- Equivalent to Data.Functor.'Data.Functor.<$'. + Equivalent to Data.Functor.'Data.Functor.<$'. +-} (<$) :: ( Contiguous arr1 , Contiguous arr2 , Element arr1 b , Element arr2 a - ) => a -> arr1 b -> arr2 a + ) => + a -> + arr1 b -> + arr2 a a <$ barr = create (replicateMut (size barr) a) -{-# inline (<$) #-} +{-# INLINE (<$) #-} + +{- | Sequential application. --- | Sequential application. --- --- Equivalent to Control.Applicative.'Control.Applicative.<*>'. + Equivalent to Control.Applicative.'Control.Applicative.<*>'. +-} ap :: ( Contiguous arr1 , Contiguous arr2 @@ -2019,7 +2332,10 @@ ap :: , Element arr1 (a -> b) , Element arr2 a , Element arr3 b - ) => arr1 (a -> b) -> arr2 a -> 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 @@ -2032,15 +2348,15 @@ ap fs xs = create $ do go2 off f (j + 1) go1 0 pure marr - where - !szfs = size fs - !szxs = size xs -{-# inline ap #-} + where + !szfs = size fs + !szxs = size xs +{-# INLINE ap #-} all :: (Contiguous arr, Element arr a) => (a -> Bool) -> arr a -> Bool all f = foldr (\x acc -> f x && acc) True -{-# inline all #-} +{-# INLINE all #-} any :: (Contiguous arr, Element arr a) => (a -> Bool) -> arr a -> Bool any f = foldr (\x acc -> f x || acc) False -{-# inline any #-} +{-# INLINE any #-} diff --git a/src/Data/Primitive/Contiguous/Class.hs b/src/Data/Primitive/Contiguous/Class.hs index cc9e53b..675ea3f 100644 --- a/src/Data/Primitive/Contiguous/Class.hs +++ b/src/Data/Primitive/Contiguous/Class.hs @@ -14,39 +14,58 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedNewtypes #-} --- | The 'Contiguous' typeclass parameterises over a contiguous array type. --- It provides the core primitives necessary to implement the common API in "Data.Primitive.Contiguous". --- This allows us to have a common API to a number of contiguous --- array types and their mutable counterparts. - +{- | The 'Contiguous' typeclass parameterises over a contiguous array type. +It provides the core primitives necessary to implement the common API in "Data.Primitive.Contiguous". + This allows us to have a common API to a number of contiguous + array types and their mutable counterparts. +-} module Data.Primitive.Contiguous.Class - ( Contiguous(..) - , Slice(..) - , MutableSlice(..) - , ContiguousU(..) + ( Contiguous (..) + , Slice (..) + , MutableSlice (..) + , ContiguousU (..) , Always ) where - +import Data.Primitive hiding (fromList, fromListN) import Data.Primitive.Contiguous.Shim -import Data.Primitive hiding (fromList,fromListN) import Data.Primitive.Unlifted.Array -import Prelude hiding (length,map,all,any,foldr,foldMap,traverse,read,filter,replicate,null,reverse,foldl,foldr,zip,zipWith,scanl,(<$),elem,maximum,minimum,mapM,mapM_,sequence,sequence_) - +import Prelude hiding + ( all + , any + , elem + , filter + , foldMap + , foldl + , foldr + , length + , map + , mapM + , mapM_ + , maximum + , minimum + , null + , read + , replicate + , reverse + , scanl + , sequence + , sequence_ + , traverse + , zip + , zipWith + , (<$) + ) import Control.DeepSeq (NFData) -import Control.Monad.Primitive (PrimState, PrimMonad(..)) -import Control.Monad.ST (runST,ST) -import Control.Monad.ST.Run (runPrimArrayST,runSmallArrayST,runUnliftedArrayST,runArrayST) +import Control.Monad.Primitive (PrimMonad (..), PrimState) +import Control.Monad.ST (ST, runST) +import Control.Monad.ST.Run (runArrayST, runPrimArrayST, runSmallArrayST, runUnliftedArrayST) import Data.Kind (Type) +import Data.Primitive.Unlifted.Array () +import Data.Primitive.Unlifted.Array.Primops (MutableUnliftedArray# (MutableUnliftedArray#), UnliftedArray# (UnliftedArray#)) import Data.Primitive.Unlifted.Class (PrimUnlifted) -import GHC.Exts (ArrayArray#,Constraint,sizeofByteArray#,sizeofArray#,sizeofArrayArray#) -import GHC.Exts (SmallMutableArray#,MutableArray#,MutableArrayArray#) -import GHC.Exts (SmallArray#,Array#) -import GHC.Exts (TYPE) -import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray) -import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray),UnliftedArray_(UnliftedArray)) -import Data.Primitive.Unlifted.Array.Primops (MutableUnliftedArray#(MutableUnliftedArray#),UnliftedArray#(UnliftedArray#)) +import GHC.Exts (Array#, Constraint, MutableArray#, SmallArray#, SmallMutableArray#, TYPE, sizeofArray#, sizeofByteArray#) import qualified Control.DeepSeq as DS import qualified Data.Primitive.Unlifted.Class as Class @@ -61,90 +80,114 @@ import GHC.Exts (RuntimeRep(UnliftedRep)) type UnliftedRep = 'UnliftedRep #endif +{- | Slices of immutable arrays: packages an offset and length with a backing array. --- | Slices of immutable arrays: packages an offset and length with a backing array. --- --- @since 0.6.0 +@since 0.6.0 +-} data Slice arr a = Slice { offset :: {-# UNPACK #-} !Int , length :: {-# UNPACK #-} !Int , base :: !(Unlifted arr a) } --- | Slices of mutable arrays: packages an offset and length with a mutable backing array. --- --- @since 0.6.0 +{- | Slices of mutable arrays: packages an offset and length with a mutable backing array. + +@since 0.6.0 +-} data MutableSlice arr s a = MutableSlice { offsetMut :: {-# UNPACK #-} !Int , lengthMut :: {-# UNPACK #-} !Int , baseMut :: !(UnliftedMut arr s a) } --- | The 'Contiguous' typeclass as an interface to a multitude of --- contiguous structures. --- --- Some functions do not make sense on slices; for those, see 'ContiguousU'. +{- | The 'Contiguous' typeclass as an interface to a multitude of +contiguous structures. + +Some functions do not make sense on slices; for those, see 'ContiguousU'. +-} class Contiguous (arr :: Type -> Type) where -- | The Mutable counterpart to the array. - type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr + type Mutable arr = (r :: Type -> Type -> Type) | r -> arr + -- | The constraint needed to store elements in the array. - type family Element arr :: Type -> Constraint + type Element arr :: Type -> Constraint + -- | The slice type of this array. -- The slice of a raw array type @t@ should be 'Slice t', -- whereas the slice of a slice should be the same slice type. -- -- @since 0.6.0 - type family Sliced arr :: Type -> Type + type Sliced arr :: Type -> Type + -- | The mutable slice type of this array. -- The mutable slice of a raw array type @t@ should be 'MutableSlice t', -- whereas the mutable slice of a mutable slice should be the same slice type. -- -- @since 0.6.0 - type family MutableSliced arr :: Type -> Type -> Type - + type MutableSliced arr :: Type -> Type -> Type ------ Construction ------ + -- | Allocate a new mutable array of the given size. new :: (PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b) + -- | @'replicateMut' n x@ is a mutable array of length @n@ with @x@ the -- value of every element. - replicateMut :: (PrimMonad m, Element arr b) - => Int -- length - -> b -- fill element - -> m (Mutable arr (PrimState m) b) + replicateMut :: + (PrimMonad m, Element arr b) => + Int -> -- length + b -> -- fill element + m (Mutable arr (PrimState m) b) + -- | Resize an array without growing it. -- -- @since 0.6.0 - shrink :: (PrimMonad m, Element arr a) - => Mutable arr (PrimState m) a - -> Int -- ^ new length - -> m (Mutable arr (PrimState m) a) + shrink :: + (PrimMonad m, Element arr a) => + Mutable arr (PrimState m) a -> + -- | new length + Int -> + m (Mutable arr (PrimState m) a) default shrink :: - ( ContiguousU arr - , PrimMonad m, Element arr a) - => Mutable arr (PrimState m) a -> Int -> m (Mutable arr (PrimState m) a) + ( ContiguousU arr + , PrimMonad m + , Element arr a + ) => + Mutable arr (PrimState m) a -> + Int -> + m (Mutable arr (PrimState m) a) {-# INLINE shrink #-} shrink = resize + -- | The empty array. empty :: arr a + -- | Create a singleton array. - singleton :: Element arr a => a -> arr a + singleton :: (Element arr a) => a -> arr a + -- | Create a doubleton array. - doubleton :: Element arr a => a -> a -> arr a + doubleton :: (Element arr a) => a -> a -> arr a + -- | Create a tripleton array. - tripleton :: Element arr a => a -> a -> a -> arr a + tripleton :: (Element arr a) => a -> a -> a -> arr a + -- | Create a quadrupleton array. - quadrupleton :: Element arr a => a -> a -> a -> a -> arr a + quadrupleton :: (Element arr a) => a -> a -> a -> a -> arr a + -- | Create a quintupleton array. - quintupleton :: Element arr a => a -> a -> a -> a -> a -> arr a + quintupleton :: (Element arr a) => a -> a -> a -> a -> a -> arr a + -- | Create a sextupleton array. - sextupleton :: Element arr a => a -> a -> a -> a -> a -> a -> arr a + sextupleton :: (Element arr a) => a -> a -> a -> a -> a -> a -> arr a ------ Access and Update ------ + -- | Index into an array at the given index. - index :: Element arr b => arr b -> Int -> b + 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 #) + index# :: (Element arr b) => arr b -> Int -> (# b #) + -- | Indexing in a monad. -- -- The monad allows operations to be strict in the array @@ -165,211 +208,318 @@ class Contiguous (arr :: Type -> Type) where -- 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 + 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 () + write :: + (PrimMonad m, Element arr b) => + Mutable arr (PrimState m) b -> + Int -> + b -> + m () ------ Properties ------ + -- | Test whether the array is empty. null :: arr b -> Bool + -- | The size of the array - size :: Element arr b => arr b -> Int + size :: (Element arr b) => arr b -> Int + -- | The size of the mutable array - sizeMut :: (PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b -> m Int + sizeMut :: + (PrimMonad m, Element arr b) => + Mutable arr (PrimState m) b -> + m Int + -- | 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. equalsMut :: Mutable arr s a -> Mutable arr s a -> Bool ------ Conversion ------ + -- | Create a 'Slice' of an array. -- -- @O(1)@. -- -- @since 0.6.0 - slice :: (Element arr a) - => arr a -- base array - -> Int -- offset - -> Int -- length - -> Sliced arr a + slice :: + (Element arr a) => + arr a -> -- base array + Int -> -- offset + Int -> -- length + Sliced arr a + -- | Create a 'MutableSlice' of a mutable array. -- -- @O(1)@. -- -- @since 0.6.0 - sliceMut :: (Element arr a) - => Mutable arr s a -- base array - -> Int -- offset - -> Int -- length - -> MutableSliced arr s a + sliceMut :: + (Element arr a) => + Mutable arr s a -> -- base array + Int -> -- offset + Int -> -- length + MutableSliced arr s a + -- | Create a 'Slice' that covers the entire array. -- -- @since 0.6.0 toSlice :: (Element arr a) => arr a -> Sliced arr a + -- | Create a 'MutableSlice' that covers the entire array. -- -- @since 0.6.0 - toSliceMut :: (PrimMonad m, Element arr a) - => Mutable arr (PrimState m) a - -> m (MutableSliced arr (PrimState m) a) + toSliceMut :: + (PrimMonad m, Element arr a) => + Mutable arr (PrimState m) a -> + m (MutableSliced arr (PrimState m) a) + -- | Clone a slice of an array. - clone :: Element arr b - => Sliced arr b -- ^ slice to copy - -> arr b + clone :: + (Element arr b) => + -- | slice to copy + Sliced arr b -> + arr b default clone :: - ( Sliced arr ~ Slice arr, ContiguousU arr - , Element arr b) - => Sliced arr b -> arr b + ( Sliced arr ~ Slice arr + , ContiguousU arr + , Element arr b + ) => + Sliced arr b -> + arr b {-# INLINE clone #-} - clone Slice{offset,length,base} = clone_ (lift base) offset length + clone Slice {offset, length, base} = clone_ (lift base) offset length + -- | Clone a slice of an array without using the 'Slice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - clone_ :: Element arr a => arr a -> Int -> Int -> arr a + clone_ :: (Element arr a) => arr a -> Int -> Int -> arr a + -- | Clone a slice of a mutable array. - cloneMut :: (PrimMonad m, Element arr b) - => MutableSliced arr (PrimState m) b -- ^ Array to copy a slice of - -> m (Mutable arr (PrimState m) b) + cloneMut :: + (PrimMonad m, Element arr b) => + -- | Array to copy a slice of + MutableSliced arr (PrimState m) b -> + m (Mutable arr (PrimState m) b) default cloneMut :: - ( MutableSliced arr ~ MutableSlice arr, ContiguousU arr - , PrimMonad m, Element arr b) - => MutableSliced arr (PrimState m) b -> m (Mutable arr (PrimState m) b) + ( MutableSliced arr ~ MutableSlice arr + , ContiguousU arr + , PrimMonad m + , Element arr b + ) => + MutableSliced arr (PrimState m) b -> + m (Mutable arr (PrimState m) b) {-# INLINE cloneMut #-} - cloneMut MutableSlice{offsetMut,lengthMut,baseMut} - = cloneMut_ (liftMut baseMut) offsetMut lengthMut + cloneMut MutableSlice {offsetMut, lengthMut, baseMut} = + cloneMut_ (liftMut baseMut) offsetMut lengthMut + -- | Clone a slice of a mutable array without using the 'MutableSlice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - cloneMut_ :: (PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b -- ^ Array to copy a slice of - -> Int -- ^ offset - -> Int -- ^ length - -> m (Mutable arr (PrimState m) b) + cloneMut_ :: + (PrimMonad m, Element arr b) => + -- | Array to copy a slice of + Mutable arr (PrimState m) b -> + -- | offset + Int -> + -- | length + Int -> + m (Mutable arr (PrimState m) b) + -- | Turn a mutable array slice an immutable array by copying. -- -- @since 0.6.0 - freeze :: (PrimMonad m, Element arr a) - => MutableSliced arr (PrimState m) a - -> m (arr a) + freeze :: + (PrimMonad m, Element arr a) => + MutableSliced arr (PrimState m) a -> + m (arr a) default freeze :: - ( MutableSliced arr ~ MutableSlice arr, ContiguousU arr - , PrimMonad m, Element arr a) - => MutableSliced arr (PrimState m) a -> m (arr a) + ( MutableSliced arr ~ MutableSlice arr + , ContiguousU arr + , PrimMonad m + , Element arr a + ) => + MutableSliced arr (PrimState m) a -> + m (arr a) {-# INLINE freeze #-} - freeze MutableSlice{offsetMut,lengthMut,baseMut} - = freeze_ (liftMut baseMut) offsetMut lengthMut + freeze MutableSlice {offsetMut, lengthMut, baseMut} = + freeze_ (liftMut baseMut) offsetMut lengthMut + -- | Turn a slice of a mutable array into an immutable one with copying, -- without using the 'MutableSlice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - freeze_ :: (PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b - -> Int -- ^ offset - -> Int -- ^ length - -> m (arr b) + freeze_ :: + (PrimMonad m, Element arr b) => + Mutable arr (PrimState m) b -> + -- | offset + Int -> + -- | length + Int -> + m (arr b) + -- | Turn a mutable array into an immutable one without copying. -- The mutable array should not be used after this conversion. - unsafeFreeze :: (PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b - -> m (arr b) + unsafeFreeze :: + (PrimMonad m, Element arr b) => + Mutable arr (PrimState m) b -> + m (arr b) unsafeFreeze xs = unsafeShrinkAndFreeze xs =<< sizeMut xs {-# INLINE unsafeFreeze #-} - unsafeShrinkAndFreeze :: (PrimMonad m, Element arr a) - => Mutable arr (PrimState m) a - -> Int -- ^ final size - -> m (arr a) + + unsafeShrinkAndFreeze :: + (PrimMonad m, Element arr a) => + Mutable arr (PrimState m) a -> + -- | final size + Int -> + m (arr a) default unsafeShrinkAndFreeze :: - ( ContiguousU arr - , PrimMonad m, Element arr a) - => Mutable arr (PrimState m) a -> Int -> m (arr a) + ( ContiguousU arr + , PrimMonad m + , Element arr a + ) => + Mutable arr (PrimState m) a -> + Int -> + m (arr a) {-# INLINE unsafeShrinkAndFreeze #-} unsafeShrinkAndFreeze arr0 len' = resize arr0 len' >>= unsafeFreeze + -- | Copy a slice of an immutable array into a new mutable array. - thaw :: (PrimMonad m, Element arr b) - => Sliced arr b - -> m (Mutable arr (PrimState m) b) + thaw :: + (PrimMonad m, Element arr b) => + Sliced arr b -> + m (Mutable arr (PrimState m) b) default thaw :: - ( Sliced arr ~ Slice arr, ContiguousU arr - , PrimMonad m, Element arr b) - => Sliced arr b - -> m (Mutable arr (PrimState m) b) + ( Sliced arr ~ Slice arr + , ContiguousU arr + , PrimMonad m + , Element arr b + ) => + Sliced arr b -> + m (Mutable arr (PrimState m) b) {-# INLINE thaw #-} - thaw Slice{offset,length,base} = thaw_ (lift base) offset length + thaw Slice {offset, length, base} = thaw_ (lift base) offset length + -- | Copy a slice of an immutable array into a new mutable array without using the 'Slice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - thaw_ :: (PrimMonad m, Element arr b) - => arr b - -> Int -- ^ offset into the array - -> Int -- ^ length of the slice - -> m (Mutable arr (PrimState m) b) + thaw_ :: + (PrimMonad m, Element arr b) => + arr b -> + -- | offset into the array + Int -> + -- | length of the slice + Int -> + m (Mutable arr (PrimState m) b) ------ Copy Operations ------ + -- | 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 - -> Sliced arr b -- ^ source slice - -> m () + copy :: + (PrimMonad m, Element arr b) => + -- | destination array + Mutable arr (PrimState m) b -> + -- | offset into destination array + Int -> + -- | source slice + Sliced arr b -> + m () default copy :: - ( Sliced arr ~ Slice arr, ContiguousU arr - , PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m () + ( Sliced arr ~ Slice arr + , ContiguousU arr + , PrimMonad m + , Element arr b + ) => + Mutable arr (PrimState m) b -> + Int -> + Sliced arr b -> + m () {-# INLINE copy #-} - copy dst dstOff Slice{offset,length,base} = copy_ dst dstOff (lift base) offset length + copy dst dstOff Slice {offset, length, base} = copy_ dst dstOff (lift base) offset length + -- | Copy a slice of an array into a mutable array without using the 'Slice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - 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_ :: + (PrimMonad m, Element arr b) => + -- | destination array + Mutable arr (PrimState m) b -> + -- | offset into destination array + Int -> + -- | source array + arr b -> + -- | offset into source array + Int -> + -- | number of elements to copy + Int -> + 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. - copyMut :: (PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b -- ^ destination array - -> Int -- ^ offset into destination array - -> MutableSliced arr (PrimState m) b -- ^ source slice - -> m () + copyMut :: + (PrimMonad m, Element arr b) => + -- | destination array + Mutable arr (PrimState m) b -> + -- | offset into destination array + Int -> + -- | source slice + MutableSliced arr (PrimState m) b -> + m () default copyMut :: - ( MutableSliced arr ~ MutableSlice arr, ContiguousU arr - , PrimMonad m, Element arr b) - => Mutable arr (PrimState m) b -> Int -> MutableSliced arr (PrimState m) b -> m () + ( MutableSliced arr ~ MutableSlice arr + , ContiguousU arr + , PrimMonad m + , Element arr b + ) => + Mutable arr (PrimState m) b -> + Int -> + MutableSliced arr (PrimState m) b -> + m () {-# INLINE copyMut #-} - copyMut dst dstOff MutableSlice{offsetMut,lengthMut,baseMut} - = copyMut_ dst dstOff (liftMut baseMut) offsetMut lengthMut + copyMut dst dstOff MutableSlice {offsetMut, lengthMut, baseMut} = + copyMut_ dst dstOff (liftMut baseMut) offsetMut lengthMut + -- | Copy a slice of a mutable array into another mutable array without using the 'Slice' type. -- These methods are required to implement 'Contiguous (Slice arr)' for any `Contiguous arr`; -- they are not really meant for direct use. -- -- @since 0.6.0 - copyMut_ :: (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 () + copyMut_ :: + (PrimMonad m, Element arr b) => + -- | destination array + Mutable arr (PrimState m) b -> + -- | offset into destination array + Int -> + -- | source array + Mutable arr (PrimState m) b -> + -- | offset into source array + Int -> + -- | number of elements to copy + Int -> + m () + -- | Copy a slice of an array and then insert an element into that array. -- -- The default implementation performs a memset which would be unnecessary @@ -377,179 +527,204 @@ class Contiguous (arr :: Type -> Type) where -- -- Was previously @insertSlicing@ -- @since 0.6.0 - insertAt :: (Element arr b) - => arr b -- ^ slice to copy from - -> Int -- ^ index in the output array to insert at - -> b -- ^ element to insert - -> arr b + insertAt :: + (Element arr b) => + -- | slice to copy from + arr b -> + -- | index in the output array to insert at + Int -> + -- | element to insert + b -> + arr b default insertAt :: - (Element arr b, ContiguousU arr) - => arr b -> Int -> b -> arr b + (Element arr b, ContiguousU arr) => + arr b -> + Int -> + b -> + arr b insertAt src i x = run $ do dst <- replicateMut (size src + 1) x copy dst 0 (slice src 0 i) copy dst (i + 1) (slice src i (size src - i)) unsafeFreeze dst - {-# inline insertAt #-} + {-# INLINE insertAt #-} ------ Reduction ------ + -- | Reduce the array and all of its elements to WHNF. rnf :: (NFData a, Element arr a) => arr a -> () + -- | Run an effectful computation that produces an array. run :: (forall s. ST s (arr a)) -> arr a --- | The 'ContiguousU' typeclass is an extension of the 'Contiguous' typeclass, --- but includes operations that make sense only on unsliced contiguous structures. --- --- @since 0.6.0 +{- | The 'ContiguousU' typeclass is an extension of the 'Contiguous' typeclass, +but includes operations that make sense only on unsliced contiguous structures. + +@since 0.6.0 +-} class (Contiguous arr) => ContiguousU arr where -- | The unifted version of the immutable array type (i.e. eliminates an indirection through a thunk). type Unlifted arr = (r :: Type -> TYPE UnliftedRep) | r -> arr + -- | The unifted version of the mutable array type (i.e. eliminates an indirection through a thunk). type UnliftedMut arr = (r :: Type -> Type -> TYPE UnliftedRep) | r -> arr + -- | 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) + resize :: + (PrimMonad m, Element arr b) => + Mutable arr (PrimState m) b -> + Int -> + m (Mutable arr (PrimState m) b) + -- | Unlift an array (i.e. point to the data without an intervening thunk). -- -- @since 0.6.0 unlift :: arr b -> Unlifted arr b + -- | Unlift a mutable array (i.e. point to the data without an intervening thunk). -- -- @since 0.6.0 unliftMut :: Mutable arr s b -> UnliftedMut arr s b + -- | Lift an array (i.e. point to the data through an intervening thunk). -- -- @since 0.6.0 lift :: Unlifted arr b -> arr b + -- | Lift a mutable array (i.e. point to the data through an intervening thunk). -- -- @since 0.6.0 liftMut :: UnliftedMut arr s b -> Mutable arr s b +{- | A typeclass that is satisfied by all types. This is used +used to provide a fake constraint for 'Array' and 'SmallArray'. +-} +class Always a --- | A typeclass that is satisfied by all types. This is used --- used to provide a fake constraint for 'Array' and 'SmallArray'. -class Always a where {} -instance Always a where {} +instance Always a instance (ContiguousU arr) => Contiguous (Slice arr) where type Mutable (Slice arr) = MutableSlice arr type Element (Slice arr) = Element arr type Sliced (Slice arr) = Slice arr type MutableSliced (Slice arr) = MutableSlice arr + ------ Construction ------ {-# INLINE new #-} new len = do baseMut <- new len - pure MutableSlice{offsetMut=0,lengthMut=len,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut = len, baseMut = unliftMut baseMut} {-# INLINE replicateMut #-} replicateMut len x = do baseMut <- replicateMut len x - pure MutableSlice{offsetMut=0,lengthMut=len,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut = len, baseMut = unliftMut baseMut} {-# INLINE shrink #-} shrink xs len' = pure $ case compare len' (lengthMut xs) of - LT -> xs{lengthMut=len'} + LT -> xs {lengthMut = len'} EQ -> xs GT -> errorWithoutStackTrace "Data.Primitive.Contiguous.Class.shrink: passed a larger than existing size" {-# INLINE empty #-} - empty = Slice{offset=0,length=0,base=unlift empty} + empty = Slice {offset = 0, length = 0, base = unlift empty} {-# INLINE singleton #-} - singleton a = Slice{offset=0,length=1,base=unlift $ singleton a} + singleton a = Slice {offset = 0, length = 1, base = unlift $ singleton a} {-# INLINE doubleton #-} - doubleton a b = Slice{offset=0,length=2,base=unlift $ doubleton a b} + doubleton a b = Slice {offset = 0, length = 2, base = unlift $ doubleton a b} {-# INLINE tripleton #-} - tripleton a b c = Slice{offset=0,length=3,base=unlift $ tripleton a b c} + tripleton a b c = Slice {offset = 0, length = 3, base = unlift $ tripleton a b c} {-# INLINE quadrupleton #-} - quadrupleton a b c d = Slice{offset=0,length=4,base=unlift $ quadrupleton a b c d} + quadrupleton a b c d = Slice {offset = 0, length = 4, base = unlift $ quadrupleton a b c d} {-# INLINE quintupleton #-} - quintupleton a b c d e = Slice{offset=0,length=5,base=unlift $ quintupleton a b c d e} + quintupleton a b c d e = Slice {offset = 0, length = 5, base = unlift $ quintupleton a b c d e} {-# INLINE sextupleton #-} - sextupleton a b c d e f = Slice{offset=0,length=6,base=unlift $ sextupleton a b c d e f} + sextupleton a b c d e f = Slice {offset = 0, length = 6, base = unlift $ sextupleton a b c d e f} ------ Access and Update ------ {-# INLINE index #-} - index Slice{offset,base} i = index (lift base) (offset + i) + index Slice {offset, base} i = index (lift base) (offset + i) {-# INLINE index# #-} - index# Slice{offset,base} i = index# (lift base) (offset + i) + index# Slice {offset, base} i = index# (lift base) (offset + i) {-# INLINE indexM #-} - indexM Slice{offset,base} i = indexM (lift base) (offset + i) + indexM Slice {offset, base} i = indexM (lift base) (offset + i) {-# INLINE read #-} - read MutableSlice{offsetMut,baseMut} i = read (liftMut baseMut) (offsetMut + i) + read MutableSlice {offsetMut, baseMut} i = read (liftMut baseMut) (offsetMut + i) {-# INLINE write #-} - write MutableSlice{offsetMut,baseMut} i = write (liftMut baseMut) (offsetMut + i) + write MutableSlice {offsetMut, baseMut} i = write (liftMut baseMut) (offsetMut + i) ------ Properties ------ {-# INLINE null #-} - null Slice{length} = length == 0 + null Slice {length} = length == 0 {-# INLINE size #-} - size Slice{length} = length + size Slice {length} = length {-# INLINE sizeMut #-} - sizeMut MutableSlice{lengthMut} = pure lengthMut + sizeMut MutableSlice {lengthMut} = pure lengthMut {-# INLINE equals #-} - equals Slice{offset=oA,length=lenA,base=a} - Slice{offset=oB,length=lenB,base=b} - = lenA == lenB && loop 0 oA oB - where - loop !i !iA !iB = - if i == lenA then True - else index (lift a) iA == index (lift b) iB && loop (i+1) (iA+1) (iB+1) + equals + Slice {offset = oA, length = lenA, base = a} + Slice {offset = oB, length = lenB, base = b} = + lenA == lenB && loop 0 oA oB + where + loop !i !iA !iB = + if i == lenA + then True + else index (lift a) iA == index (lift b) iB && loop (i + 1) (iA + 1) (iB + 1) {-# INLINE equalsMut #-} - equalsMut MutableSlice{offsetMut=offA,lengthMut=lenA,baseMut=a} - MutableSlice{offsetMut=offB,lengthMut=lenB,baseMut=b} - = liftMut a `equalsMut` liftMut b - && offA == offB - && lenA == lenB + equalsMut + MutableSlice {offsetMut = offA, lengthMut = lenA, baseMut = a} + MutableSlice {offsetMut = offB, lengthMut = lenB, baseMut = b} = + liftMut a `equalsMut` liftMut b + && offA == offB + && lenA == lenB ------ Conversion ------ {-# INLINE slice #-} - slice Slice{offset,base} off' len' = Slice - { offset = offset + off' - , length = len' - , base - } + slice Slice {offset, base} off' len' = + Slice + { offset = offset + off' + , length = len' + , base + } {-# INLINE sliceMut #-} - sliceMut MutableSlice{offsetMut,baseMut} off' len' = MutableSlice - { offsetMut = offsetMut + off' - , lengthMut = len' - , baseMut - } + sliceMut MutableSlice {offsetMut, baseMut} off' len' = + MutableSlice + { offsetMut = offsetMut + off' + , lengthMut = len' + , baseMut + } {-# INLINE clone #-} clone = id {-# INLINE clone_ #-} - clone_ Slice{offset,base} off' len' = - Slice{offset=offset+off',length=len',base} + clone_ Slice {offset, base} off' len' = + Slice {offset = offset + off', length = len', base} {-# INLINE cloneMut #-} - cloneMut xs@MutableSlice{lengthMut} = cloneMut_ xs 0 lengthMut + cloneMut xs@MutableSlice {lengthMut} = cloneMut_ xs 0 lengthMut {-# INLINE cloneMut_ #-} - cloneMut_ MutableSlice{offsetMut,baseMut} off' len' = do + cloneMut_ MutableSlice {offsetMut, baseMut} off' len' = do baseMut' <- cloneMut_ (liftMut baseMut) (offsetMut + off') len' - pure MutableSlice{offsetMut=0,lengthMut=len',baseMut=unliftMut baseMut'} + pure MutableSlice {offsetMut = 0, lengthMut = len', baseMut = unliftMut baseMut'} {-# INLINE freeze #-} - freeze xs@MutableSlice{lengthMut} - = freeze_ xs 0 lengthMut + freeze xs@MutableSlice {lengthMut} = + freeze_ xs 0 lengthMut {-# INLINE freeze_ #-} - freeze_ MutableSlice{offsetMut,baseMut} off' len' = do + freeze_ MutableSlice {offsetMut, baseMut} off' len' = do base <- freeze_ (liftMut baseMut) (offsetMut + off') len' - pure Slice{offset=0,length=len',base=unlift base} + pure Slice {offset = 0, length = len', base = unlift base} {-# INLINE unsafeShrinkAndFreeze #-} - unsafeShrinkAndFreeze MutableSlice{offsetMut=0,lengthMut,baseMut} len' = do - shrunk <- if lengthMut /= len' - then resize (liftMut baseMut) len' - else pure (liftMut baseMut) + unsafeShrinkAndFreeze MutableSlice {offsetMut = 0, lengthMut, baseMut} len' = do + shrunk <- + if lengthMut /= len' + then resize (liftMut baseMut) len' + else pure (liftMut baseMut) base <- unsafeFreeze shrunk - pure Slice{offset=0,length=len',base=unlift base} - unsafeShrinkAndFreeze MutableSlice{offsetMut,baseMut} len' = do + pure Slice {offset = 0, length = len', base = unlift base} + unsafeShrinkAndFreeze MutableSlice {offsetMut, baseMut} len' = do base <- freeze_ (liftMut baseMut) offsetMut len' - pure Slice{offset=0,length=len',base=unlift base} + pure Slice {offset = 0, length = len', base = unlift base} {-# INLINE thaw #-} - thaw xs@Slice{length} = thaw_ xs 0 length + thaw xs@Slice {length} = thaw_ xs 0 length {-# INLINE thaw_ #-} - thaw_ Slice{offset,base} off' len' = do + thaw_ Slice {offset, base} off' len' = do baseMut <- thaw_ (lift base) (offset + off') len' - pure MutableSlice{offsetMut=0,lengthMut=len',baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut = len', baseMut = unliftMut baseMut} {-# INLINE toSlice #-} toSlice = id {-# INLINE toSliceMut #-} @@ -557,37 +732,41 @@ instance (ContiguousU arr) => Contiguous (Slice arr) where ------ Copy Operations ------ {-# INLINE copy #-} - copy dst dstOff src@Slice{length} = copy_ dst dstOff src 0 length + copy dst dstOff src@Slice {length} = copy_ dst dstOff src 0 length {-# INLINE copy_ #-} - copy_ MutableSlice{offsetMut,baseMut} dstOff Slice{offset,base} off' len = + copy_ MutableSlice {offsetMut, baseMut} dstOff Slice {offset, base} off' len = copy_ (liftMut baseMut) (offsetMut + dstOff) (lift base) (offset + off') len {-# INLINE copyMut #-} - copyMut dst dstOff src@MutableSlice{lengthMut} = copyMut_ dst dstOff src 0 lengthMut + copyMut dst dstOff src@MutableSlice {lengthMut} = copyMut_ dst dstOff src 0 lengthMut {-# INLINE copyMut_ #-} - copyMut_ MutableSlice{offsetMut=dstOff,baseMut=dst} dstOff' - MutableSlice{offsetMut=srcOff,baseMut=src} srcOff' len = - copyMut_ (liftMut dst) (dstOff + dstOff') (liftMut src) (srcOff + srcOff') len + copyMut_ + MutableSlice {offsetMut = dstOff, baseMut = dst} + dstOff' + MutableSlice {offsetMut = srcOff, baseMut = src} + srcOff' + len = + copyMut_ (liftMut dst) (dstOff + dstOff') (liftMut src) (srcOff + srcOff') len {-# INLINE insertAt #-} - insertAt Slice{offset,length,base} i x = run $ do + insertAt Slice {offset, length, base} i x = run $ do dst <- replicateMut (length + 1) x copy_ dst 0 (lift base) offset i copy_ dst (i + 1) (lift base) (offset + i) (length - i) base' <- unsafeFreeze dst - pure Slice{offset=0,length=length+1,base=unlift base'} + pure Slice {offset = 0, length = length + 1, base = unlift base'} ------ Reduction ------ {-# INLINE rnf #-} - rnf !arr@Slice{length} = - let go !ix = if ix < length - then - let !(# x #) = index# arr ix - in DS.rnf x `seq` go (ix + 1) - else () + rnf !arr@Slice {length} = + let go !ix = + if ix < length + then + let !(# x #) = index# arr ix + in DS.rnf x `seq` go (ix + 1) + else () in go 0 {-# INLINE run #-} run = runST - instance Contiguous SmallArray where type Mutable SmallArray = SmallMutableArray type Element SmallArray = Always @@ -612,15 +791,15 @@ instance Contiguous SmallArray where 0 -> True _ -> False {-# INLINE slice #-} - slice base offset length = Slice{offset,length,base=unlift base} + slice base offset length = Slice {offset, length, base = unlift base} {-# INLINE sliceMut #-} - sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut} + sliceMut baseMut offsetMut lengthMut = MutableSlice {offsetMut, lengthMut, baseMut = unliftMut baseMut} {-# INLINE toSlice #-} - toSlice base = Slice{offset=0,length=size base,base=unlift base} + toSlice base = Slice {offset = 0, length = size base, base = unlift base} {-# INLINE toSliceMut #-} toSliceMut baseMut = do lengthMut <- sizeMut baseMut - pure MutableSlice{offsetMut=0,lengthMut,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut} {-# INLINE freeze_ #-} freeze_ = freezeSmallArray {-# INLINE unsafeFreeze #-} @@ -677,11 +856,12 @@ instance Contiguous SmallArray where {-# INLINE rnf #-} 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 () + go !ix = + if ix < sz + then + let !(# x #) = indexSmallArray## ary ix + in DS.rnf x `seq` go (ix + 1) + else () in go 0 {-# INLINE clone_ #-} clone_ = cloneSmallArray @@ -710,7 +890,6 @@ instance ContiguousU SmallArray where {-# INLINE liftMut #-} liftMut x = SmallMutableArray x - instance Contiguous PrimArray where type Mutable PrimArray = MutablePrimArray type Element PrimArray = Prim @@ -737,15 +916,15 @@ instance Contiguous PrimArray where {-# INLINE sizeMut #-} sizeMut = getSizeofMutablePrimArray {-# INLINE slice #-} - slice base offset length = Slice{offset,length,base=unlift base} + slice base offset length = Slice {offset, length, base = unlift base} {-# INLINE sliceMut #-} - sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut} + sliceMut baseMut offsetMut lengthMut = MutableSlice {offsetMut, lengthMut, baseMut = unliftMut baseMut} {-# INLINE toSlice #-} - toSlice base = Slice{offset=0,length=size base,base=unlift base} + toSlice base = Slice {offset = 0, length = size base, base = unlift base} {-# INLINE toSliceMut #-} toSliceMut baseMut = do lengthMut <- sizeMut baseMut - pure MutableSlice{offsetMut=0,lengthMut,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut} {-# INLINE freeze_ #-} freeze_ = freezePrimArrayShim {-# INLINE unsafeFreeze #-} @@ -841,7 +1020,6 @@ instance ContiguousU PrimArray where {-# INLINE liftMut #-} liftMut (MutablePrimArray# x) = MutablePrimArray x - instance Contiguous Array where type Mutable Array = MutableArray type Element Array = Always @@ -868,15 +1046,15 @@ instance Contiguous Array where {-# INLINE sizeMut #-} sizeMut = (\x -> pure $! sizeofMutableArray x) {-# INLINE slice #-} - slice base offset length = Slice{offset,length,base=unlift base} + slice base offset length = Slice {offset, length, base = unlift base} {-# INLINE sliceMut #-} - sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut} + sliceMut baseMut offsetMut lengthMut = MutableSlice {offsetMut, lengthMut, baseMut = unliftMut baseMut} {-# INLINE toSlice #-} - toSlice base = Slice{offset=0,length=size base,base=unlift base} + toSlice base = Slice {offset = 0, length = size base, base = unlift base} {-# INLINE toSliceMut #-} toSliceMut baseMut = do lengthMut <- sizeMut baseMut - pure MutableSlice{offsetMut=0,lengthMut,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut} {-# INLINE freeze_ #-} freeze_ = freezeArray {-# INLINE unsafeFreeze #-} @@ -888,7 +1066,7 @@ instance Contiguous Array where {-# INLINE copyMut_ #-} copyMut_ = copyMutableArray {-# INLINE clone #-} - clone Slice{offset,length,base} = clone_ (lift base) offset length + clone Slice {offset, length, base} = clone_ (lift base) offset length {-# INLINE clone_ #-} clone_ = cloneArray {-# INLINE cloneMut_ #-} @@ -908,7 +1086,7 @@ instance Contiguous Array where | i == sz = () | otherwise = let !(# x #) = indexArray## ary i - in DS.rnf x `seq` go (i+1) + in DS.rnf x `seq` go (i + 1) in go 0 {-# INLINE singleton #-} singleton a = runArrayST (newArray 1 a >>= unsafeFreezeArray) @@ -964,7 +1142,7 @@ instance ContiguousU Array where {-# INLINE liftMut #-} liftMut x = MutableArray x -class (Class.Unlifted a ~ u, PrimUnlifted a) => PrimUnliftsInto (u :: TYPE ('Exts.BoxedRep 'Exts.Unlifted)) (a :: Type) where +class (Class.Unlifted a ~ u, PrimUnlifted a) => PrimUnliftsInto (u :: TYPE ('Exts.BoxedRep 'Exts.Unlifted)) (a :: Type) instance (Class.Unlifted a ~ u, PrimUnlifted a) => PrimUnliftsInto u a instance Contiguous (UnliftedArray_ unlifted_a) where @@ -993,19 +1171,19 @@ instance Contiguous (UnliftedArray_ unlifted_a) where {-# INLINE sizeMut #-} sizeMut = pure . sizeofMutableUnliftedArray {-# INLINE slice #-} - slice base offset length = Slice{offset,length,base=unlift base} + slice base offset length = Slice {offset, length, base = unlift base} {-# INLINE sliceMut #-} - sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut} + sliceMut baseMut offsetMut lengthMut = MutableSlice {offsetMut, lengthMut, baseMut = unliftMut baseMut} {-# INLINE freeze_ #-} freeze_ = freezeUnliftedArray {-# INLINE unsafeFreeze #-} unsafeFreeze = unsafeFreezeUnliftedArray {-# INLINE toSlice #-} - toSlice base = Slice{offset=0,length=size base,base=unlift base} + toSlice base = Slice {offset = 0, length = size base, base = unlift base} {-# INLINE toSliceMut #-} toSliceMut baseMut = do lengthMut <- sizeMut baseMut - pure MutableSlice{offsetMut=0,lengthMut,baseMut=unliftMut baseMut} + pure MutableSlice {offsetMut = 0, lengthMut, baseMut = unliftMut baseMut} {-# INLINE thaw_ #-} thaw_ = thawUnliftedArray {-# INLINE copy_ #-} @@ -1031,7 +1209,7 @@ instance Contiguous (UnliftedArray_ unlifted_a) where | i == sz = () | otherwise = let x = indexUnliftedArray ary i - in DS.rnf x `seq` go (i+1) + in DS.rnf x `seq` go (i + 1) in go 0 {-# INLINE singleton #-} singleton a = runUnliftedArrayST (newUnliftedArray 1 a >>= unsafeFreezeUnliftedArray) @@ -1073,10 +1251,10 @@ instance Contiguous (UnliftedArray_ unlifted_a) where {-# INLINE run #-} run = runUnliftedArrayST -newtype UnliftedArray## (u :: TYPE UnliftedRep) (a :: Type) = - UnliftedArray## (Exts.Array# u) -newtype MutableUnliftedArray## (u :: TYPE UnliftedRep) s (a :: Type) = - MutableUnliftedArray## (Exts.MutableArray# s u) +newtype UnliftedArray## (u :: TYPE UnliftedRep) (a :: Type) + = UnliftedArray## (Exts.Array# u) +newtype MutableUnliftedArray## (u :: TYPE UnliftedRep) s (a :: Type) + = MutableUnliftedArray## (Exts.MutableArray# s u) instance ContiguousU (UnliftedArray_ unlifted_a) where type Unlifted (UnliftedArray_ unlifted_a) = UnliftedArray## unlifted_a diff --git a/src/Data/Primitive/Contiguous/Shim.hs b/src/Data/Primitive/Contiguous/Shim.hs index 275b1ee..961f60a 100644 --- a/src/Data/Primitive/Contiguous/Shim.hs +++ b/src/Data/Primitive/Contiguous/Shim.hs @@ -15,36 +15,36 @@ module Data.Primitive.Contiguous.Shim import Control.Monad (when) import Control.Monad.ST.Run (runPrimArrayST) -import Data.Primitive hiding (fromList,fromListN) +import Data.Primitive hiding (fromList, fromListN) import Data.Primitive.Unlifted.Array -import Prelude hiding (map,all,any,foldr,foldMap,traverse,read,filter,replicate,null,reverse,foldl,foldr,zip,zipWith,scanl,(<$),elem,maximum,minimum,mapM,mapM_,sequence,sequence_) +import Prelude hiding (all, any, elem, filter, foldMap, foldl, foldr, map, mapM, mapM_, maximum, minimum, null, read, replicate, reverse, scanl, sequence, sequence_, traverse, zip, zipWith, (<$)) +import Control.Monad.Primitive (PrimMonad (..), PrimState) import Data.Primitive.Unlifted.Class (PrimUnlifted) -import Control.Monad.Primitive (PrimState, PrimMonad(..)) - errorThunk :: a errorThunk = error "Contiguous typeclass: unitialized element" -{-# noinline errorThunk #-} +{-# NOINLINE errorThunk #-} -resizeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a) +resizeArray :: (PrimMonad m) => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a) resizeArray !src !sz = do dst <- newArray sz errorThunk copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src)) pure dst -{-# inline resizeArray #-} +{-# INLINE resizeArray #-} -resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a) +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 #-} +{-# INLINE resizeSmallArray #-} -replicateSmallMutableArray :: (PrimMonad m) - => Int - -> a - -> m (SmallMutableArray (PrimState m) a) +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 @@ -52,42 +52,45 @@ replicateSmallMutableArray len a = do go (ix + 1) go 0 pure marr -{-# inline replicateSmallMutableArray #-} +{-# INLINE replicateSmallMutableArray #-} 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 #-} +{-# INLINE resizeUnliftedArray #-} -replicateMutablePrimArray :: (PrimMonad m, Prim a) - => Int -- ^ length - -> a -- ^ element - -> m (MutablePrimArray (PrimState m) a) +replicateMutablePrimArray :: + (PrimMonad m, Prim a) => + -- | length + Int -> + -- | element + a -> + m (MutablePrimArray (PrimState m) a) replicateMutablePrimArray len a = do marr <- newPrimArray len setPrimArray marr 0 len a pure marr -{-# inline replicateMutablePrimArray #-} +{-# INLINE replicateMutablePrimArray #-} -clonePrimArrayShim :: Prim a => PrimArray a -> Int -> Int -> PrimArray a +clonePrimArrayShim :: (Prim a) => PrimArray a -> Int -> Int -> PrimArray a clonePrimArrayShim !arr !off !len = runPrimArrayST $ do marr <- newPrimArray len copyPrimArray marr 0 arr off len unsafeFreezePrimArray marr -{-# inline clonePrimArrayShim #-} +{-# INLINE clonePrimArrayShim #-} cloneMutablePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (MutablePrimArray (PrimState m) a) cloneMutablePrimArrayShim !arr !off !len = do marr <- newPrimArray len copyMutablePrimArray marr 0 arr off len pure marr -{-# inline cloneMutablePrimArrayShim #-} +{-# INLINE cloneMutablePrimArrayShim #-} freezePrimArrayShim :: (PrimMonad m, Prim a) => MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a) freezePrimArrayShim !src !off !len = do dst <- newPrimArray len copyMutablePrimArray dst 0 src off len unsafeFreezePrimArray dst -{-# inline freezePrimArrayShim #-} +{-# INLINE freezePrimArrayShim #-} diff --git a/test/Laws.hs b/test/Laws.hs index 2355532..e845f86 100644 --- a/test/Laws.hs +++ b/test/Laws.hs @@ -1,4 +1,6 @@ -{-# language InstanceSigs, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- We define a newtype around `Array a` for the purpose of testing -- the definitions of many typeclass methods from `Data.Primitive.Contiguous`. @@ -8,30 +10,33 @@ module Main (main) where import Data.Foldable import Data.Primitive.Contiguous +import qualified Data.Primitive.Contiguous as C import Data.Proxy +import qualified GHC.Exts as Exts 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 - ] + [ + ( "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 +instance (Arbitrary a) => Arbitrary (Arr a) where arbitrary = fmap (Arr . Exts.fromList) arbitrary arr :: Proxy Arr @@ -59,10 +64,10 @@ instance Foldable Arr where length (Arr a) = C.size a instance Traversable Arr where - traverse :: Applicative f => (a -> f b) -> Arr a -> f (Arr b) + 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 :: (Applicative f) => Arr (f a) -> f (Arr a) sequenceA (Arr f) = fmap Arr (C.sequence f) instance Exts.IsList (Arr a) where @@ -70,5 +75,3 @@ instance Exts.IsList (Arr a) where fromList = Arr . C.fromList fromListN len = Arr . C.fromListN len toList (Arr a) = Exts.toList a - - diff --git a/test/UnitTests.hs b/test/UnitTests.hs index 73c07d7..c36c5ca 100644 --- a/test/UnitTests.hs +++ b/test/UnitTests.hs @@ -1,59 +1,60 @@ -{-# language ExistentialQuantification #-} -{-# language GeneralizedNewtypeDeriving #-} -{-# language ScopedTypeVariables #-} -{-# language UndecidableInstances #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} module Main (main) where -import Data.Functor.Identity (Identity(..)) +import qualified Data.Either as P +import Data.Functor.Identity (Identity (..)) +import qualified Data.List as P +import qualified Data.Maybe as P import Data.Monoid import Data.Primitive -import Prelude -import Test.QuickCheck -import Test.QuickCheck.Instances () -import qualified Data.Maybe as P import qualified Data.Primitive.Contiguous as C +import qualified Data.Vector as V import qualified GHC.Exts as Exts +import Test.QuickCheck +import Test.QuickCheck.Instances () +import Prelude 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 = unitTests unitTests :: IO () -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 - ] +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 + ] -- Verbosity with which to run tests. data Verbosity = Quiet | Verbose -- | Hide the prop type. -data Prop = forall prop. Testable prop => Prop prop - +data Prop = forall prop. (Testable prop) => Prop prop -- hack to let us get away with stuffing different -- prop types in a list @@ -64,12 +65,12 @@ data CTest = CTest } -- quiet output of a test -quiet :: Testable prop => String -> prop -> CTest +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 :: (Testable prop) => String -> prop -> CTest _verbose l p = CTest Verbose l (Prop p) testC :: CTest -> IO () @@ -78,88 +79,98 @@ testC (CTest v lbl (Prop p)) = do putStrLn $ "-- " ++ lbl ++ " --" putStrLn $ P.replicate (length lbl + 6) '-' putStr "\n" - ($ p) $ case v of { Verbose -> verboseCheck; Quiet -> quickCheck } + ($ p) $ case v of Verbose -> verboseCheck; Quiet -> quickCheck putStr "\n" newtype Arr = Arr (Array L) - deriving (Eq,Show) + deriving (Eq, Show) newtype L = L [Int] - deriving (Eq,Ord,Exts.IsList) + deriving (Eq, Ord, Exts.IsList) instance Show L where show (L x) = show x instance Arbitrary L where arbitrary = do - j <- choose (1,6) + j <- choose (1, 6) fmap L $ vectorOf j arbitrary instance Arbitrary Arr where arbitrary = do - k <- choose (2,20) + k <- choose (2, 20) fmap (Arr . Exts.fromList) $ vectorOf k arbitrary shrink (Arr xs) = fmap Arr (fmap Exts.fromList $ shrink $ Exts.toList xs) mean :: forall t a. (Foldable t, Integral a) => t a -> a mean xs = - let (sum_ :: Sum a,len_ :: Sum a) = foldMap (\x -> (Sum x, Sum 1)) xs - in (round :: Double -> a) $ (fromIntegral (getSum sum_) / fromIntegral (getSum len_)) + let (sum_ :: Sum a, len_ :: Sum a) = foldMap (\x -> (Sum x, Sum 1)) xs + in (round :: Double -> a) $ (fromIntegral (getSum sum_) / fromIntegral (getSum len_)) prop_filter :: Arr -> Property -prop_filter (Arr arr) = property $ - let arrList = C.toList arr - p = \(L xs) -> all even xs - in P.filter p arrList == C.toList (C.filter p arr) +prop_filter (Arr arr) = + property $ + let arrList = C.toList arr + p = \(L xs) -> all even xs + in P.filter p arrList == C.toList (C.filter p arr) prop_mapMaybe :: Arr -> Property -prop_mapMaybe (Arr arr) = property $ - let arrList = C.toList arr - p = \(L xs) -> if all even xs then Just () else Nothing - in P.mapMaybe p arrList == C.toList (C.mapMaybe p arr :: Array ()) +prop_mapMaybe (Arr arr) = + property $ + let arrList = C.toList arr + p = \(L xs) -> if all even xs then Just () else Nothing + in P.mapMaybe p arrList == C.toList (C.mapMaybe p arr :: Array ()) prop_reverse1 :: Arr -> Property -prop_reverse1 (Arr arr) = property $ - C.reverse (C.reverse arr) == arr +prop_reverse1 (Arr arr) = + property $ + C.reverse (C.reverse arr) == arr prop_reverse2 :: Arr -> Property -prop_reverse2 (Arr arr) = property $ - let arrList = C.toList arr - in P.reverse arrList == C.toList (C.reverse arr) +prop_reverse2 (Arr arr) = + property $ + let arrList = C.toList arr + in P.reverse arrList == C.toList (C.reverse arr) prop_map :: Arr -> Property -prop_map (Arr arr) = property $ - let arrList = C.toList arr - f = \(L xs) -> mean xs - in P.map f arrList == C.toList (C.map f arr :: Array Int) +prop_map (Arr arr) = + property $ + let arrList = C.toList arr + f = \(L xs) -> mean xs + in P.map f arrList == C.toList (C.map f arr :: Array Int) prop_unfoldr :: Property -prop_unfoldr = property $ - let f = \n -> if n == 0 then Nothing else Just (n,n-1) - sz = 10 - in P.unfoldr f sz == C.toList (C.unfoldr f sz :: Array Int) +prop_unfoldr = + property $ + let f = \n -> if n == 0 then Nothing else Just (n, n - 1) + sz = 10 + in P.unfoldr f sz == C.toList (C.unfoldr f sz :: Array Int) prop_unfoldrN :: Property -prop_unfoldrN = property $ - let f = \n -> if n == 0 then Nothing else Just (n,n-1) - sz = 100 - in V.toList (V.unfoldrN sz f 10) == C.toList (C.unfoldrN sz f 10 :: Array Int) +prop_unfoldrN = + property $ + let f = \n -> if n == 0 then Nothing else Just (n, n - 1) + sz = 100 + in V.toList (V.unfoldrN sz f 10) == C.toList (C.unfoldrN sz f 10 :: Array Int) prop_traverse :: Arr -> Property -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 :: Identity (Array Int))) +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 :: Identity (Array Int))) 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_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_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 @@ -170,90 +181,100 @@ prop_postscanl (Arr arr) = property $ -} 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 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_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_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_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_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 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_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_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_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_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_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 +prop_maximum (Arr arr) = + property $ + let arrList = C.toList arr + in Just (maximum arrList) == C.maximum arr -newtype Array' a = Array' { getArray' :: Array a } +newtype Array' a = Array' {getArray' :: Array a} deriving (Eq, Show, Exts.IsList) -instance Arbitrary a => Arbitrary (Array' a) where +instance (Arbitrary a) => Arbitrary (Array' a) where arbitrary = do - k <- choose (2,20) + 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 } +-- newtype GenArrM = GenArr { getGenArrM :: Array Int } -- deriving (Eq, Show, Exts.IsList) ---instance Arbitrary GenArrM where +-- 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 - -