contiguous 0.5.2 → 0.6.0
raw patch · 4 files changed
+1196/−611 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Primitive.Contiguous: cloneMutable :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (Mutable arr (PrimState m) b)
- Data.Primitive.Contiguous: copyMutable :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()
- Data.Primitive.Contiguous: equalsMutable :: Contiguous arr => Mutable arr s a -> Mutable arr s a -> Bool
- Data.Primitive.Contiguous: insertSlicing :: (Contiguous arr, Element arr b) => arr b -> Int -> Int -> Int -> b -> arr b
- Data.Primitive.Contiguous: instance Data.Primitive.Contiguous.Always a
- Data.Primitive.Contiguous: instance Data.Primitive.Contiguous.Contiguous Data.Primitive.Array.Array
- Data.Primitive.Contiguous: instance Data.Primitive.Contiguous.Contiguous Data.Primitive.PrimArray.PrimArray
- Data.Primitive.Contiguous: instance Data.Primitive.Contiguous.Contiguous Data.Primitive.SmallArray.SmallArray
- Data.Primitive.Contiguous: instance Data.Primitive.Contiguous.Contiguous Data.Primitive.Unlifted.Array.UnliftedArray
- Data.Primitive.Contiguous: replicateMutable :: (Contiguous arr, PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)
- Data.Primitive.Contiguous: replicateMutableM :: (PrimMonad m, Contiguous arr, Element arr a) => Int -> m a -> m (Mutable arr (PrimState m) a)
- Data.Primitive.Contiguous: sizeMutable :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int
+ Data.Primitive.Contiguous: -- of a mutable slice should be the same slice type.
+ Data.Primitive.Contiguous: -- should be 'Slice t', whereas the slice of a slice should be the same
+ Data.Primitive.Contiguous: -- slice type.
+ Data.Primitive.Contiguous: -- type <tt>t</tt> should be 'MutableSlice t', whereas the mutable slice
+ Data.Primitive.Contiguous: class (Contiguous arr) => ContiguousU arr
+ Data.Primitive.Contiguous: cloneMut :: (Contiguous arr, PrimMonad m, Element arr b) => MutableSliced arr (PrimState m) b -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous: copyMut :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> MutableSliced arr (PrimState m) b -> m ()
+ Data.Primitive.Contiguous: data MutableSlice arr s a
+ Data.Primitive.Contiguous: data Slice arr a
+ Data.Primitive.Contiguous: deleteAt :: (Contiguous arr, Element arr a) => arr a -> Int -> arr a
+ Data.Primitive.Contiguous: equalsMut :: Contiguous arr => Mutable arr s a -> Mutable arr s a -> Bool
+ Data.Primitive.Contiguous: ifoldr :: (Contiguous arr, Element arr a) => (Int -> a -> b -> b) -> b -> arr a -> b
+ Data.Primitive.Contiguous: liftMut :: ContiguousU arr => UnliftedMut arr s b -> Mutable arr s b
+ Data.Primitive.Contiguous: replicateMut :: (Contiguous arr, PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous: replicateMutM :: (PrimMonad m, Contiguous arr, Element arr a) => Int -> m a -> m (Mutable arr (PrimState m) a)
+ Data.Primitive.Contiguous: shrink :: (Contiguous arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> Int -> m (Mutable arr (PrimState m) a)
+ Data.Primitive.Contiguous: sizeMut :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int
+ Data.Primitive.Contiguous: slice :: (Contiguous arr, Element arr a) => arr a -> Int -> Int -> Sliced arr a
+ Data.Primitive.Contiguous: sliceMut :: (Contiguous arr, Element arr a) => Mutable arr s a -> Int -> Int -> MutableSliced arr s a
+ Data.Primitive.Contiguous: toSlice :: (Contiguous arr, Element arr a) => arr a -> Sliced arr a
+ Data.Primitive.Contiguous: toSliceMut :: (Contiguous arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> m (MutableSliced arr (PrimState m) a)
+ Data.Primitive.Contiguous: unliftMut :: ContiguousU arr => Mutable arr s b -> UnliftedMut arr s b
+ Data.Primitive.Contiguous: unsafeShrinkAndFreeze :: (Contiguous arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> Int -> m (arr a)
+ Data.Primitive.Contiguous.Class: -- indirection through a thunk).
+ Data.Primitive.Contiguous.Class: -- of a mutable slice should be the same slice type.
+ Data.Primitive.Contiguous.Class: -- should be 'Slice t', whereas the slice of a slice should be the same
+ Data.Primitive.Contiguous.Class: -- slice type.
+ Data.Primitive.Contiguous.Class: -- type <tt>t</tt> should be 'MutableSlice t', whereas the mutable slice
+ Data.Primitive.Contiguous.Class: -- | The unifted version of the mutable array type (i.e. eliminates an
+ Data.Primitive.Contiguous.Class: MutableSlice :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !UnliftedMut arr s a -> MutableSlice arr s a
+ Data.Primitive.Contiguous.Class: Slice :: {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !Unlifted arr a -> Slice arr a
+ Data.Primitive.Contiguous.Class: [baseMut] :: MutableSlice arr s a -> !UnliftedMut arr s a
+ Data.Primitive.Contiguous.Class: [base] :: Slice arr a -> !Unlifted arr a
+ Data.Primitive.Contiguous.Class: [lengthMut] :: MutableSlice arr s a -> {-# UNPACK #-} !Int
+ Data.Primitive.Contiguous.Class: [length] :: Slice arr a -> {-# UNPACK #-} !Int
+ Data.Primitive.Contiguous.Class: [offsetMut] :: MutableSlice arr s a -> {-# UNPACK #-} !Int
+ Data.Primitive.Contiguous.Class: [offset] :: Slice arr a -> {-# UNPACK #-} !Int
+ Data.Primitive.Contiguous.Class: class Always a
+ Data.Primitive.Contiguous.Class: class Contiguous (arr :: Type -> Type) where {
+ Data.Primitive.Contiguous.Class: class (Contiguous arr) => ContiguousU arr where {
+ Data.Primitive.Contiguous.Class: clone :: (Contiguous arr, Sliced arr ~ Slice arr, ContiguousU arr, Element arr b) => Sliced arr b -> arr b
+ Data.Primitive.Contiguous.Class: cloneMut :: (Contiguous arr, MutableSliced arr ~ MutableSlice arr, ContiguousU arr, PrimMonad m, Element arr b) => MutableSliced arr (PrimState m) b -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: cloneMut_ :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: clone_ :: (Contiguous arr, Element arr a) => arr a -> Int -> Int -> arr a
+ Data.Primitive.Contiguous.Class: copy :: (Contiguous arr, Sliced arr ~ Slice arr, ContiguousU arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
+ Data.Primitive.Contiguous.Class: copyMut :: (Contiguous arr, MutableSliced arr ~ MutableSlice arr, ContiguousU arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> MutableSliced arr (PrimState m) b -> m ()
+ Data.Primitive.Contiguous.Class: copyMut_ :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()
+ Data.Primitive.Contiguous.Class: copy_ :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
+ Data.Primitive.Contiguous.Class: data MutableSlice arr s a
+ Data.Primitive.Contiguous.Class: data Slice arr a
+ Data.Primitive.Contiguous.Class: doubleton :: (Contiguous arr, Element arr a) => a -> a -> arr a
+ Data.Primitive.Contiguous.Class: empty :: Contiguous arr => arr a
+ Data.Primitive.Contiguous.Class: equals :: (Contiguous arr, Element arr b, Eq b) => arr b -> arr b -> Bool
+ Data.Primitive.Contiguous.Class: equalsMut :: Contiguous arr => Mutable arr s a -> Mutable arr s a -> Bool
+ Data.Primitive.Contiguous.Class: freeze :: (Contiguous arr, MutableSliced arr ~ MutableSlice arr, ContiguousU arr, PrimMonad m, Element arr a) => MutableSliced arr (PrimState m) a -> m (arr a)
+ Data.Primitive.Contiguous.Class: freeze_ :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
+ Data.Primitive.Contiguous.Class: index :: (Contiguous arr, Element arr b) => arr b -> Int -> b
+ Data.Primitive.Contiguous.Class: index# :: (Contiguous arr, Element arr b) => arr b -> Int -> (# b #)
+ Data.Primitive.Contiguous.Class: indexM :: (Contiguous arr, Element arr b, Monad m) => arr b -> Int -> m b
+ Data.Primitive.Contiguous.Class: insertAt :: (Contiguous arr, Element arr b, ContiguousU arr) => arr b -> Int -> b -> arr b
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.Always a
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.Contiguous Data.Primitive.Array.Array
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.Contiguous Data.Primitive.PrimArray.PrimArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.Contiguous Data.Primitive.SmallArray.SmallArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.Contiguous Data.Primitive.Unlifted.Array.UnliftedArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.ContiguousU Data.Primitive.Array.Array
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.ContiguousU Data.Primitive.PrimArray.PrimArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.ContiguousU Data.Primitive.SmallArray.SmallArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.ContiguousU Data.Primitive.Unlifted.Array.UnliftedArray
+ Data.Primitive.Contiguous.Class: instance Data.Primitive.Contiguous.Class.ContiguousU arr => Data.Primitive.Contiguous.Class.Contiguous (Data.Primitive.Contiguous.Class.Slice arr)
+ Data.Primitive.Contiguous.Class: lift :: ContiguousU arr => Unlifted arr b -> arr b
+ Data.Primitive.Contiguous.Class: liftMut :: ContiguousU arr => UnliftedMut arr s b -> Mutable arr s b
+ Data.Primitive.Contiguous.Class: new :: (Contiguous arr, PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: null :: Contiguous arr => arr b -> Bool
+ Data.Primitive.Contiguous.Class: quadrupleton :: (Contiguous arr, Element arr a) => a -> a -> a -> a -> arr a
+ Data.Primitive.Contiguous.Class: read :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m b
+ Data.Primitive.Contiguous.Class: replicateMut :: (Contiguous arr, PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: resize :: (ContiguousU arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: rnf :: (Contiguous arr, NFData a, Element arr a) => arr a -> ()
+ Data.Primitive.Contiguous.Class: run :: Contiguous arr => (forall s. ST s (arr a)) -> arr a
+ Data.Primitive.Contiguous.Class: shrink :: (Contiguous arr, ContiguousU arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> Int -> m (Mutable arr (PrimState m) a)
+ Data.Primitive.Contiguous.Class: singleton :: (Contiguous arr, Element arr a) => a -> arr a
+ Data.Primitive.Contiguous.Class: size :: (Contiguous arr, Element arr b) => arr b -> Int
+ Data.Primitive.Contiguous.Class: sizeMut :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int
+ Data.Primitive.Contiguous.Class: slice :: (Contiguous arr, Element arr a) => arr a -> Int -> Int -> Sliced arr a
+ Data.Primitive.Contiguous.Class: sliceMut :: (Contiguous arr, Element arr a) => Mutable arr s a -> Int -> Int -> MutableSliced arr s a
+ Data.Primitive.Contiguous.Class: thaw :: (Contiguous arr, Sliced arr ~ Slice arr, ContiguousU arr, PrimMonad m, Element arr b) => Sliced arr b -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: thaw_ :: (Contiguous arr, PrimMonad m, Element arr b) => arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous.Class: toSlice :: (Contiguous arr, Element arr a) => arr a -> Sliced arr a
+ Data.Primitive.Contiguous.Class: toSliceMut :: (Contiguous arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> m (MutableSliced arr (PrimState m) a)
+ Data.Primitive.Contiguous.Class: tripleton :: (Contiguous arr, Element arr a) => a -> a -> a -> arr a
+ Data.Primitive.Contiguous.Class: type family UnliftedMut arr = (r :: Type -> Type -> TYPE 'UnliftedRep) | r -> arr;
+ Data.Primitive.Contiguous.Class: unlift :: ContiguousU arr => arr b -> Unlifted arr b
+ Data.Primitive.Contiguous.Class: unliftMut :: ContiguousU arr => Mutable arr s b -> UnliftedMut arr s b
+ Data.Primitive.Contiguous.Class: unsafeFreeze :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m (arr b)
+ Data.Primitive.Contiguous.Class: unsafeShrinkAndFreeze :: (Contiguous arr, ContiguousU arr, PrimMonad m, Element arr a) => Mutable arr (PrimState m) a -> Int -> m (arr a)
+ Data.Primitive.Contiguous.Class: write :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> b -> m ()
+ Data.Primitive.Contiguous.Class: }
- Data.Primitive.Contiguous: -- | The constraint needed to store elements in the array.
+ Data.Primitive.Contiguous: -- | The mutable slice type of this array. The mutable slice of a raw array
- Data.Primitive.Contiguous: clone :: (Contiguous arr, Element arr b) => arr b -> Int -> Int -> arr b
+ Data.Primitive.Contiguous: clone :: (Contiguous arr, Element arr b) => Sliced arr b -> arr b
- Data.Primitive.Contiguous: copy :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
+ Data.Primitive.Contiguous: copy :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
- Data.Primitive.Contiguous: freeze :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
+ Data.Primitive.Contiguous: freeze :: (Contiguous arr, PrimMonad m, Element arr a) => MutableSliced arr (PrimState m) a -> m (arr a)
- Data.Primitive.Contiguous: insertAt :: (Contiguous arr, Element arr a) => arr a -> Int -> a -> arr a
+ Data.Primitive.Contiguous: insertAt :: (Contiguous arr, Element arr b) => arr b -> Int -> b -> arr b
- Data.Primitive.Contiguous: lift :: Contiguous arr => ArrayArray# -> arr b
+ Data.Primitive.Contiguous: lift :: ContiguousU arr => Unlifted arr b -> arr b
- Data.Primitive.Contiguous: resize :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous: resize :: (ContiguousU arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)
- Data.Primitive.Contiguous: same :: Contiguous arr => arr a -> arr a -> Bool
+ Data.Primitive.Contiguous: same :: ContiguousU arr => arr a -> arr a -> Bool
- Data.Primitive.Contiguous: thaw :: (Contiguous arr, PrimMonad m, Element arr b) => arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)
+ Data.Primitive.Contiguous: thaw :: (Contiguous arr, PrimMonad m, Element arr b) => Sliced arr b -> m (Mutable arr (PrimState m) b)
- Data.Primitive.Contiguous: traverseP :: (PrimMonad m, Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b) => (a -> m b) -> arr1 a -> m (arr2 b)
+ Data.Primitive.Contiguous: traverseP :: (PrimMonad m, Contiguous arr1, Element arr1 a, Contiguous arr2, Element arr2 b) => (a -> m b) -> arr1 a -> m (arr2 b)
- Data.Primitive.Contiguous: type family Element arr :: Type -> Constraint;
+ Data.Primitive.Contiguous: type family MutableSliced arr :: Type -> Type -> Type;
- Data.Primitive.Contiguous: unlift :: Contiguous arr => arr b -> ArrayArray#
+ Data.Primitive.Contiguous: unlift :: ContiguousU arr => arr b -> Unlifted arr b
- Data.Primitive.Contiguous: unsafeFreeze :: (Contiguous arr, PrimMonad m) => Mutable arr (PrimState m) b -> m (arr b)
+ Data.Primitive.Contiguous: unsafeFreeze :: (Contiguous arr, PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m (arr b)
Files
- contiguous.cabal +4/−1
- src/Data/Primitive/Contiguous.hs +104/−610
- src/Data/Primitive/Contiguous/Class.hs +995/−0
- src/Data/Primitive/Contiguous/Shim.hs +93/−0
contiguous.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: contiguous-version: 0.5.2+version: 0.6.0 homepage: https://github.com/andrewthad/contiguous bug-reports: https://github.com/andrewthad/contiguous/issues author: Andrew Martin@@ -24,6 +24,9 @@ library exposed-modules: Data.Primitive.Contiguous+ Data.Primitive.Contiguous.Class+ other-modules:+ Data.Primitive.Contiguous.Shim hs-source-dirs: src build-depends: base >=4.11.1.0 && <5
src/Data/Primitive/Contiguous.hs view
@@ -8,15 +8,19 @@ {-# language TypeFamilyDependencies #-} {-# language UnboxedTuples #-} --- | The contiguous typeclass parameterises over a contiguous array type.--- This allows us to have a common API to a number of contiguous--- array types and their mutable counterparts.+-- | 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 -- ** Length Information size- , sizeMutable+ , sizeMut , null -- ** Indexing , index@@ -34,7 +38,7 @@ , tripleton , quadrupleton , replicate- , replicateMutable+ , replicateMut , generate , generateM , generateMutable@@ -44,7 +48,7 @@ -- ** Running , run -- ** Monadic initialisation- , replicateMutableM+ , replicateMutM , generateMutableM , iterateMutableNM , create@@ -60,13 +64,22 @@ , append -- ** Splitting and Splicing , insertAt- , insertSlicing++ -- * Slicing+ , Slice+ , MutableSlice+ , slice+ , sliceMut+ , toSlice+ , toSliceMut+ -- * Modifying arrays , replaceAt , modifyAt , modifyAt' , modifyAtF , modifyAtF'+ , deleteAt -- ** Permutations , reverse , reverseMutable@@ -74,6 +87,8 @@ -- ** Resizing , resize+ , shrink+ , unsafeShrinkAndFreeze -- * Elementwise operations -- ** Mapping@@ -115,7 +130,7 @@ , minimumBy -- ** Comparing for equality , equals- , equalsMutable+ , equalsMut , same -- * Folds@@ -127,6 +142,7 @@ , foldMap' , foldlMap' , ifoldl'+ , ifoldr , ifoldr' , ifoldlMap' , ifoldlMap1'@@ -189,12 +205,14 @@ -- ** Other array types , convert , lift+ , liftMut , unlift+ , unliftMut -- ** Between mutable and immutable variants , clone- , cloneMutable+ , cloneMut , copy- , copyMutable+ , copyMut , freeze , thaw , unsafeFreeze@@ -206,7 +224,8 @@ , rnf -- * Classes- , Contiguous(Mutable,Element)+ , Contiguous(Mutable,Element,Sliced,MutableSliced)+ , ContiguousU , Always -- * Re-Exports@@ -226,557 +245,43 @@ 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 Control.Applicative (liftA2)-import Control.DeepSeq (NFData) import Control.Monad (when) import Control.Monad.ST (runST,ST)-import Control.Monad.ST.Run (runPrimArrayST,runSmallArrayST,runUnliftedArrayST,runArrayST) import Data.Bits (xor) import Data.Coerce (coerce)-import Data.Kind (Type)-import Data.Primitive.Unlifted.Class (PrimUnlifted)+import Data.Primitive.Contiguous.Class (Contiguous(..), ContiguousU(..), Slice, MutableSlice, Always) import Data.Semigroup (First(..)) import Data.Word (Word8) import GHC.Base (build)-import GHC.Exts (MutableArrayArray#,ArrayArray#,Constraint,sizeofByteArray#,sizeofArray#,sizeofArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#,dataToTag#,Int(..))+import GHC.Exts (MutableArrayArray#,unsafeCoerce#,sameMutableArrayArray#,isTrue#,dataToTag#,Int(..)) import qualified Control.Applicative as A-import qualified Control.DeepSeq as DS import qualified Prelude --- | A typeclass that is satisfied by all types. This is used--- used to provide a fake constraint for 'Array' and 'SmallArray'.-class Always a-instance Always a --- | The 'Contiguous' typeclass as an interface to a multitude of--- contiguous structures.-class Contiguous (arr :: Type -> Type) where- -- | The Mutable counterpart to the array.- type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr- -- | The constraint needed to store elements in the array.- type family Element arr :: Type -> Constraint- -- | The empty array.- empty :: arr a- -- | Test whether the array is empty.- null :: arr b -> Bool- -- | Allocate a new mutable array of the given size.- new :: (PrimMonad m, Element arr b) => Int -> m (Mutable arr (PrimState m) b)- -- | @'replicateMutable' n x@ is a mutable array of length @n@ with @x@ the value of every element.- replicateMutable :: (PrimMonad m, Element arr b) => Int -> b -> m (Mutable arr (PrimState m) b)- -- | Index into an array at the given index.- index :: Element arr b => arr b -> Int -> b- -- | Index into an array at the given index, yielding an unboxed one-tuple of the element.- index# :: Element arr b => arr b -> Int -> (# b #)- -- | Indexing in a monad.- --- -- The monad allows operations to be strict in the array- -- when necessary. Suppose array copying is implemented like this:- --- -- > copy mv v = ... write mv i (v ! i) ...- --- -- For lazy arrays, @v ! i@ would not be not be evaluated,- -- which means that @mv@ would unnecessarily retain a reference- -- to @v@ in each element written.- --- -- With 'indexM', copying can be implemented like this instead:- --- -- > copy mv v = ... do- -- > x <- indexM v i- -- > write mv i x- --- -- Here, no references to @v@ are retained because indexing- -- (but /not/ the elements) is evaluated eagerly.- indexM :: (Element arr b, Monad m) => arr b -> Int -> m b- -- | Read a mutable array at the given index.- read :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m b- -- | Write to a mutable array at the given index.- write :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> b -> m ()- -- | Resize an array into one with the given size.- resize :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> Int -> m (Mutable arr (PrimState m) b)- -- | The size of the array- size :: Element arr b => arr b -> Int- -- | The size of the mutable array- sizeMutable :: (PrimMonad m, Element arr b) => Mutable arr (PrimState m) b -> m Int- -- | Turn a mutable array into an immutable one without copying.- -- The mutable array should not be used after this conversion.- unsafeFreeze :: PrimMonad m => Mutable arr (PrimState m) b -> m (arr b)- -- | Turn a mutable array into an immutable one with copying, using a slice of the mutable array.- freeze :: (PrimMonad m, Element arr b)- => Mutable arr (PrimState m) b- -> Int -- ^ offset into the array- -> Int -- ^ length of the slice- -> m (arr b)- -- | Copy a slice of an immutable array into a new mutable array.- thaw :: (PrimMonad m, Element arr b)- => arr b- -> Int -- ^ offset into the array- -> Int -- ^ length of the slice- -> m (Mutable arr (PrimState m) b)- -- | Copy a slice of an array into a mutable array.- copy :: (PrimMonad m, Element arr b)- => Mutable arr (PrimState m) b -- ^ destination array- -> Int -- ^ offset into destination array- -> arr b -- ^ source array- -> Int -- ^ offset into source array- -> Int -- ^ number of elements to copy- -> m ()- -- | Copy a slice of a mutable array into another mutable array.- -- In the case that the destination and source arrays are the- -- same, the regions may overlap.- copyMutable :: (PrimMonad m, Element arr b)- => Mutable arr (PrimState m) b -- ^ destination array- -> Int -- ^ offset into destination array- -> Mutable arr (PrimState m) b -- ^ source array- -> Int -- ^ offset into source array- -> Int -- ^ number of elements to copy- -> m ()- -- | Clone a slice of an array.- clone :: Element arr b- => arr b -- ^ Array to copy a slice of- -> Int -- ^ Offset into the array- -> Int -- ^ Length of the slice- -> arr b- -- | Clone a slice of a mutable array.- cloneMutable :: (PrimMonad m, Element arr b)- => Mutable arr (PrimState m) b -- ^ Array to copy a slice of- -> Int -- ^ Offset into the array- -> Int -- ^ Length of the slice- -> m (Mutable arr (PrimState m) b)- -- | Copy a slice of an array an then insert an element into that array.- --- -- The default implementation performs a memset which would be unnecessary- -- except that the garbage collector might trace the uninitialized array.- insertSlicing :: Element arr b- => arr b -- ^ array to copy a slice from- -> Int -- ^ offset into source array- -> Int -- ^ length of the slice- -> Int -- ^ index in the output array to insert at- -> b -- ^ element to insert- -> arr b- insertSlicing src off len0 i x = run $ do- dst <- replicateMutable (len0 + 1) x- copy dst 0 src off i- copy dst (i + 1) src (off + i) (len0 - i)- unsafeFreeze dst- {-# inline insertSlicing #-}- -- | Test the two arrays for equality.- equals :: (Element arr b, Eq b) => arr b -> arr b -> Bool- -- | Test the two mutable arrays for pointer equality.- -- Does not check equality of elements.- equalsMutable :: Mutable arr s a -> Mutable arr s a -> Bool- -- | Unlift an array into an 'ArrayArray#'.- unlift :: arr b -> ArrayArray#- -- | Lift an 'ArrayArray#' into an array.- lift :: ArrayArray# -> arr b- -- | Create a singleton array.- singleton :: Element arr a => a -> arr a- -- | Create a doubleton array.- doubleton :: Element arr a => a -> a -> arr a- -- | Create a tripleton array.- tripleton :: Element arr a => a -> a -> a -> arr a- -- | Create a quadrupleton array.- quadrupleton :: Element arr a => a -> a -> a -> a -> arr a- -- | 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--instance Contiguous SmallArray where- type Mutable SmallArray = SmallMutableArray- type Element SmallArray = Always- empty = mempty- new n = newSmallArray n errorThunk- index = indexSmallArray- indexM = indexSmallArrayM- index# = indexSmallArray##- read = readSmallArray- write = writeSmallArray- null a = case sizeofSmallArray a of- 0 -> True- _ -> False- freeze = freezeSmallArray- size = sizeofSmallArray- sizeMutable = (\x -> pure $! sizeofSmallMutableArray x)- unsafeFreeze = unsafeFreezeSmallArray- thaw = thawSmallArray- equals = (==)- equalsMutable = (==)- singleton a = runST $ do- marr <- newSmallArray 1 errorThunk- writeSmallArray marr 0 a- unsafeFreezeSmallArray marr- doubleton a b = runST $ do- m <- newSmallArray 2 errorThunk- writeSmallArray m 0 a- writeSmallArray m 1 b- unsafeFreezeSmallArray m- tripleton a b c = runST $ do- m <- newSmallArray 3 errorThunk- writeSmallArray m 0 a- writeSmallArray m 1 b- writeSmallArray m 2 c- unsafeFreezeSmallArray m- quadrupleton a b c d = runST $ do- m <- newSmallArray 4 errorThunk- writeSmallArray m 0 a- writeSmallArray m 1 b- writeSmallArray m 2 c- writeSmallArray m 3 d- unsafeFreezeSmallArray m- rnf !ary =- let !sz = sizeofSmallArray ary- go !ix = if ix < sz- then- let !(# x #) = indexSmallArray## ary ix- in DS.rnf x `seq` go (ix + 1)- else ()- in go 0- clone = cloneSmallArray- cloneMutable = cloneSmallMutableArray- lift x = SmallArray (unsafeCoerce# x)- unlift (SmallArray x) = unsafeCoerce# x- copy = copySmallArray- copyMutable = copySmallMutableArray- replicateMutable = replicateSmallMutableArray- resize = resizeSmallArray- run = runSmallArrayST- {-# inline empty #-}- {-# inline null #-}- {-# inline new #-}- {-# inline replicateMutable #-}- {-# inline index #-}- {-# inline index# #-}- {-# inline indexM #-}- {-# inline read #-}- {-# inline write #-}- {-# inline resize #-}- {-# inline size #-}- {-# inline sizeMutable #-}- {-# inline unsafeFreeze #-}- {-# inline freeze #-}- {-# inline thaw #-}- {-# inline copy #-}- {-# inline copyMutable #-}- {-# inline clone #-}- {-# inline cloneMutable #-}- {-# inline equals #-}- {-# inline equalsMutable #-}- {-# inline unlift #-}- {-# inline lift #-}- {-# inline singleton #-}- {-# inline doubleton #-}- {-# inline tripleton #-}- {-# inline quadrupleton #-}- {-# inline rnf #-}- {-# inline run #-}--instance Contiguous PrimArray where- type Mutable PrimArray = MutablePrimArray- type Element PrimArray = Prim- empty = mempty- new = newPrimArray- replicateMutable = replicateMutablePrimArray- index = indexPrimArray- index# arr ix = (# indexPrimArray arr ix #)- indexM arr ix = pure (indexPrimArray arr ix)- read = readPrimArray- write = writePrimArray- resize = resizeMutablePrimArray- size = sizeofPrimArray- sizeMutable = getSizeofMutablePrimArray- freeze = freezePrimArrayShim- unsafeFreeze = unsafeFreezePrimArray- thaw = thawPrimArray- copy = copyPrimArray- copyMutable = copyMutablePrimArray- clone = clonePrimArrayShim- cloneMutable = cloneMutablePrimArrayShim- equals = (==)- unlift (PrimArray x) = unsafeCoerce# x- lift x = PrimArray (unsafeCoerce# x)- null (PrimArray a) = case sizeofByteArray# a of- 0# -> True- _ -> False- equalsMutable = sameMutablePrimArray- rnf (PrimArray !_) = ()- singleton a = runPrimArrayST $ do- marr <- newPrimArray 1- writePrimArray marr 0 a- unsafeFreezePrimArray marr- doubleton a b = runPrimArrayST $ do- m <- newPrimArray 2- writePrimArray m 0 a- writePrimArray m 1 b- unsafeFreezePrimArray m- tripleton a b c = runPrimArrayST $ do- m <- newPrimArray 3- writePrimArray m 0 a- writePrimArray m 1 b- writePrimArray m 2 c- unsafeFreezePrimArray m- quadrupleton a b c d = runPrimArrayST $ do- m <- newPrimArray 4- writePrimArray m 0 a- writePrimArray m 1 b- writePrimArray m 2 c- writePrimArray m 3 d- unsafeFreezePrimArray m- insertSlicing src off len0 i x = runPrimArrayST $ do- dst <- new (len0 + 1)- copy dst 0 src off i- write dst i x- copy dst (i + 1) src (off + i) (len0 - i)- unsafeFreeze dst- run = runPrimArrayST- {-# inline empty #-}- {-# inline null #-}- {-# inline new #-}- {-# inline replicateMutable #-}- {-# inline index #-}- {-# inline index# #-}- {-# inline indexM #-}- {-# inline read #-}- {-# inline write #-}- {-# inline resize #-}- {-# inline size #-}- {-# inline sizeMutable #-}- {-# inline unsafeFreeze #-}- {-# inline freeze #-}- {-# inline thaw #-}- {-# inline copy #-}- {-# inline copyMutable #-}- {-# inline clone #-}- {-# inline cloneMutable #-}- {-# inline insertSlicing #-}- {-# inline equals #-}- {-# inline equalsMutable #-}- {-# inline unlift #-}- {-# inline lift #-}- {-# inline singleton #-}- {-# inline doubleton #-}- {-# inline tripleton #-}- {-# inline quadrupleton #-}- {-# inline rnf #-}- {-# inline run #-}--instance Contiguous Array where- type Mutable Array = MutableArray- type Element Array = Always- empty = mempty- new n = newArray n errorThunk- replicateMutable = newArray- index = indexArray- index# = indexArray##- indexM = indexArrayM- read = readArray- write = writeArray- resize = resizeArray- size = sizeofArray- sizeMutable = (\x -> pure $! sizeofMutableArray x)- freeze = freezeArray- unsafeFreeze = unsafeFreezeArray- thaw = thawArray- copy = copyArray- copyMutable = copyMutableArray- clone = cloneArray- cloneMutable = cloneMutableArray- equals = (==)- unlift (Array x) = unsafeCoerce# x- lift x = Array (unsafeCoerce# x)- null (Array a) = case sizeofArray# a of- 0# -> True- _ -> False- equalsMutable = sameMutableArray- rnf !ary =- let !sz = sizeofArray ary- go !i- | i == sz = ()- | otherwise =- let !(# x #) = indexArray## ary i- in DS.rnf x `seq` go (i+1)- in go 0- singleton a = runArrayST (newArray 1 a >>= unsafeFreezeArray)- doubleton a b = runArrayST $ do- m <- newArray 2 a- writeArray m 1 b- unsafeFreezeArray m- tripleton a b c = runArrayST $ do- m <- newArray 3 a- writeArray m 1 b- writeArray m 2 c- unsafeFreezeArray m- quadrupleton a b c d = runArrayST $ do- m <- newArray 4 a- writeArray m 1 b- writeArray m 2 c- writeArray m 3 d- unsafeFreezeArray m- run = runArrayST- {-# inline empty #-}- {-# inline null #-}- {-# inline new #-}- {-# inline replicateMutable #-}- {-# inline index #-}- {-# inline index# #-}- {-# inline indexM #-}- {-# inline read #-}- {-# inline write #-}- {-# inline resize #-}- {-# inline size #-}- {-# inline sizeMutable #-}- {-# inline unsafeFreeze #-}- {-# inline freeze #-}- {-# inline thaw #-}- {-# inline copy #-}- {-# inline copyMutable #-}- {-# inline clone #-}- {-# inline cloneMutable #-}- {-# inline equals #-}- {-# inline equalsMutable #-}- {-# inline unlift #-}- {-# inline lift #-}- {-# inline singleton #-}- {-# inline doubleton #-}- {-# inline tripleton #-}- {-# inline quadrupleton #-}- {-# inline rnf #-}- {-# inline run #-}--instance Contiguous UnliftedArray where- type Mutable UnliftedArray = MutableUnliftedArray- type Element UnliftedArray = PrimUnlifted- empty = emptyUnliftedArray- new = unsafeNewUnliftedArray- replicateMutable = newUnliftedArray- index = indexUnliftedArray- index# arr ix = (# indexUnliftedArray arr ix #)- indexM arr ix = pure (indexUnliftedArray arr ix)- read = readUnliftedArray- write = writeUnliftedArray- resize = resizeUnliftedArray- size = sizeofUnliftedArray- sizeMutable = pure . sizeofMutableUnliftedArray- freeze = freezeUnliftedArray- unsafeFreeze = unsafeFreezeUnliftedArray- thaw = thawUnliftedArray- copy = copyUnliftedArray- copyMutable = copyMutableUnliftedArray- clone = cloneUnliftedArray- cloneMutable = cloneMutableUnliftedArray- equals = (==)- unlift (UnliftedArray x) = x- lift x = UnliftedArray x- null (UnliftedArray a) = case sizeofArrayArray# a of- 0# -> True- _ -> False- equalsMutable = sameMutableUnliftedArray- rnf !ary =- let !sz = sizeofUnliftedArray ary- go !i- | i == sz = ()- | otherwise =- let x = indexUnliftedArray ary i- in DS.rnf x `seq` go (i+1)- in go 0- singleton a = runUnliftedArrayST (newUnliftedArray 1 a >>= unsafeFreezeUnliftedArray)- doubleton a b = runUnliftedArrayST $ do- m <- newUnliftedArray 2 a- writeUnliftedArray m 1 b- unsafeFreezeUnliftedArray m- tripleton a b c = runUnliftedArrayST $ do- m <- newUnliftedArray 3 a- writeUnliftedArray m 1 b- writeUnliftedArray m 2 c- unsafeFreezeUnliftedArray m- quadrupleton a b c d = runUnliftedArrayST $ do- m <- newUnliftedArray 4 a- writeUnliftedArray m 1 b- writeUnliftedArray m 2 c- writeUnliftedArray m 3 d- unsafeFreezeUnliftedArray m- run = runUnliftedArrayST- {-# inline empty #-}- {-# inline null #-}- {-# inline new #-}- {-# inline replicateMutable #-}- {-# inline index #-}- {-# inline index# #-}- {-# inline indexM #-}- {-# inline read #-}- {-# inline write #-}- {-# inline resize #-}- {-# inline size #-}- {-# inline sizeMutable #-}- {-# inline unsafeFreeze #-}- {-# inline freeze #-}- {-# inline thaw #-}- {-# inline copy #-}- {-# inline copyMutable #-}- {-# inline clone #-}- {-# inline cloneMutable #-}- {-# inline equals #-}- {-# inline equalsMutable #-}- {-# inline unlift #-}- {-# inline lift #-}- {-# inline singleton #-}- {-# inline doubleton #-}- {-# inline tripleton #-}- {-# inline quadrupleton #-}- {-# inline rnf #-}- {-# inline run #-}--errorThunk :: a-errorThunk = error "Contiguous typeclass: unitialized element"-{-# noinline errorThunk #-}--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 #-}--resizeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a)-resizeArray !src !sz = do- dst <- newArray sz errorThunk- copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src))- pure dst-{-# inline resizeArray #-}--resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)-resizeSmallArray !src !sz = do- dst <- newSmallArray sz errorThunk- copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src))- pure dst-{-# inline resizeSmallArray #-}--resizeUnliftedArray :: (PrimMonad m, PrimUnlifted a) => MutableUnliftedArray (PrimState m) a -> Int -> m (MutableUnliftedArray (PrimState m) a)-resizeUnliftedArray !src !sz = do- dst <- unsafeNewUnliftedArray sz- copyMutableUnliftedArray dst 0 src 0 (min sz (sizeofMutableUnliftedArray src))- pure dst-{-# inline resizeUnliftedArray #-}- -- | Append two arrays. append :: (Contiguous arr, Element arr a) => arr a -> arr a -> arr a append !a !b = run $ do- let !szA = size a- let !szB = size b- m <- new (szA + szB)- copy m 0 a 0 szA- copy m szA b 0 szB+ m <- new (size a + size b)+ copy m 0 (toSlice a)+ copy m (size a) (toSlice b) unsafeFreeze m {-# inline append #-} --- | Insert an element into an array at the given index.-insertAt :: (Contiguous arr, Element arr a) => arr a -> Int -> a -> arr a-insertAt src i x = insertSlicing src 0 (size src) i x+-- | Delete the element at the given position.+deleteAt :: (Contiguous arr, Element arr a) => arr a -> Int -> arr a+deleteAt src i = run $ do+ dst <- thaw (slice src 0 (size src - 1))+ let !i' = i + 1+ copy dst i (slice src i' (size src - i'))+ unsafeFreeze dst+{-# inline deleteAt #-} -- | 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 src 0 (size src)+ dst <- thaw (toSlice src) write dst i x pure dst {-# inline replaceAt #-}@@ -809,7 +314,8 @@ {-# 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@@ -826,7 +332,8 @@ -- -- 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' :: (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@@ -844,7 +351,8 @@ -- -- 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 :: (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@@ -861,7 +369,8 @@ -- -- 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' :: (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@@ -876,7 +385,8 @@ {-# 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 #-} @@ -891,6 +401,18 @@ 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 #-}+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+ -- | 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 ->@@ -925,7 +447,8 @@ -- | 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' :: (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@@ -937,7 +460,8 @@ -- | 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' :: (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)@@ -1006,7 +530,8 @@ {-# inline ifoldlMap1' #-} -- | Strict left monadic fold over the elements of an array.-foldlM' :: (Contiguous arr, Element arr a, Monad m) => (b -> a -> m b) -> b -> arr a -> m b+foldlM' :: (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@@ -1019,7 +544,8 @@ {-# 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@@ -1079,7 +605,10 @@ -- 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)+mapMaybe :: forall arr1 arr2 a b.+ ( Contiguous arr1, Element arr1 a+ , Contiguous arr2, Element arr2 b+ ) => (a -> Maybe b) -> arr1 a -> arr2 b@@ -1111,31 +640,17 @@ catMaybes = mapMaybe id {-# inline catMaybes #-} -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 #-}--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 #-}- -- | @'replicate' n x@ is an array of length @n@ with @x@ the value of every element. replicate :: (Contiguous arr, Element arr a) => Int -> a -> arr a-replicate n x = create (replicateMutable n x)+replicate n x = create (replicateMut n x) {-# inline replicate #-} --- | @'replicateMutableM' n act@ performs the action n times, gathering the results.-replicateMutableM :: (PrimMonad m, Contiguous arr, Element arr a)+-- | @'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)-replicateMutableM len act = do+replicateMutM len act = do marr <- new len let go !ix = when (ix < len) $ do x <- act@@ -1143,31 +658,9 @@ go (ix + 1) go 0 pure marr-{-# inline replicateMutableM #-}+{-# inline replicateMutM #-} -replicateMutablePrimArray :: (PrimMonad m, Prim a)- => Int -- ^ length- -> a -- ^ element- -> m (MutablePrimArray (PrimState m) a)-replicateMutablePrimArray len a = do- marr <- newPrimArray len- setPrimArray marr 0 len a- pure marr-{-# inline replicateMutablePrimArray #-} -replicateSmallMutableArray :: (PrimMonad m)- => Int- -> a- -> m (SmallMutableArray (PrimState m) a)-replicateSmallMutableArray len a = do- marr <- newSmallArray len errorThunk- let go !ix = when (ix < len) $ do- writeSmallArray marr ix a- go (ix + 1)- go 0- pure marr-{-# inline replicateSmallMutableArray #-}- -- | Create an array from a list. If the given length does -- not match the actual length, this function has undefined -- behavior.@@ -1223,7 +716,7 @@ -> Mutable arr (PrimState m) a -> m () mapMutable f !marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do a <- read marr ix write marr ix (f a)@@ -1237,7 +730,7 @@ -> Mutable arr (PrimState m) a -> m () mapMutable' f !marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do a <- read marr ix let !b = f a@@ -1252,7 +745,7 @@ -> Mutable arr (PrimState m) a -> m () imapMutable f !marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do a <- read marr ix write marr ix (f ix a)@@ -1266,7 +759,7 @@ -> Mutable arr (PrimState m) a -> m () imapMutable' f !marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do a <- read marr ix let !b = f ix a@@ -1278,7 +771,11 @@ -- | Map each element of the array to an action, evaluate these -- actions from left to right, and collect the results in a -- new array.-traverseP :: (PrimMonad m, Contiguous arr1, Contiguous arr2, Element arr1 a, Element arr2 b)+traverseP ::+ ( PrimMonad m+ , Contiguous arr1, Element arr1 a+ , Contiguous arr2, Element arr2 b+ ) => (a -> m b) -> arr1 a -> m (arr2 b)@@ -1719,10 +1216,7 @@ go (ix + 1) s' else pure ix sz <- go 0 z0- case compare maxSz sz of- EQ -> pure m- GT -> resize m sz- LT -> error "Data.Primitive.Contiguous.unfoldrMutableN: internal error"+ shrink m sz {-# inline unfoldrMutableN #-} -- | Convert an array to a list.@@ -1740,7 +1234,7 @@ => Mutable arr (PrimState m) a -> m [a] toListMutable marr = do- sz <- sizeMutable marr+ sz <- sizeMut marr let go !ix !acc = if ix >= 0 then do x <- read marr ix@@ -1804,7 +1298,7 @@ -> Mutable arr (PrimState m) a -> m () modify f marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do x <- read marr ix write marr ix (f x)@@ -1818,7 +1312,7 @@ -> Mutable arr (PrimState m) a -> m () modify' f marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr let go !ix = when (ix < sz) $ do x <- read marr ix let !y = f x@@ -1873,12 +1367,10 @@ => arr a -> arr a reverse arr = run $ do- marr <- new sz- copy marr 0 arr 0 sz+ marr <- new (size arr)+ copy marr 0 (toSlice arr) reverseMutable marr unsafeFreeze marr- where- !sz = size arr {-# inline reverse #-} -- | Reverse the elements of a mutable array, in-place.@@ -1886,7 +1378,7 @@ => Mutable arr (PrimState m) a -> m () reverseMutable marr = do- !sz <- sizeMutable marr+ !sz <- sizeMut marr reverseSlice marr 0 (sz - 1) {-# inline reverseMutable #-} @@ -1912,8 +1404,10 @@ -- on is that if it returns 'True', the two immutable arrays are definitely the -- same. This is useful as shortcut for equality tests. However, keep in mind -- that a result of 'False' tells us nothing about the arguments.-same :: Contiguous arr => arr a -> arr a -> Bool-same a b = isTrue# (sameMutableArrayArray# (unsafeCoerce# (unlift a) :: MutableArrayArray# s) (unsafeCoerce# (unlift b) :: MutableArrayArray# s))+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@@ -2398,7 +1892,7 @@ , Element arr1 b , Element arr2 a ) => a -> arr1 b -> arr2 a-a <$ barr = create (replicateMutable (size barr) a)+a <$ barr = create (replicateMut (size barr) a) {-# inline (<$) #-} -- | Sequential application.
+ src/Data/Primitive/Contiguous/Class.hs view
@@ -0,0 +1,995 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# 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.++module Data.Primitive.Contiguous.Class+ ( Contiguous(..)+ , Slice(..)+ , MutableSlice(..)+ , ContiguousU(..)+ , Always+ ) where+++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 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 Data.Kind (Type)+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,RuntimeRep(UnliftedRep))++import qualified Control.DeepSeq as DS++-- | Slices of immutable arrays: packages an offset and length with a backing array.+--+-- @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+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'.+class Contiguous (arr :: Type -> Type) where+ -- | The Mutable counterpart to the array.+ type family Mutable arr = (r :: Type -> Type -> Type) | r -> arr+ -- | The constraint needed to store elements in the array.+ type family Element arr :: Type -> Constraint+ -- | The 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+ -- | 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+++ ------ 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)+ -- | 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)+ default shrink ::+ ( 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+ -- | Create a doubleton array.+ doubleton :: Element arr a => a -> a -> arr a+ -- | Create a tripleton array.+ tripleton :: Element arr a => a -> a -> a -> arr a+ -- | Create a quadrupleton array.+ quadrupleton :: Element arr 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 into an array at the given index, yielding an unboxed one-tuple of the element.+ index# :: Element arr b => arr b -> Int -> (# b #)+ -- | Indexing in a monad.+ --+ -- The monad allows operations to be strict in the array+ -- when necessary. Suppose array copying is implemented like this:+ --+ -- > copy mv v = ... write mv i (v ! i) ...+ --+ -- For lazy arrays, @v ! i@ would not be not be evaluated,+ -- which means that @mv@ would unnecessarily retain a reference+ -- to @v@ in each element written.+ --+ -- With 'indexM', copying can be implemented like this instead:+ --+ -- > copy mv v = ... do+ -- > x <- indexM v i+ -- > write mv i x+ --+ -- Here, no references to @v@ are retained because indexing+ -- (but /not/ the elements) is evaluated eagerly.+ indexM :: (Element arr b, Monad m) => arr b -> Int -> m b+ -- | Read a mutable array at the given index.+ read :: (PrimMonad m, Element arr b)+ => Mutable arr (PrimState m) b -> Int -> m b+ -- | Write to a mutable array at the given index.+ write :: (PrimMonad m, Element arr b)+ => Mutable arr (PrimState m) b -> Int -> b -> m ()++ ------ Properties ------+ -- | Test whether the array is empty.+ null :: arr b -> Bool+ -- | The size of the array+ 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+ -- | 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+ -- | 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+ -- | 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)+ -- | Clone a slice of an array.+ clone :: Element arr b+ => Sliced arr b -- ^ slice to copy+ -> arr b+ default clone ::+ ( 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 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 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)+ default cloneMut ::+ ( 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+ -- | 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)+ -- | 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)+ default freeze ::+ ( 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+ -- | 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)+ -- | 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 xs = unsafeShrinkAndFreeze xs =<< sizeMut xs+ {-# INLINE unsafeFreeze #-}+ unsafeShrinkAndFreeze :: (PrimMonad m, Element arr a)+ => Mutable arr (PrimState m) a+ -> Int -- ^ final size+ -> m (arr a)+ default unsafeShrinkAndFreeze ::+ ( 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)+ default thaw ::+ ( 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+ -- | 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)++ ------ 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 ()+ default copy ::+ ( 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 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 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 ()+ 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 ()+ {-# INLINE copyMut #-}+ 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 ()+ -- | Copy a slice of an array and then insert an element into that array.+ --+ -- The default implementation performs a memset which would be unnecessary+ -- except that the garbage collector might trace the uninitialized array.+ --+ -- 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+ default insertAt ::+ (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 #-}++ ------ 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 uncliced 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)+ -- | 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 where {}+instance Always a where {}++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}+ {-# INLINE replicateMut #-}+ replicateMut len x = do+ baseMut <- replicateMut len x+ 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'}+ 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}+ {-# INLINE singleton #-}+ 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}+ {-# INLINE tripleton #-}+ 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}++ ------ Access and Update ------+ {-# INLINE index #-}+ index Slice{offset,base} i = index (lift base) (offset + i)+ {-# INLINE index# #-}+ index# Slice{offset,base} i = index# (lift base) (offset + i)+ {-# INLINE indexM #-}+ indexM Slice{offset,base} i = indexM (lift base) (offset + i)+ {-# INLINE read #-}+ read MutableSlice{offsetMut,baseMut} i = read (liftMut baseMut) (offsetMut + i)+ {-# INLINE write #-}+ write MutableSlice{offsetMut,baseMut} i = write (liftMut baseMut) (offsetMut + i)++ ------ Properties ------+ {-# INLINE null #-}+ null Slice{length} = length == 0+ {-# INLINE size #-}+ size Slice{length} = length+ {-# INLINE sizeMut #-}+ 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)+ {-# 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++ ------ Conversion ------+ {-# INLINE slice #-}+ 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+ }+ {-# INLINE clone #-}+ clone = id+ {-# INLINE clone_ #-}+ clone_ Slice{offset,base} off' len' =+ Slice{offset=offset+off',length=len',base}+ {-# INLINE cloneMut #-}+ cloneMut xs@MutableSlice{lengthMut} = cloneMut_ xs 0 lengthMut+ {-# INLINE cloneMut_ #-}+ cloneMut_ MutableSlice{offsetMut,baseMut} off' len' = do+ baseMut' <- cloneMut_ (liftMut baseMut) (offsetMut + off') len'+ pure MutableSlice{offsetMut=0,lengthMut=len',baseMut=unliftMut baseMut'}+ {-# INLINE freeze #-}+ freeze xs@MutableSlice{lengthMut}+ = freeze_ xs 0 lengthMut+ {-# INLINE freeze_ #-}+ freeze_ MutableSlice{offsetMut,baseMut} off' len' = do+ base <- freeze_ (liftMut baseMut) (offsetMut + off') len'+ 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)+ base <- unsafeFreeze shrunk+ 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}+ {-# INLINE thaw #-}+ thaw xs@Slice{length} = thaw_ xs 0 length+ {-# INLINE thaw_ #-}+ thaw_ Slice{offset,base} off' len' = do+ baseMut <- thaw_ (lift base) (offset + off') len'+ pure MutableSlice{offsetMut=0,lengthMut=len',baseMut=unliftMut baseMut}+ {-# INLINE toSlice #-}+ toSlice = id+ {-# INLINE toSliceMut #-}+ toSliceMut = pure++ ------ Copy Operations ------+ {-# INLINE copy #-}+ 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_ (liftMut baseMut) (offsetMut + dstOff) (lift base) (offset + off') len+ {-# INLINE copyMut #-}+ 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+ {-# INLINE insertAt #-}+ 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'}++ ------ 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 ()+ in go 0+ {-# INLINE run #-}+ run = runST+++instance Contiguous SmallArray where+ type Mutable SmallArray = SmallMutableArray+ type Element SmallArray = Always+ type Sliced SmallArray = Slice SmallArray+ type MutableSliced SmallArray = MutableSlice SmallArray+ {-# INLINE new #-}+ new n = newSmallArray n errorThunk+ {-# INLINE empty #-}+ empty = mempty+ {-# INLINE index #-}+ index = indexSmallArray+ {-# INLINE indexM #-}+ indexM = indexSmallArrayM+ {-# INLINE index# #-}+ index# = indexSmallArray##+ {-# INLINE read #-}+ read = readSmallArray+ {-# INLINE write #-}+ write = writeSmallArray+ {-# INLINE null #-}+ null a = case sizeofSmallArray a of+ 0 -> True+ _ -> False+ {-# INLINE slice #-}+ slice base offset length = Slice{offset,length,base=unlift base}+ {-# INLINE sliceMut #-}+ sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut}+ {-# INLINE toSlice #-}+ 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}+ {-# INLINE freeze_ #-}+ freeze_ = freezeSmallArray+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze = unsafeFreezeSmallArray+ {-# INLINE size #-}+ size = sizeofSmallArray+ {-# INLINE sizeMut #-}+ sizeMut = (\x -> pure $! sizeofSmallMutableArray x)+ {-# INLINE thaw_ #-}+ thaw_ = thawSmallArray+ {-# INLINE equals #-}+ equals = (==)+ {-# INLINE equalsMut #-}+ equalsMut = (==)+ {-# INLINE singleton #-}+ singleton a = runST $ do+ marr <- newSmallArray 1 errorThunk+ writeSmallArray marr 0 a+ unsafeFreezeSmallArray marr+ {-# INLINE doubleton #-}+ doubleton a b = runST $ do+ m <- newSmallArray 2 errorThunk+ writeSmallArray m 0 a+ writeSmallArray m 1 b+ unsafeFreezeSmallArray m+ {-# INLINE tripleton #-}+ tripleton a b c = runST $ do+ m <- newSmallArray 3 errorThunk+ writeSmallArray m 0 a+ writeSmallArray m 1 b+ writeSmallArray m 2 c+ unsafeFreezeSmallArray m+ {-# INLINE quadrupleton #-}+ quadrupleton a b c d = runST $ do+ m <- newSmallArray 4 errorThunk+ writeSmallArray m 0 a+ writeSmallArray m 1 b+ writeSmallArray m 2 c+ writeSmallArray m 3 d+ unsafeFreezeSmallArray m+ {-# 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 ()+ in go 0+ {-# INLINE clone_ #-}+ clone_ = cloneSmallArray+ {-# INLINE cloneMut_ #-}+ cloneMut_ = cloneSmallMutableArray+ {-# INLINE copy_ #-}+ copy_ = copySmallArray+ {-# INLINE copyMut_ #-}+ copyMut_ = copySmallMutableArray+ {-# INLINE replicateMut #-}+ replicateMut = replicateSmallMutableArray+ {-# INLINE run #-}+ run = runSmallArrayST++instance ContiguousU SmallArray where+ type Unlifted SmallArray = SmallArray#+ type UnliftedMut SmallArray = SmallMutableArray#+ {-# INLINE resize #-}+ resize = resizeSmallArray+ {-# INLINE unlift #-}+ unlift (SmallArray x) = x+ {-# INLINE unliftMut #-}+ unliftMut (SmallMutableArray x) = x+ {-# INLINE lift #-}+ lift x = SmallArray x+ {-# INLINE liftMut #-}+ liftMut x = SmallMutableArray x+++instance Contiguous PrimArray where+ type Mutable PrimArray = MutablePrimArray+ type Element PrimArray = Prim+ type Sliced PrimArray = Slice PrimArray+ type MutableSliced PrimArray = MutableSlice PrimArray+ {-# INLINE empty #-}+ empty = mempty+ {-# INLINE new #-}+ new = newPrimArray+ {-# INLINE replicateMut #-}+ replicateMut = replicateMutablePrimArray+ {-# INLINE index #-}+ index = indexPrimArray+ {-# INLINE index# #-}+ index# arr ix = (# indexPrimArray arr ix #)+ {-# INLINE indexM #-}+ indexM arr ix = pure (indexPrimArray arr ix)+ {-# INLINE read #-}+ read = readPrimArray+ {-# INLINE write #-}+ write = writePrimArray+ {-# INLINE size #-}+ size = sizeofPrimArray+ {-# INLINE sizeMut #-}+ sizeMut = getSizeofMutablePrimArray+ {-# INLINE slice #-}+ slice base offset length = Slice{offset,length,base=unlift base}+ {-# INLINE sliceMut #-}+ sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut}+ {-# INLINE toSlice #-}+ 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}+ {-# INLINE freeze_ #-}+ freeze_ = freezePrimArrayShim+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze = unsafeFreezePrimArray+ {-# INLINE thaw_ #-}+ thaw_ = thawPrimArray+ {-# INLINE copy_ #-}+ copy_ = copyPrimArray+ {-# INLINE copyMut_ #-}+ copyMut_ = copyMutablePrimArray+ {-# INLINE clone_ #-}+ clone_ = clonePrimArrayShim+ {-# INLINE cloneMut_ #-}+ cloneMut_ = cloneMutablePrimArrayShim+ {-# INLINE equals #-}+ equals = (==)+ {-# INLINE null #-}+ null (PrimArray a) = case sizeofByteArray# a of+ 0# -> True+ _ -> False+ {-# INLINE equalsMut #-}+ equalsMut = sameMutablePrimArray+ {-# INLINE rnf #-}+ rnf (PrimArray !_) = ()+ {-# INLINE singleton #-}+ singleton a = runPrimArrayST $ do+ marr <- newPrimArray 1+ writePrimArray marr 0 a+ unsafeFreezePrimArray marr+ {-# INLINE doubleton #-}+ doubleton a b = runPrimArrayST $ do+ m <- newPrimArray 2+ writePrimArray m 0 a+ writePrimArray m 1 b+ unsafeFreezePrimArray m+ {-# INLINE tripleton #-}+ tripleton a b c = runPrimArrayST $ do+ m <- newPrimArray 3+ writePrimArray m 0 a+ writePrimArray m 1 b+ writePrimArray m 2 c+ unsafeFreezePrimArray m+ {-# INLINE quadrupleton #-}+ quadrupleton a b c d = runPrimArrayST $ do+ m <- newPrimArray 4+ writePrimArray m 0 a+ writePrimArray m 1 b+ writePrimArray m 2 c+ writePrimArray m 3 d+ unsafeFreezePrimArray m+ {-# INLINE insertAt #-}+ insertAt src i x = runPrimArrayST $ do+ dst <- new (size src + 1)+ copy dst 0 (slice src 0 i)+ write dst i x+ copy dst (i + 1) (slice src i (size src - i))+ unsafeFreeze dst+ {-# INLINE run #-}+ run = runPrimArrayST++newtype PrimArray# a = PrimArray# ByteArray#+newtype MutablePrimArray# s a = MutablePrimArray# (MutableByteArray# s)+instance ContiguousU PrimArray where+ type Unlifted PrimArray = PrimArray#+ type UnliftedMut PrimArray = MutablePrimArray#+ {-# INLINE resize #-}+ resize = resizeMutablePrimArray+ {-# INLINE unlift #-}+ unlift (PrimArray x) = PrimArray# x+ {-# INLINE unliftMut #-}+ unliftMut (MutablePrimArray x) = MutablePrimArray# x+ {-# INLINE lift #-}+ lift (PrimArray# x) = PrimArray x+ {-# INLINE liftMut #-}+ liftMut (MutablePrimArray# x) = MutablePrimArray x+++instance Contiguous Array where+ type Mutable Array = MutableArray+ type Element Array = Always+ type Sliced Array = Slice Array+ type MutableSliced Array = MutableSlice Array+ {-# INLINE empty #-}+ empty = mempty+ {-# INLINE new #-}+ new n = newArray n errorThunk+ {-# INLINE replicateMut #-}+ replicateMut = newArray+ {-# INLINE index #-}+ index = indexArray+ {-# INLINE index# #-}+ index# = indexArray##+ {-# INLINE indexM #-}+ indexM = indexArrayM+ {-# INLINE read #-}+ read = readArray+ {-# INLINE write #-}+ write = writeArray+ {-# INLINE size #-}+ size = sizeofArray+ {-# INLINE sizeMut #-}+ sizeMut = (\x -> pure $! sizeofMutableArray x)+ {-# INLINE slice #-}+ slice base offset length = Slice{offset,length,base=unlift base}+ {-# INLINE sliceMut #-}+ sliceMut baseMut offsetMut lengthMut = MutableSlice{offsetMut,lengthMut,baseMut=unliftMut baseMut}+ {-# INLINE toSlice #-}+ 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}+ {-# INLINE freeze_ #-}+ freeze_ = freezeArray+ {-# INLINE unsafeFreeze #-}+ unsafeFreeze = unsafeFreezeArray+ {-# INLINE thaw_ #-}+ thaw_ = thawArray+ {-# INLINE copy_ #-}+ copy_ = copyArray+ {-# INLINE copyMut_ #-}+ copyMut_ = copyMutableArray+ {-# INLINE clone #-}+ clone Slice{offset,length,base} = clone_ (lift base) offset length+ {-# INLINE clone_ #-}+ clone_ = cloneArray+ {-# INLINE cloneMut_ #-}+ cloneMut_ = cloneMutableArray+ {-# INLINE equals #-}+ equals = (==)+ {-# INLINE null #-}+ null (Array a) = case sizeofArray# a of+ 0# -> True+ _ -> False+ {-# INLINE equalsMut #-}+ equalsMut = sameMutableArray+ {-# INLINE rnf #-}+ rnf !ary =+ let !sz = sizeofArray ary+ go !i+ | i == sz = ()+ | otherwise =+ let !(# x #) = indexArray## ary i+ in DS.rnf x `seq` go (i+1)+ in go 0+ {-# INLINE singleton #-}+ singleton a = runArrayST (newArray 1 a >>= unsafeFreezeArray)+ {-# INLINE doubleton #-}+ doubleton a b = runArrayST $ do+ m <- newArray 2 a+ writeArray m 1 b+ unsafeFreezeArray m+ {-# INLINE tripleton #-}+ tripleton a b c = runArrayST $ do+ m <- newArray 3 a+ writeArray m 1 b+ writeArray m 2 c+ unsafeFreezeArray m+ {-# INLINE quadrupleton #-}+ quadrupleton a b c d = runArrayST $ do+ m <- newArray 4 a+ writeArray m 1 b+ writeArray m 2 c+ writeArray m 3 d+ unsafeFreezeArray m+ {-# INLINE run #-}+ run = runArrayST++instance ContiguousU Array where+ type Unlifted Array = Array#+ type UnliftedMut Array = MutableArray#+ {-# INLINE resize #-}+ resize = resizeArray+ {-# INLINE unlift #-}+ unlift (Array x) = x+ {-# INLINE unliftMut #-}+ unliftMut (MutableArray x) = x+ {-# INLINE lift #-}+ lift x = Array x+ {-# INLINE liftMut #-}+ liftMut x = MutableArray x+++instance Contiguous UnliftedArray where+ type Mutable UnliftedArray = MutableUnliftedArray+ type Element UnliftedArray = PrimUnlifted+ type Sliced UnliftedArray = Slice UnliftedArray+ type MutableSliced UnliftedArray = MutableSlice UnliftedArray+ {-# INLINE empty #-}+ empty = emptyUnliftedArray+ {-# INLINE new #-}+ new = unsafeNewUnliftedArray+ {-# INLINE replicateMut #-}+ replicateMut = newUnliftedArray+ {-# INLINE index #-}+ index = indexUnliftedArray+ {-# INLINE index# #-}+ index# arr ix = (# indexUnliftedArray arr ix #)+ {-# INLINE indexM #-}+ indexM arr ix = pure (indexUnliftedArray arr ix)+ {-# INLINE read #-}+ read = readUnliftedArray+ {-# INLINE write #-}+ write = writeUnliftedArray+ {-# INLINE size #-}+ size = sizeofUnliftedArray+ {-# INLINE sizeMut #-}+ sizeMut = pure . sizeofMutableUnliftedArray+ {-# INLINE slice #-}+ slice base offset length = Slice{offset,length,base=unlift base}+ {-# INLINE sliceMut #-}+ 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}+ {-# INLINE toSliceMut #-}+ toSliceMut baseMut = do+ lengthMut <- sizeMut baseMut+ pure MutableSlice{offsetMut=0,lengthMut,baseMut=unliftMut baseMut}+ {-# INLINE thaw_ #-}+ thaw_ = thawUnliftedArray+ {-# INLINE copy_ #-}+ copy_ = copyUnliftedArray+ {-# INLINE copyMut_ #-}+ copyMut_ = copyMutableUnliftedArray+ {-# INLINE clone_ #-}+ clone_ = cloneUnliftedArray+ {-# INLINE cloneMut_ #-}+ cloneMut_ = cloneMutableUnliftedArray+ {-# INLINE equals #-}+ equals = (==)+ {-# INLINE null #-}+ null (UnliftedArray a) = case sizeofArrayArray# a of+ 0# -> True+ _ -> False+ {-# INLINE equalsMut #-}+ equalsMut = sameMutableUnliftedArray+ {-# INLINE rnf #-}+ rnf !ary =+ let !sz = sizeofUnliftedArray ary+ go !i+ | i == sz = ()+ | otherwise =+ let x = indexUnliftedArray ary i+ in DS.rnf x `seq` go (i+1)+ in go 0+ {-# INLINE singleton #-}+ singleton a = runUnliftedArrayST (newUnliftedArray 1 a >>= unsafeFreezeUnliftedArray)+ {-# INLINE doubleton #-}+ doubleton a b = runUnliftedArrayST $ do+ m <- newUnliftedArray 2 a+ writeUnliftedArray m 1 b+ unsafeFreezeUnliftedArray m+ {-# INLINE tripleton #-}+ tripleton a b c = runUnliftedArrayST $ do+ m <- newUnliftedArray 3 a+ writeUnliftedArray m 1 b+ writeUnliftedArray m 2 c+ unsafeFreezeUnliftedArray m+ {-# INLINE quadrupleton #-}+ quadrupleton a b c d = runUnliftedArrayST $ do+ m <- newUnliftedArray 4 a+ writeUnliftedArray m 1 b+ writeUnliftedArray m 2 c+ writeUnliftedArray m 3 d+ unsafeFreezeUnliftedArray m+ {-# INLINE run #-}+ run = runUnliftedArrayST++newtype UnliftedArray# a = UnliftedArray# ArrayArray#+newtype MutableUnliftedArray# s a = MutableUnliftedArray# (MutableArrayArray# s)+instance ContiguousU UnliftedArray where+ type Unlifted UnliftedArray = UnliftedArray#+ type UnliftedMut UnliftedArray = MutableUnliftedArray#+ {-# INLINE resize #-}+ resize = resizeUnliftedArray+ {-# INLINE unlift #-}+ unlift (UnliftedArray x) = (UnliftedArray# x)+ {-# INLINE unliftMut #-}+ unliftMut (MutableUnliftedArray x) = (MutableUnliftedArray# x)+ {-# INLINE lift #-}+ lift (UnliftedArray# x) = UnliftedArray x+ {-# INLINE liftMut #-}+ liftMut (MutableUnliftedArray# x) = MutableUnliftedArray x
+ src/Data/Primitive/Contiguous/Shim.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}++module Data.Primitive.Contiguous.Shim+ ( errorThunk+ , resizeArray+ , resizeSmallArray+ , replicateSmallMutableArray+ , resizeUnliftedArray+ , replicateMutablePrimArray+ , clonePrimArrayShim+ , cloneMutablePrimArrayShim+ , freezePrimArrayShim+ ) where++import Control.Monad (when)+import Control.Monad.ST.Run (runPrimArrayST)+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 Data.Primitive.Unlifted.Class (PrimUnlifted)+import Control.Monad.Primitive (PrimState, PrimMonad(..))+++errorThunk :: a+errorThunk = error "Contiguous typeclass: unitialized element"+{-# noinline errorThunk #-}++resizeArray :: PrimMonad m => MutableArray (PrimState m) a -> Int -> m (MutableArray (PrimState m) a)+resizeArray !src !sz = do+ dst <- newArray sz errorThunk+ copyMutableArray dst 0 src 0 (min sz (sizeofMutableArray src))+ pure dst+{-# inline resizeArray #-}++resizeSmallArray :: PrimMonad m => SmallMutableArray (PrimState m) a -> Int -> m (SmallMutableArray (PrimState m) a)+resizeSmallArray !src !sz = do+ dst <- newSmallArray sz errorThunk+ copySmallMutableArray dst 0 src 0 (min sz (sizeofSmallMutableArray src))+ pure dst+{-# inline resizeSmallArray #-}++replicateSmallMutableArray :: (PrimMonad m)+ => Int+ -> a+ -> m (SmallMutableArray (PrimState m) a)+replicateSmallMutableArray len a = do+ marr <- newSmallArray len errorThunk+ let go !ix = when (ix < len) $ do+ writeSmallArray marr ix a+ go (ix + 1)+ go 0+ pure marr+{-# inline replicateSmallMutableArray #-}++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 #-}++replicateMutablePrimArray :: (PrimMonad m, Prim a)+ => Int -- ^ length+ -> a -- ^ element+ -> m (MutablePrimArray (PrimState m) a)+replicateMutablePrimArray len a = do+ marr <- newPrimArray len+ setPrimArray marr 0 len a+ pure marr+{-# inline replicateMutablePrimArray #-}++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 #-}++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 #-}++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 #-}