{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# 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)

import qualified Control.DeepSeq as DS

-- In GHC 9.2 the UnliftedRep constructor of RuntimeRep was removed
-- and replaced with a type synonym
#if __GLASGOW_HASKELL__  >= 902
import GHC.Exts (UnliftedRep)
#else
import GHC.Exts (RuntimeRep(UnliftedRep))
type UnliftedRep = 'UnliftedRep
#endif


-- | Slices of immutable arrays: packages an offset and length with a backing array.
--
-- @since 0.6.0
data Slice arr a = Slice
  { forall (arr :: * -> *) a. Slice arr a -> Int
offset :: {-# UNPACK #-} !Int
  , forall (arr :: * -> *) a. Slice arr a -> Int
length :: {-# UNPACK #-} !Int
  , forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
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
  { forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut :: {-# UNPACK #-} !Int
  , forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut :: {-# UNPACK #-} !Int
  , forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
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 = forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
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{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> arr a
clone_ (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) Int
offset Int
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{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut}
    = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Int -> m (Mutable arr (PrimState m) b)
cloneMut_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) Int
offsetMut Int
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{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut,UnliftedMut arr (PrimState m) a
baseMut :: UnliftedMut arr (PrimState m) a
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut}
    = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
freeze_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) a
baseMut) Int
offsetMut Int
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 Mutable arr (PrimState m) b
xs = forall (arr :: * -> *) (m :: * -> *) a.
(Contiguous arr, PrimMonad m, Element arr a) =>
Mutable arr (PrimState m) a -> Int -> m (arr a)
unsafeShrinkAndFreeze Mutable arr (PrimState m) b
xs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
sizeMut Mutable arr (PrimState m) b
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 Mutable arr (PrimState m) a
arr0 Int
len' =
    forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
resize Mutable arr (PrimState m) a
arr0 Int
len' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
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{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)
thaw_ (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) Int
offset Int
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 Mutable arr (PrimState m) b
dst Int
dstOff Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
copy_ Mutable arr (PrimState m) b
dst Int
dstOff (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) Int
offset Int
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 Mutable arr (PrimState m) b
dst Int
dstOff MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut}
    = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()
copyMut_ Mutable arr (PrimState m) b
dst Int
dstOff (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) Int
offsetMut Int
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 arr b
src Int
i b
x = forall (arr :: * -> *) a.
Contiguous arr =>
(forall s. ST s (arr a)) -> arr a
run forall a b. (a -> b) -> a -> b
$ do
    Mutable arr s b
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
replicateMut (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size arr b
src forall a. Num a => a -> a -> a
+ Int
1) b
x
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
copy Mutable arr s b
dst Int
0 (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice arr b
src Int
0 Int
i)
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
copy Mutable arr s b
dst (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice arr b
src Int
i (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size arr b
src forall a. Num a => a -> a -> a
- Int
i))
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
unsafeFreeze Mutable arr s b
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 :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Int -> m (Mutable (Slice arr) (PrimState m) b)
new Int
len = do
    Mutable arr (PrimState m) b
baseMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
new Int
len
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,lengthMut :: Int
lengthMut=Int
len,baseMut :: UnliftedMut arr (PrimState m) b
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable arr (PrimState m) b
baseMut}
  {-# INLINE replicateMut #-}
  replicateMut :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Int -> b -> m (Mutable (Slice arr) (PrimState m) b)
replicateMut Int
len b
x = do
    Mutable arr (PrimState m) b
baseMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
replicateMut Int
len b
x
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,lengthMut :: Int
lengthMut=Int
len,baseMut :: UnliftedMut arr (PrimState m) b
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable arr (PrimState m) b
baseMut}
  {-# INLINE shrink #-}
  shrink :: forall (m :: * -> *) a.
(PrimMonad m, Element (Slice arr) a) =>
Mutable (Slice arr) (PrimState m) a
-> Int -> m (Mutable (Slice arr) (PrimState m) a)
shrink Mutable (Slice arr) (PrimState m) a
xs Int
len' = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case forall a. Ord a => a -> a -> Ordering
compare Int
len' (forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut Mutable (Slice arr) (PrimState m) a
xs) of
    Ordering
LT -> Mutable (Slice arr) (PrimState m) a
xs{lengthMut :: Int
lengthMut=Int
len'}
    Ordering
EQ -> Mutable (Slice arr) (PrimState m) a
xs
    Ordering
GT -> forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Data.Primitive.Contiguous.Class.shrink: passed a larger than existing size"
  {-# INLINE empty #-}
  empty :: forall a. Slice arr a
empty = Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
0,base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift forall (arr :: * -> *) a. Contiguous arr => arr a
empty}
  {-# INLINE singleton #-}
  singleton :: forall a. Element (Slice arr) a => a -> Slice arr a
singleton a
a = Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
1,base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift forall a b. (a -> b) -> a -> b
$ forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> arr a
singleton a
a}
  {-# INLINE doubleton #-}
  doubleton :: forall a. Element (Slice arr) a => a -> a -> Slice arr a
doubleton a
a a
b = Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
2,base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift forall a b. (a -> b) -> a -> b
$ forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> a -> arr a
doubleton a
a a
b}
  {-# INLINE tripleton #-}
  tripleton :: forall a. Element (Slice arr) a => a -> a -> a -> Slice arr a
tripleton a
a a
b a
c = Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
3,base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift forall a b. (a -> b) -> a -> b
$ forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> a -> a -> arr a
tripleton a
a a
b a
c}
  {-# INLINE quadrupleton #-}
  quadrupleton :: forall a. Element (Slice arr) a => a -> a -> a -> a -> Slice arr a
quadrupleton a
a a
b a
c a
d = Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
4,base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift forall a b. (a -> b) -> a -> b
$ forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> a -> a -> a -> arr a
quadrupleton a
a a
b a
c a
d}

  ------ Access and Update ------
  {-# INLINE index #-}
  index :: forall b. Element (Slice arr) b => Slice arr b -> Int -> b
index Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
i = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
i)
  {-# INLINE index# #-}
  index# :: forall b. Element (Slice arr) b => Slice arr b -> Int -> (# b #)
index# Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
i = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
index# (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
i)
  {-# INLINE indexM #-}
  indexM :: forall b (m :: * -> *).
(Element (Slice arr) b, Monad m) =>
Slice arr b -> Int -> m b
indexM Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
i = forall (arr :: * -> *) b (m :: * -> *).
(Contiguous arr, Element arr b, Monad m) =>
arr b -> Int -> m b
indexM (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
i)
  {-# INLINE read #-}
  read :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b -> Int -> m b
read MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
i = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> m b
read (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) (Int
offsetMut forall a. Num a => a -> a -> a
+ Int
i)
  {-# INLINE write #-}
  write :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b -> Int -> b -> m ()
write MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
i = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
write (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) (Int
offsetMut forall a. Num a => a -> a -> a
+ Int
i)

  ------ Properties ------
  {-# INLINE null #-}
  null :: forall b. Slice arr b -> Bool
null Slice{Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length} = Int
length forall a. Eq a => a -> a -> Bool
== Int
0
  {-# INLINE size #-}
  size :: forall b. Element (Slice arr) b => Slice arr b -> Int
size Slice{Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length} = Int
length
  {-# INLINE sizeMut #-}
  sizeMut :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b -> m Int
sizeMut MutableSlice{Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
lengthMut
  {-# INLINE equals #-}
  equals :: forall b.
(Element (Slice arr) b, Eq b) =>
Slice arr b -> Slice arr b -> Bool
equals Slice{offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset=Int
oA,length :: forall (arr :: * -> *) a. Slice arr a -> Int
length=Int
lenA,base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base=Unlifted arr b
a}
         Slice{offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset=Int
oB,length :: forall (arr :: * -> *) a. Slice arr a -> Int
length=Int
lenB,base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base=Unlifted arr b
b}
    = Int
lenA forall a. Eq a => a -> a -> Bool
== Int
lenB Bool -> Bool -> Bool
&& Int -> Int -> Int -> Bool
loop Int
0 Int
oA Int
oB
    where
    loop :: Int -> Int -> Int -> Bool
loop !Int
i !Int
iA !Int
iB =
      if Int
i forall a. Eq a => a -> a -> Bool
== Int
lenA then Bool
True
      else forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
a) Int
iA forall a. Eq a => a -> a -> Bool
== forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
index (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
b) Int
iB Bool -> Bool -> Bool
&& Int -> Int -> Int -> Bool
loop (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
iAforall a. Num a => a -> a -> a
+Int
1) (Int
iBforall a. Num a => a -> a -> a
+Int
1)
  {-# INLINE equalsMut #-}
  equalsMut :: forall s a.
Mutable (Slice arr) s a -> Mutable (Slice arr) s a -> Bool
equalsMut MutableSlice{offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut=Int
offA,lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut=Int
lenA,baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut=UnliftedMut arr s a
a}
                MutableSlice{offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut=Int
offB,lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut=Int
lenB,baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut=UnliftedMut arr s a
b}
    =  forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr s a
a forall (arr :: * -> *) s a.
Contiguous arr =>
Mutable arr s a -> Mutable arr s a -> Bool
`equalsMut` forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr s a
b
    Bool -> Bool -> Bool
&& Int
offA forall a. Eq a => a -> a -> Bool
== Int
offB
    Bool -> Bool -> Bool
&& Int
lenA forall a. Eq a => a -> a -> Bool
== Int
lenB

  ------ Conversion ------
  {-# INLINE slice #-}
  slice :: forall a.
Element (Slice arr) a =>
Slice arr a -> Int -> Int -> Sliced (Slice arr) a
slice Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr a
base :: Unlifted arr a
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
off' Int
len' = Slice
    { offset :: Int
offset = Int
offset forall a. Num a => a -> a -> a
+ Int
off'
    , length :: Int
length = Int
len'
    , Unlifted arr a
base :: Unlifted arr a
base :: Unlifted arr a
base
    }
  {-# INLINE sliceMut #-}
  sliceMut :: forall a s.
Element (Slice arr) a =>
Mutable (Slice arr) s a
-> Int -> Int -> MutableSliced (Slice arr) s a
sliceMut MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr s a
baseMut :: UnliftedMut arr s a
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
off' Int
len' = MutableSlice
    { offsetMut :: Int
offsetMut = Int
offsetMut forall a. Num a => a -> a -> a
+ Int
off'
    , lengthMut :: Int
lengthMut = Int
len'
    , UnliftedMut arr s a
baseMut :: UnliftedMut arr s a
baseMut :: UnliftedMut arr s a
baseMut
    }
  {-# INLINE clone #-}
  clone :: forall b.
Element (Slice arr) b =>
Sliced (Slice arr) b -> Slice arr b
clone = forall a. a -> a
id
  {-# INLINE clone_ #-}
  clone_ :: forall a.
Element (Slice arr) a =>
Slice arr a -> Int -> Int -> Slice arr a
clone_ Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr a
base :: Unlifted arr a
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
off' Int
len' =
    Slice{offset :: Int
offset=Int
offsetforall a. Num a => a -> a -> a
+Int
off',length :: Int
length=Int
len',Unlifted arr a
base :: Unlifted arr a
base :: Unlifted arr a
base}
  {-# INLINE cloneMut #-}
  cloneMut :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
MutableSliced (Slice arr) (PrimState m) b
-> m (Mutable (Slice arr) (PrimState m) b)
cloneMut xs :: MutableSliced (Slice arr) (PrimState m) b
xs@MutableSlice{Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Int -> m (Mutable arr (PrimState m) b)
cloneMut_ MutableSliced (Slice arr) (PrimState m) b
xs Int
0 Int
lengthMut
  {-# INLINE cloneMut_ #-}
  cloneMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> Int -> m (Mutable (Slice arr) (PrimState m) b)
cloneMut_ MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
off' Int
len' = do
    Mutable arr (PrimState m) b
baseMut' <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Int -> m (Mutable arr (PrimState m) b)
cloneMut_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) (Int
offsetMut forall a. Num a => a -> a -> a
+ Int
off') Int
len'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,lengthMut :: Int
lengthMut=Int
len',baseMut :: UnliftedMut arr (PrimState m) b
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable arr (PrimState m) b
baseMut'}
  {-# INLINE freeze #-}
  freeze :: forall (m :: * -> *) a.
(PrimMonad m, Element (Slice arr) a) =>
MutableSliced (Slice arr) (PrimState m) a -> m (Slice arr a)
freeze xs :: MutableSliced (Slice arr) (PrimState m) a
xs@MutableSlice{Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut}
    = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
freeze_ MutableSliced (Slice arr) (PrimState m) a
xs Int
0 Int
lengthMut
  {-# INLINE freeze_ #-}
  freeze_ :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> Int -> m (Slice arr b)
freeze_ MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
off' Int
len' = do
    arr b
base <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
freeze_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) (Int
offsetMut forall a. Num a => a -> a -> a
+ Int
off') Int
len'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
len',base :: Unlifted arr b
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift arr b
base}
  {-# INLINE unsafeShrinkAndFreeze #-}
  unsafeShrinkAndFreeze :: forall (m :: * -> *) a.
(PrimMonad m, Element (Slice arr) a) =>
Mutable (Slice arr) (PrimState m) a -> Int -> m (Slice arr a)
unsafeShrinkAndFreeze MutableSlice{offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut=Int
0,Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut,UnliftedMut arr (PrimState m) a
baseMut :: UnliftedMut arr (PrimState m) a
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
len' = do
    Mutable arr (PrimState m) a
shrunk <- if Int
lengthMut forall a. Eq a => a -> a -> Bool
/= Int
len'
      then forall (arr :: * -> *) (m :: * -> *) b.
(ContiguousU arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> m (Mutable arr (PrimState m) b)
resize (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) a
baseMut) Int
len'
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) a
baseMut)
    arr a
base <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
unsafeFreeze Mutable arr (PrimState m) a
shrunk
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
len',base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift arr a
base}
  unsafeShrinkAndFreeze MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) a
baseMut :: UnliftedMut arr (PrimState m) a
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
len' = do
    arr a
base <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Int -> m (arr b)
freeze_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) a
baseMut) Int
offsetMut Int
len'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
len',base :: Unlifted arr a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift arr a
base}
  {-# INLINE thaw #-}
  thaw :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Sliced (Slice arr) b -> m (Mutable (Slice arr) (PrimState m) b)
thaw xs :: Sliced (Slice arr) b
xs@Slice{Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)
thaw_ Sliced (Slice arr) b
xs Int
0 Int
length
  {-# INLINE thaw_ #-}
  thaw_ :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Slice arr b
-> Int -> Int -> m (Mutable (Slice arr) (PrimState m) b)
thaw_ Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
off' Int
len' = do
    Mutable arr (PrimState m) b
baseMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
arr b -> Int -> Int -> m (Mutable arr (PrimState m) b)
thaw_ (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
off') Int
len'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,lengthMut :: Int
lengthMut=Int
len',baseMut :: UnliftedMut arr (PrimState m) b
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable arr (PrimState m) b
baseMut}
  {-# INLINE toSlice #-}
  toSlice :: forall a.
Element (Slice arr) a =>
Slice arr a -> Sliced (Slice arr) a
toSlice = forall a. a -> a
id
  {-# INLINE toSliceMut #-}
  toSliceMut :: forall (m :: * -> *) a.
(PrimMonad m, Element (Slice arr) a) =>
Mutable (Slice arr) (PrimState m) a
-> m (MutableSliced (Slice arr) (PrimState m) a)
toSliceMut = forall (f :: * -> *) a. Applicative f => a -> f a
pure

  ------ Copy Operations ------
  {-# INLINE copy #-}
  copy :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> Sliced (Slice arr) b -> m ()
copy Mutable (Slice arr) (PrimState m) b
dst Int
dstOff src :: Sliced (Slice arr) b
src@Slice{Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
copy_ Mutable (Slice arr) (PrimState m) b
dst Int
dstOff Sliced (Slice arr) b
src Int
0 Int
length
  {-# INLINE copy_ #-}
  copy_ :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> Slice arr b -> Int -> Int -> m ()
copy_ MutableSlice{Int
offsetMut :: Int
offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut,UnliftedMut arr (PrimState m) b
baseMut :: UnliftedMut arr (PrimState m) b
baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut} Int
dstOff Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
off' Int
len =
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
copy_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
baseMut) (Int
offsetMut forall a. Num a => a -> a -> a
+ Int
dstOff) (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
off') Int
len
  {-# INLINE copyMut #-}
  copyMut :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> MutableSliced (Slice arr) (PrimState m) b -> m ()
copyMut Mutable (Slice arr) (PrimState m) b
dst Int
dstOff src :: MutableSliced (Slice arr) (PrimState m) b
src@MutableSlice{Int
lengthMut :: Int
lengthMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
lengthMut} = forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()
copyMut_ Mutable (Slice arr) (PrimState m) b
dst Int
dstOff MutableSliced (Slice arr) (PrimState m) b
src Int
0 Int
lengthMut
  {-# INLINE copyMut_ #-}
  copyMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element (Slice arr) b) =>
Mutable (Slice arr) (PrimState m) b
-> Int -> Mutable (Slice arr) (PrimState m) b -> Int -> Int -> m ()
copyMut_ MutableSlice{offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut=Int
dstOff,baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut=UnliftedMut arr (PrimState m) b
dst} Int
dstOff'
           MutableSlice{offsetMut :: forall (arr :: * -> *) s a. MutableSlice arr s a -> Int
offsetMut=Int
srcOff,baseMut :: forall (arr :: * -> *) s a.
MutableSlice arr s a -> UnliftedMut arr s a
baseMut=UnliftedMut arr (PrimState m) b
src} Int
srcOff' Int
len =
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b
-> Int -> Mutable arr (PrimState m) b -> Int -> Int -> m ()
copyMut_ (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
dst) (Int
dstOff forall a. Num a => a -> a -> a
+ Int
dstOff') (forall (arr :: * -> *) s b.
ContiguousU arr =>
UnliftedMut arr s b -> Mutable arr s b
liftMut UnliftedMut arr (PrimState m) b
src) (Int
srcOff forall a. Num a => a -> a -> a
+ Int
srcOff') Int
len
  {-# INLINE insertAt #-}
  insertAt :: forall b.
Element (Slice arr) b =>
Slice arr b -> Int -> b -> Slice arr b
insertAt Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length,Unlifted arr b
base :: Unlifted arr b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} Int
i b
x = forall (arr :: * -> *) a.
Contiguous arr =>
(forall s. ST s (arr a)) -> arr a
run forall a b. (a -> b) -> a -> b
$ do
    Mutable arr s b
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> b -> m (Mutable arr (PrimState m) b)
replicateMut (Int
length forall a. Num a => a -> a -> a
+ Int
1) b
x
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
copy_ Mutable arr s b
dst Int
0 (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) Int
offset Int
i
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> arr b -> Int -> Int -> m ()
copy_ Mutable arr s b
dst (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted arr b
base) (Int
offset forall a. Num a => a -> a -> a
+ Int
i) (Int
length forall a. Num a => a -> a -> a
- Int
i)
    arr b
base' <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
unsafeFreeze Mutable arr s b
dst
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Slice{offset :: Int
offset=Int
0,length :: Int
length=Int
lengthforall a. Num a => a -> a -> a
+Int
1,base :: Unlifted arr b
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift arr b
base'}

  ------ Reduction ------
  {-# INLINE rnf #-}
  rnf :: forall a. (NFData a, Element (Slice arr) a) => Slice arr a -> ()
rnf !arr :: Slice arr a
arr@Slice{Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length} =
    let go :: Int -> ()
go !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
length
          then
            let !(# a
x #) = forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> (# b #)
index# Slice arr a
arr Int
ix
             in forall a. NFData a => a -> ()
DS.rnf a
x seq :: forall a b. a -> b -> b
`seq` Int -> ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
          else ()
     in Int -> ()
go Int
0
  {-# INLINE run #-}
  run :: forall a. (forall s. ST s (Slice arr a)) -> Slice arr a
run = forall a. (forall s. ST s a) -> a
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 :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Int -> m (Mutable SmallArray (PrimState m) b)
new Int
n = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
n forall a. a
errorThunk
  {-# INLINE empty #-}
  empty :: forall a. SmallArray a
empty = forall a. Monoid a => a
mempty
  {-# INLINE index #-}
  index :: forall b. Element SmallArray b => SmallArray b -> Int -> b
index = forall a. SmallArray a -> Int -> a
indexSmallArray
  {-# INLINE indexM #-}
  indexM :: forall b (m :: * -> *).
(Element SmallArray b, Monad m) =>
SmallArray b -> Int -> m b
indexM = forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
indexSmallArrayM
  {-# INLINE index# #-}
  index# :: forall b. Element SmallArray b => SmallArray b -> Int -> (# b #)
index# = forall a. SmallArray a -> Int -> (# a #)
indexSmallArray##
  {-# INLINE read #-}
  read :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b -> Int -> m b
read = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> m a
readSmallArray
  {-# INLINE write #-}
  write :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b -> Int -> b -> m ()
write = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray
  {-# INLINE null #-}
  null :: forall b. SmallArray b -> Bool
null SmallArray b
a = case forall a. SmallArray a -> Int
sizeofSmallArray SmallArray b
a of
    Int
0 -> Bool
True
    Int
_ -> Bool
False
  {-# INLINE slice #-}
  slice :: forall a.
Element SmallArray a =>
SmallArray a -> Int -> Int -> Sliced SmallArray a
slice SmallArray a
base Int
offset Int
length = Slice{Int
offset :: Int
offset :: Int
offset,Int
length :: Int
length :: Int
length,base :: Unlifted SmallArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift SmallArray a
base}
  {-# INLINE sliceMut #-}
  sliceMut :: forall a s.
Element SmallArray a =>
Mutable SmallArray s a
-> Int -> Int -> MutableSliced SmallArray s a
sliceMut Mutable SmallArray s a
baseMut Int
offsetMut Int
lengthMut = MutableSlice{Int
offsetMut :: Int
offsetMut :: Int
offsetMut,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut SmallArray s a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable SmallArray s a
baseMut}
  {-# INLINE toSlice #-}
  toSlice :: forall a.
Element SmallArray a =>
SmallArray a -> Sliced SmallArray a
toSlice SmallArray a
base = Slice{offset :: Int
offset=Int
0,length :: Int
length=forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size SmallArray a
base,base :: Unlifted SmallArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift SmallArray a
base}
  {-# INLINE toSliceMut #-}
  toSliceMut :: forall (m :: * -> *) a.
(PrimMonad m, Element SmallArray a) =>
Mutable SmallArray (PrimState m) a
-> m (MutableSliced SmallArray (PrimState m) a)
toSliceMut Mutable SmallArray (PrimState m) a
baseMut = do
    Int
lengthMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
sizeMut Mutable SmallArray (PrimState m) a
baseMut
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut SmallArray (PrimState m) a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable SmallArray (PrimState m) a
baseMut}
  {-# INLINE freeze_ #-}
  freeze_ :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b
-> Int -> Int -> m (SmallArray b)
freeze_ = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> Int -> m (SmallArray a)
freezeSmallArray
  {-# INLINE unsafeFreeze #-}
  unsafeFreeze :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b -> m (SmallArray b)
unsafeFreeze = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray
  {-# INLINE size #-}
  size :: forall b. Element SmallArray b => SmallArray b -> Int
size = forall a. SmallArray a -> Int
sizeofSmallArray
  {-# INLINE sizeMut #-}
  sizeMut :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b -> m Int
sizeMut = (\Mutable SmallArray (PrimState m) b
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall s a. SmallMutableArray s a -> Int
sizeofSmallMutableArray Mutable SmallArray (PrimState m) b
x)
  {-# INLINE thaw_ #-}
  thaw_ :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
SmallArray b
-> Int -> Int -> m (Mutable SmallArray (PrimState m) b)
thaw_ = forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> Int -> Int -> m (SmallMutableArray (PrimState m) a)
thawSmallArray
  {-# INLINE equals #-}
  equals :: forall b.
(Element SmallArray b, Eq b) =>
SmallArray b -> SmallArray b -> Bool
equals = forall a. Eq a => a -> a -> Bool
(==)
  {-# INLINE equalsMut #-}
  equalsMut :: forall s a.
Mutable SmallArray s a -> Mutable SmallArray s a -> Bool
equalsMut = forall a. Eq a => a -> a -> Bool
(==)
  {-# INLINE singleton #-}
  singleton :: forall a. Element SmallArray a => a -> SmallArray a
singleton a
a = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    SmallMutableArray s a
marr <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
1 forall a. a
errorThunk
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
marr Int
0 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
marr
  {-# INLINE doubleton #-}
  doubleton :: forall a. Element SmallArray a => a -> a -> SmallArray a
doubleton a
a a
b = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
2 forall a. a
errorThunk
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
0 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
m
  {-# INLINE tripleton #-}
  tripleton :: forall a. Element SmallArray a => a -> a -> a -> SmallArray a
tripleton a
a a
b a
c = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
3 forall a. a
errorThunk
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
0 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
m
  {-# INLINE quadrupleton #-}
  quadrupleton :: forall a. Element SmallArray a => a -> a -> a -> a -> SmallArray a
quadrupleton a
a a
b a
c a
d = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    SmallMutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
4 forall a. a
errorThunk
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
0 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
writeSmallArray SmallMutableArray s a
m Int
3 a
d
    forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
m
  {-# INLINE rnf #-}
  rnf :: forall a. (NFData a, Element SmallArray a) => SmallArray a -> ()
rnf !SmallArray a
ary =
    let !sz :: Int
sz = forall a. SmallArray a -> Int
sizeofSmallArray SmallArray a
ary
        go :: Int -> ()
go !Int
ix = if Int
ix forall a. Ord a => a -> a -> Bool
< Int
sz
          then
            let !(# a
x #) = forall a. SmallArray a -> Int -> (# a #)
indexSmallArray## SmallArray a
ary Int
ix
             in forall a. NFData a => a -> ()
DS.rnf a
x seq :: forall a b. a -> b -> b
`seq` Int -> ()
go (Int
ix forall a. Num a => a -> a -> a
+ Int
1)
          else ()
     in Int -> ()
go Int
0
  {-# INLINE clone_ #-}
  clone_ :: forall a.
Element SmallArray a =>
SmallArray a -> Int -> Int -> SmallArray a
clone_ = forall a. SmallArray a -> Int -> Int -> SmallArray a
cloneSmallArray
  {-# INLINE cloneMut_ #-}
  cloneMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b
-> Int -> Int -> m (Mutable SmallArray (PrimState m) b)
cloneMut_ = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> Int -> m (SmallMutableArray (PrimState m) a)
cloneSmallMutableArray
  {-# INLINE copy_ #-}
  copy_ :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b
-> Int -> SmallArray b -> Int -> Int -> m ()
copy_ = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
copySmallArray
  {-# INLINE copyMut_ #-}
  copyMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Mutable SmallArray (PrimState m) b
-> Int -> Mutable SmallArray (PrimState m) b -> Int -> Int -> m ()
copyMut_ = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallMutableArray (PrimState m) a -> Int -> Int -> m ()
copySmallMutableArray
  {-# INLINE replicateMut #-}
  replicateMut :: forall (m :: * -> *) b.
(PrimMonad m, Element SmallArray b) =>
Int -> b -> m (Mutable SmallArray (PrimState m) b)
replicateMut = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
replicateSmallMutableArray
  {-# INLINE run #-}
  run :: forall a. (forall s. ST s (SmallArray a)) -> SmallArray a
run = forall a. (forall s. ST s (SmallArray a)) -> SmallArray a
runSmallArrayST

instance ContiguousU SmallArray where
  type Unlifted SmallArray = SmallArray#
  type UnliftedMut SmallArray = SmallMutableArray#
  {-# INLINE resize #-}
  resize :: forall (m :: * -> *) a.
(PrimMonad m, Element SmallArray a) =>
Mutable SmallArray (PrimState m) a
-> Int -> m (Mutable SmallArray (PrimState m) a)
resize = forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> m (SmallMutableArray (PrimState m) a)
resizeSmallArray
  {-# INLINE unlift #-}
  unlift :: forall b. SmallArray b -> Unlifted SmallArray b
unlift (SmallArray SmallArray# b
x) = SmallArray# b
x
  {-# INLINE unliftMut #-}
  unliftMut :: forall s b. Mutable SmallArray s b -> UnliftedMut SmallArray s b
unliftMut (SmallMutableArray SmallMutableArray# s b
x) = SmallMutableArray# s b
x
  {-# INLINE lift #-}
  lift :: forall b. Unlifted SmallArray b -> SmallArray b
lift Unlifted SmallArray b
x = forall a. SmallArray# a -> SmallArray a
SmallArray Unlifted SmallArray b
x
  {-# INLINE liftMut #-}
  liftMut :: forall s b. UnliftedMut SmallArray s b -> Mutable SmallArray s b
liftMut UnliftedMut SmallArray s b
x = forall s a. SmallMutableArray# s a -> SmallMutableArray s a
SmallMutableArray UnliftedMut SmallArray s b
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 :: forall a. PrimArray a
empty = forall a. Monoid a => a
mempty
  {-# INLINE new #-}
  new :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Int -> m (Mutable PrimArray (PrimState m) b)
new = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray
  {-# INLINE replicateMut #-}
  replicateMut :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Int -> b -> m (Mutable PrimArray (PrimState m) b)
replicateMut = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> a -> m (MutablePrimArray (PrimState m) a)
replicateMutablePrimArray
  {-# INLINE index #-}
  index :: forall b. Element PrimArray b => PrimArray b -> Int -> b
index = forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray
  {-# INLINE index# #-}
  index# :: forall b. Element PrimArray b => PrimArray b -> Int -> (# b #)
index# PrimArray b
arr Int
ix = (# forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray b
arr Int
ix #)
  {-# INLINE indexM #-}
  indexM :: forall b (m :: * -> *).
(Element PrimArray b, Monad m) =>
PrimArray b -> Int -> m b
indexM PrimArray b
arr Int
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray b
arr Int
ix)
  {-# INLINE read #-}
  read :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b -> Int -> m b
read = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray
  {-# INLINE write #-}
  write :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b -> Int -> b -> m ()
write = forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray
  {-# INLINE size #-}
  size :: forall b. Element PrimArray b => PrimArray b -> Int
size = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray
  {-# INLINE sizeMut #-}
  sizeMut :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b -> m Int
sizeMut = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> m Int
getSizeofMutablePrimArray
  {-# INLINE slice #-}
  slice :: forall a.
Element PrimArray a =>
PrimArray a -> Int -> Int -> Sliced PrimArray a
slice PrimArray a
base Int
offset Int
length = Slice{Int
offset :: Int
offset :: Int
offset,Int
length :: Int
length :: Int
length,base :: Unlifted PrimArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift PrimArray a
base}
  {-# INLINE sliceMut #-}
  sliceMut :: forall a s.
Element PrimArray a =>
Mutable PrimArray s a -> Int -> Int -> MutableSliced PrimArray s a
sliceMut Mutable PrimArray s a
baseMut Int
offsetMut Int
lengthMut = MutableSlice{Int
offsetMut :: Int
offsetMut :: Int
offsetMut,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut PrimArray s a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable PrimArray s a
baseMut}
  {-# INLINE toSlice #-}
  toSlice :: forall a. Element PrimArray a => PrimArray a -> Sliced PrimArray a
toSlice PrimArray a
base = Slice{offset :: Int
offset=Int
0,length :: Int
length=forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size PrimArray a
base,base :: Unlifted PrimArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift PrimArray a
base}
  {-# INLINE toSliceMut #-}
  toSliceMut :: forall (m :: * -> *) a.
(PrimMonad m, Element PrimArray a) =>
Mutable PrimArray (PrimState m) a
-> m (MutableSliced PrimArray (PrimState m) a)
toSliceMut Mutable PrimArray (PrimState m) a
baseMut = do
    Int
lengthMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
sizeMut Mutable PrimArray (PrimState m) a
baseMut
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut PrimArray (PrimState m) a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable PrimArray (PrimState m) a
baseMut}
  {-# INLINE freeze_ #-}
  freeze_ :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b -> Int -> Int -> m (PrimArray b)
freeze_ = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> m (PrimArray a)
freezePrimArrayShim
  {-# INLINE unsafeFreeze #-}
  unsafeFreeze :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b -> m (PrimArray b)
unsafeFreeze = forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray
  {-# INLINE thaw_ #-}
  thaw_ :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
PrimArray b -> Int -> Int -> m (Mutable PrimArray (PrimState m) b)
thaw_ = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimArray a -> Int -> Int -> m (MutablePrimArray (PrimState m) a)
thawPrimArray
  {-# INLINE copy_ #-}
  copy_ :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b
-> Int -> PrimArray b -> Int -> Int -> m ()
copy_ = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray
  {-# INLINE copyMut_ #-}
  copyMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b
-> Int -> Mutable PrimArray (PrimState m) b -> Int -> Int -> m ()
copyMut_ = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray
  {-# INLINE clone_ #-}
  clone_ :: forall a.
Element PrimArray a =>
PrimArray a -> Int -> Int -> PrimArray a
clone_ = forall a. Prim a => PrimArray a -> Int -> Int -> PrimArray a
clonePrimArrayShim
  {-# INLINE cloneMut_ #-}
  cloneMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element PrimArray b) =>
Mutable PrimArray (PrimState m) b
-> Int -> Int -> m (Mutable PrimArray (PrimState m) b)
cloneMut_ = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> Int -> m (MutablePrimArray (PrimState m) a)
cloneMutablePrimArrayShim
  {-# INLINE equals #-}
  equals :: forall b.
(Element PrimArray b, Eq b) =>
PrimArray b -> PrimArray b -> Bool
equals = forall a. Eq a => a -> a -> Bool
(==)
  {-# INLINE null #-}
  null :: forall b. PrimArray b -> Bool
null (PrimArray ByteArray#
a) = case ByteArray# -> Int#
sizeofByteArray# ByteArray#
a of
    Int#
0# -> Bool
True
    Int#
_ -> Bool
False
  {-# INLINE equalsMut #-}
  equalsMut :: forall s a. Mutable PrimArray s a -> Mutable PrimArray s a -> Bool
equalsMut = forall s a. MutablePrimArray s a -> MutablePrimArray s a -> Bool
sameMutablePrimArray
  {-# INLINE rnf #-}
  rnf :: forall a. (NFData a, Element PrimArray a) => PrimArray a -> ()
rnf (PrimArray !ByteArray#
_) = ()
  {-# INLINE singleton #-}
  singleton :: forall a. Element PrimArray a => a -> PrimArray a
singleton a
a = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
marr <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
1
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
marr Int
0 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
marr
  {-# INLINE doubleton #-}
  doubleton :: forall a. Element PrimArray a => a -> a -> PrimArray a
doubleton a
a a
b = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
2
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
0 a
a
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
m
  {-# INLINE tripleton #-}
  tripleton :: forall a. Element PrimArray a => a -> a -> a -> PrimArray a
tripleton a
a a
b a
c = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
3
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
0 a
a
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
1 a
b
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
m
  {-# INLINE quadrupleton #-}
  quadrupleton :: forall a. Element PrimArray a => a -> a -> a -> a -> PrimArray a
quadrupleton a
a a
b a
c a
d = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
4
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
0 a
a
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
1 a
b
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
2 a
c
    forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s a
m Int
3 a
d
    forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s a
m
  {-# INLINE insertAt #-}
  insertAt :: forall b.
Element PrimArray b =>
PrimArray b -> Int -> b -> PrimArray b
insertAt PrimArray b
src Int
i b
x = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
runPrimArrayST forall a b. (a -> b) -> a -> b
$ do
    Mutable PrimArray s b
dst <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Int -> m (Mutable arr (PrimState m) b)
new (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size PrimArray b
src forall a. Num a => a -> a -> a
+ Int
1)
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
copy Mutable PrimArray s b
dst Int
0 (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice PrimArray b
src Int
0 Int
i)
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> b -> m ()
write Mutable PrimArray s b
dst Int
i b
x
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> Int -> Sliced arr b -> m ()
copy Mutable PrimArray s b
dst (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice PrimArray b
src Int
i (forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size PrimArray b
src forall a. Num a => a -> a -> a
- Int
i))
    forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m (arr b)
unsafeFreeze Mutable PrimArray s b
dst
  {-# INLINE run #-}
  run :: forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
run = forall a. (forall s. ST s (PrimArray a)) -> PrimArray a
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 :: forall (m :: * -> *) a.
(PrimMonad m, Element PrimArray a) =>
Mutable PrimArray (PrimState m) a
-> Int -> m (Mutable PrimArray (PrimState m) a)
resize = forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> m (MutablePrimArray (PrimState m) a)
resizeMutablePrimArray
  {-# INLINE unlift #-}
  unlift :: forall b. PrimArray b -> Unlifted PrimArray b
unlift (PrimArray ByteArray#
x) = forall a. ByteArray# -> PrimArray# a
PrimArray# ByteArray#
x
  {-# INLINE unliftMut #-}
  unliftMut :: forall s b. Mutable PrimArray s b -> UnliftedMut PrimArray s b
unliftMut (MutablePrimArray MutableByteArray# s
x) = forall s a. MutableByteArray# s -> MutablePrimArray# s a
MutablePrimArray# MutableByteArray# s
x
  {-# INLINE lift #-}
  lift :: forall b. Unlifted PrimArray b -> PrimArray b
lift (PrimArray# ByteArray#
x) = forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x
  {-# INLINE liftMut #-}
  liftMut :: forall s b. UnliftedMut PrimArray s b -> Mutable PrimArray s b
liftMut (MutablePrimArray# MutableByteArray# s
x) = forall s a. MutableByteArray# s -> MutablePrimArray s a
MutablePrimArray MutableByteArray# s
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 :: forall a. Array a
empty = forall a. Monoid a => a
mempty
  {-# INLINE new #-}
  new :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Int -> m (Mutable Array (PrimState m) b)
new Int
n = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n forall a. a
errorThunk
  {-# INLINE replicateMut #-}
  replicateMut :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Int -> b -> m (Mutable Array (PrimState m) b)
replicateMut = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray
  {-# INLINE index #-}
  index :: forall b. Element Array b => Array b -> Int -> b
index = forall a. Array a -> Int -> a
indexArray
  {-# INLINE index# #-}
  index# :: forall b. Element Array b => Array b -> Int -> (# b #)
index# = forall a. Array a -> Int -> (# a #)
indexArray##
  {-# INLINE indexM #-}
  indexM :: forall b (m :: * -> *).
(Element Array b, Monad m) =>
Array b -> Int -> m b
indexM = forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM
  {-# INLINE read #-}
  read :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b -> Int -> m b
read = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray
  {-# INLINE write #-}
  write :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b -> Int -> b -> m ()
write = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray
  {-# INLINE size #-}
  size :: forall b. Element Array b => Array b -> Int
size = forall a. Array a -> Int
sizeofArray
  {-# INLINE sizeMut #-}
  sizeMut :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b -> m Int
sizeMut = (\Mutable Array (PrimState m) b
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall s a. MutableArray s a -> Int
sizeofMutableArray Mutable Array (PrimState m) b
x)
  {-# INLINE slice #-}
  slice :: forall a.
Element Array a =>
Array a -> Int -> Int -> Sliced Array a
slice Array a
base Int
offset Int
length = Slice{Int
offset :: Int
offset :: Int
offset,Int
length :: Int
length :: Int
length,base :: Unlifted Array a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift Array a
base}
  {-# INLINE sliceMut #-}
  sliceMut :: forall a s.
Element Array a =>
Mutable Array s a -> Int -> Int -> MutableSliced Array s a
sliceMut Mutable Array s a
baseMut Int
offsetMut Int
lengthMut = MutableSlice{Int
offsetMut :: Int
offsetMut :: Int
offsetMut,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut Array s a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable Array s a
baseMut}
  {-# INLINE toSlice #-}
  toSlice :: forall a. Element Array a => Array a -> Sliced Array a
toSlice Array a
base = Slice{offset :: Int
offset=Int
0,length :: Int
length=forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size Array a
base,base :: Unlifted Array a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift Array a
base}
  {-# INLINE toSliceMut #-}
  toSliceMut :: forall (m :: * -> *) a.
(PrimMonad m, Element Array a) =>
Mutable Array (PrimState m) a
-> m (MutableSliced Array (PrimState m) a)
toSliceMut Mutable Array (PrimState m) a
baseMut = do
    Int
lengthMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
sizeMut Mutable Array (PrimState m) a
baseMut
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut Array (PrimState m) a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable Array (PrimState m) a
baseMut}
  {-# INLINE freeze_ #-}
  freeze_ :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b -> Int -> Int -> m (Array b)
freeze_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
freezeArray
  {-# INLINE unsafeFreeze #-}
  unsafeFreeze :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b -> m (Array b)
unsafeFreeze = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray
  {-# INLINE thaw_ #-}
  thaw_ :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Array b -> Int -> Int -> m (Mutable Array (PrimState m) b)
thaw_ = forall (m :: * -> *) a.
PrimMonad m =>
Array a -> Int -> Int -> m (MutableArray (PrimState m) a)
thawArray
  {-# INLINE copy_ #-}
  copy_ :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b
-> Int -> Array b -> Int -> Int -> m ()
copy_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray
  {-# INLINE copyMut_ #-}
  copyMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b
-> Int -> Mutable Array (PrimState m) b -> Int -> Int -> m ()
copyMut_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray
  {-# INLINE clone #-}
  clone :: forall b. Element Array b => Sliced Array b -> Array b
clone Slice{Int
offset :: Int
offset :: forall (arr :: * -> *) a. Slice arr a -> Int
offset,Int
length :: Int
length :: forall (arr :: * -> *) a. Slice arr a -> Int
length,Unlifted Array b
base :: Unlifted Array b
base :: forall (arr :: * -> *) a. Slice arr a -> Unlifted arr a
base} = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> arr a
clone_ (forall (arr :: * -> *) b.
ContiguousU arr =>
Unlifted arr b -> arr b
lift Unlifted Array b
base) Int
offset Int
length
  {-# INLINE clone_ #-}
  clone_ :: forall a. Element Array a => Array a -> Int -> Int -> Array a
clone_ = forall a. Array a -> Int -> Int -> Array a
cloneArray
  {-# INLINE cloneMut_ #-}
  cloneMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element Array b) =>
Mutable Array (PrimState m) b
-> Int -> Int -> m (Mutable Array (PrimState m) b)
cloneMut_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray
  {-# INLINE equals #-}
  equals :: forall b. (Element Array b, Eq b) => Array b -> Array b -> Bool
equals = forall a. Eq a => a -> a -> Bool
(==)
  {-# INLINE null #-}
  null :: forall b. Array b -> Bool
null (Array Array# b
a) = case forall a. Array# a -> Int#
sizeofArray# Array# b
a of
    Int#
0# -> Bool
True
    Int#
_ -> Bool
False
  {-# INLINE equalsMut #-}
  equalsMut :: forall s a. Mutable Array s a -> Mutable Array s a -> Bool
equalsMut = forall s a. MutableArray s a -> MutableArray s a -> Bool
sameMutableArray
  {-# INLINE rnf #-}
  rnf :: forall a. (NFData a, Element Array a) => Array a -> ()
rnf !Array a
ary =
    let !sz :: Int
sz = forall a. Array a -> Int
sizeofArray Array a
ary
        go :: Int -> ()
go !Int
i
          | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = ()
          | Bool
otherwise =
              let !(# a
x #) = forall a. Array a -> Int -> (# a #)
indexArray## Array a
ary Int
i
               in forall a. NFData a => a -> ()
DS.rnf a
x seq :: forall a b. a -> b -> b
`seq` Int -> ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
     in Int -> ()
go Int
0
  {-# INLINE singleton #-}
  singleton :: forall a. Element Array a => a -> Array a
singleton a
a = forall a. (forall s. ST s (Array a)) -> Array a
runArrayST (forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray)
  {-# INLINE doubleton #-}
  doubleton :: forall a. Element Array a => a -> a -> Array a
doubleton a
a a
b = forall a. (forall s. ST s (Array a)) -> Array a
runArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
2 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
m
  {-# INLINE tripleton #-}
  tripleton :: forall a. Element Array a => a -> a -> a -> Array a
tripleton a
a a
b a
c = forall a. (forall s. ST s (Array a)) -> Array a
runArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
3 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
m
  {-# INLINE quadrupleton #-}
  quadrupleton :: forall a. Element Array a => a -> a -> a -> a -> Array a
quadrupleton a
a a
b a
c a
d = forall a. (forall s. ST s (Array a)) -> Array a
runArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableArray s a
m <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
4 a
a
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
m Int
3 a
d
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
m
  {-# INLINE run #-}
  run :: forall a. (forall s. ST s (Array a)) -> Array a
run = forall a. (forall s. ST s (Array a)) -> Array a
runArrayST

instance ContiguousU Array where
  type Unlifted Array = Array#
  type UnliftedMut Array = MutableArray#
  {-# INLINE resize #-}
  resize :: forall (m :: * -> *) a.
(PrimMonad m, Element Array a) =>
Mutable Array (PrimState m) a
-> Int -> m (Mutable Array (PrimState m) a)
resize = forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> m (MutableArray (PrimState m) a)
resizeArray
  {-# INLINE unlift #-}
  unlift :: forall b. Array b -> Unlifted Array b
unlift (Array Array# b
x) = Array# b
x
  {-# INLINE unliftMut #-}
  unliftMut :: forall s b. Mutable Array s b -> UnliftedMut Array s b
unliftMut (MutableArray MutableArray# s b
x) = MutableArray# s b
x
  {-# INLINE lift #-}
  lift :: forall b. Unlifted Array b -> Array b
lift Unlifted Array b
x = forall a. Array# a -> Array a
Array Unlifted Array b
x
  {-# INLINE liftMut #-}
  liftMut :: forall s b. UnliftedMut Array s b -> Mutable Array s b
liftMut UnliftedMut Array s b
x = forall s a. MutableArray# s a -> MutableArray s a
MutableArray UnliftedMut Array s b
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 :: forall a. UnliftedArray a
empty = forall a. UnliftedArray a
emptyUnliftedArray
  {-# INLINE new #-}
  new :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Int -> m (Mutable UnliftedArray (PrimState m) b)
new = forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MutableUnliftedArray (PrimState m) a)
unsafeNewUnliftedArray
  {-# INLINE replicateMut #-}
  replicateMut :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Int -> b -> m (Mutable UnliftedArray (PrimState m) b)
replicateMut = forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray
  {-# INLINE index #-}
  index :: forall b. Element UnliftedArray b => UnliftedArray b -> Int -> b
index = forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray
  {-# INLINE index# #-}
  index# :: forall b.
Element UnliftedArray b =>
UnliftedArray b -> Int -> (# b #)
index# UnliftedArray b
arr Int
ix = (# forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray b
arr Int
ix #)
  {-# INLINE indexM #-}
  indexM :: forall b (m :: * -> *).
(Element UnliftedArray b, Monad m) =>
UnliftedArray b -> Int -> m b
indexM UnliftedArray b
arr Int
ix = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray b
arr Int
ix)
  {-# INLINE read #-}
  read :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b -> Int -> m b
read = forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> m a
readUnliftedArray
  {-# INLINE write #-}
  write :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b -> Int -> b -> m ()
write = forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray
  {-# INLINE size #-}
  size :: forall b. Element UnliftedArray b => UnliftedArray b -> Int
size = forall e. UnliftedArray e -> Int
sizeofUnliftedArray
  {-# INLINE sizeMut #-}
  sizeMut :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b -> m Int
sizeMut = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. MutableUnliftedArray s e -> Int
sizeofMutableUnliftedArray
  {-# INLINE slice #-}
  slice :: forall a.
Element UnliftedArray a =>
UnliftedArray a -> Int -> Int -> Sliced UnliftedArray a
slice UnliftedArray a
base Int
offset Int
length = Slice{Int
offset :: Int
offset :: Int
offset,Int
length :: Int
length :: Int
length,base :: Unlifted UnliftedArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift UnliftedArray a
base}
  {-# INLINE sliceMut #-}
  sliceMut :: forall a s.
Element UnliftedArray a =>
Mutable UnliftedArray s a
-> Int -> Int -> MutableSliced UnliftedArray s a
sliceMut Mutable UnliftedArray s a
baseMut Int
offsetMut Int
lengthMut = MutableSlice{Int
offsetMut :: Int
offsetMut :: Int
offsetMut,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut UnliftedArray s a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable UnliftedArray s a
baseMut}
  {-# INLINE freeze_ #-}
  freeze_ :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b
-> Int -> Int -> m (UnliftedArray b)
freeze_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> Int -> m (UnliftedArray a)
freezeUnliftedArray
  {-# INLINE unsafeFreeze #-}
  unsafeFreeze :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b -> m (UnliftedArray b)
unsafeFreeze = forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray
  {-# INLINE toSlice #-}
  toSlice :: forall a.
Element UnliftedArray a =>
UnliftedArray a -> Sliced UnliftedArray a
toSlice UnliftedArray a
base = Slice{offset :: Int
offset=Int
0,length :: Int
length=forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
size UnliftedArray a
base,base :: Unlifted UnliftedArray a
base=forall (arr :: * -> *) b.
ContiguousU arr =>
arr b -> Unlifted arr b
unlift UnliftedArray a
base}
  {-# INLINE toSliceMut #-}
  toSliceMut :: forall (m :: * -> *) a.
(PrimMonad m, Element UnliftedArray a) =>
Mutable UnliftedArray (PrimState m) a
-> m (MutableSliced UnliftedArray (PrimState m) a)
toSliceMut Mutable UnliftedArray (PrimState m) a
baseMut = do
    Int
lengthMut <- forall (arr :: * -> *) (m :: * -> *) b.
(Contiguous arr, PrimMonad m, Element arr b) =>
Mutable arr (PrimState m) b -> m Int
sizeMut Mutable UnliftedArray (PrimState m) a
baseMut
    forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableSlice{offsetMut :: Int
offsetMut=Int
0,Int
lengthMut :: Int
lengthMut :: Int
lengthMut,baseMut :: UnliftedMut UnliftedArray (PrimState m) a
baseMut=forall (arr :: * -> *) s b.
ContiguousU arr =>
Mutable arr s b -> UnliftedMut arr s b
unliftMut Mutable UnliftedArray (PrimState m) a
baseMut}
  {-# INLINE thaw_ #-}
  thaw_ :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
UnliftedArray b
-> Int -> Int -> m (Mutable UnliftedArray (PrimState m) b)
thaw_ = forall (m :: * -> *) a.
PrimMonad m =>
UnliftedArray a
-> Int -> Int -> m (MutableUnliftedArray (PrimState m) a)
thawUnliftedArray
  {-# INLINE copy_ #-}
  copy_ :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b
-> Int -> UnliftedArray b -> Int -> Int -> m ()
copy_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> UnliftedArray a -> Int -> Int -> m ()
copyUnliftedArray
  {-# INLINE copyMut_ #-}
  copyMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b
-> Int
-> Mutable UnliftedArray (PrimState m) b
-> Int
-> Int
-> m ()
copyMut_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int
-> MutableUnliftedArray (PrimState m) a
-> Int
-> Int
-> m ()
copyMutableUnliftedArray
  {-# INLINE clone_ #-}
  clone_ :: forall a.
Element UnliftedArray a =>
UnliftedArray a -> Int -> Int -> UnliftedArray a
clone_ = forall a. UnliftedArray a -> Int -> Int -> UnliftedArray a
cloneUnliftedArray
  {-# INLINE cloneMut_ #-}
  cloneMut_ :: forall (m :: * -> *) b.
(PrimMonad m, Element UnliftedArray b) =>
Mutable UnliftedArray (PrimState m) b
-> Int -> Int -> m (Mutable UnliftedArray (PrimState m) b)
cloneMut_ = forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a
-> Int -> Int -> m (MutableUnliftedArray (PrimState m) a)
cloneMutableUnliftedArray
  {-# INLINE equals #-}
  equals :: forall b.
(Element UnliftedArray b, Eq b) =>
UnliftedArray b -> UnliftedArray b -> Bool
equals = forall a. Eq a => a -> a -> Bool
(==)
  {-# INLINE null #-}
  null :: forall b. UnliftedArray b -> Bool
null (UnliftedArray ArrayArray#
a) = case ArrayArray# -> Int#
sizeofArrayArray# ArrayArray#
a of
    Int#
0# -> Bool
True
    Int#
_ -> Bool
False
  {-# INLINE equalsMut #-}
  equalsMut :: forall s a.
Mutable UnliftedArray s a -> Mutable UnliftedArray s a -> Bool
equalsMut = forall s a.
MutableUnliftedArray s a -> MutableUnliftedArray s a -> Bool
sameMutableUnliftedArray
  {-# INLINE rnf #-}
  rnf :: forall a.
(NFData a, Element UnliftedArray a) =>
UnliftedArray a -> ()
rnf !UnliftedArray a
ary =
    let !sz :: Int
sz = forall e. UnliftedArray e -> Int
sizeofUnliftedArray UnliftedArray a
ary
        go :: Int -> ()
go !Int
i
          | Int
i forall a. Eq a => a -> a -> Bool
== Int
sz = ()
          | Bool
otherwise =
              let x :: a
x = forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
indexUnliftedArray UnliftedArray a
ary Int
i
               in forall a. NFData a => a -> ()
DS.rnf a
x seq :: forall a b. a -> b -> b
`seq` Int -> ()
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
     in Int -> ()
go Int
0
  {-# INLINE singleton #-}
  singleton :: forall a. Element UnliftedArray a => a -> UnliftedArray a
singleton a
a = forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
runUnliftedArrayST (forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray Int
1 a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray)
  {-# INLINE doubleton #-}
  doubleton :: forall a. Element UnliftedArray a => a -> a -> UnliftedArray a
doubleton a
a a
b = forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
runUnliftedArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableUnliftedArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray Int
2 a
a
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray s a
m
  {-# INLINE tripleton #-}
  tripleton :: forall a. Element UnliftedArray a => a -> a -> a -> UnliftedArray a
tripleton a
a a
b a
c = forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
runUnliftedArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableUnliftedArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray Int
3 a
a
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray s a
m
  {-# INLINE quadrupleton #-}
  quadrupleton :: forall a.
Element UnliftedArray a =>
a -> a -> a -> a -> UnliftedArray a
quadrupleton a
a a
b a
c a
d = forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
runUnliftedArrayST forall a b. (a -> b) -> a -> b
$ do
    MutableUnliftedArray s a
m <- forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
Int -> a -> m (MutableUnliftedArray (PrimState m) a)
newUnliftedArray Int
4 a
a
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
1 a
b
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
2 a
c
    forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a -> Int -> a -> m ()
writeUnliftedArray MutableUnliftedArray s a
m Int
3 a
d
    forall (m :: * -> *) a.
PrimMonad m =>
MutableUnliftedArray (PrimState m) a -> m (UnliftedArray a)
unsafeFreezeUnliftedArray MutableUnliftedArray s a
m
  {-# INLINE run #-}
  run :: forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
run = forall a. (forall s. ST s (UnliftedArray a)) -> UnliftedArray a
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 :: forall (m :: * -> *) a.
(PrimMonad m, Element UnliftedArray a) =>
Mutable UnliftedArray (PrimState m) a
-> Int -> m (Mutable UnliftedArray (PrimState m) a)
resize = forall (m :: * -> *) a.
(PrimMonad m, PrimUnlifted a) =>
MutableUnliftedArray (PrimState m) a
-> Int -> m (MutableUnliftedArray (PrimState m) a)
resizeUnliftedArray
  {-# INLINE unlift #-}
  unlift :: forall b. UnliftedArray b -> Unlifted UnliftedArray b
unlift (UnliftedArray ArrayArray#
x) = (forall a. ArrayArray# -> UnliftedArray# a
UnliftedArray# ArrayArray#
x)
  {-# INLINE unliftMut #-}
  unliftMut :: forall s b.
Mutable UnliftedArray s b -> UnliftedMut UnliftedArray s b
unliftMut (MutableUnliftedArray MutableArrayArray# s
x) = (forall s a. MutableArrayArray# s -> MutableUnliftedArray# s a
MutableUnliftedArray# MutableArrayArray# s
x)
  {-# INLINE lift #-}
  lift :: forall b. Unlifted UnliftedArray b -> UnliftedArray b
lift (UnliftedArray# ArrayArray#
x) = forall a. ArrayArray# -> UnliftedArray a
UnliftedArray ArrayArray#
x
  {-# INLINE liftMut #-}
  liftMut :: forall s b.
UnliftedMut UnliftedArray s b -> Mutable UnliftedArray s b
liftMut (MutableUnliftedArray# MutableArrayArray# s
x) = forall s a. MutableArrayArray# s -> MutableUnliftedArray s a
MutableUnliftedArray MutableArrayArray# s
x