{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      : Data.Vector.Strict.Mutable
-- Copyright   : (c) Roman Leshchinskiy 2008-2010
--                   Alexey Kuleshevich 2020-2022
--                   Aleksey Khudyakov 2020-2022
--                   Andrew Lelechenko 2020-2022
-- License     : BSD-style
--
-- Maintainer  : Haskell Libraries Team <libraries@haskell.org>
-- Stability   : experimental
-- Portability : non-portable
--
-- Mutable strict boxed vectors. Strict means that all writes to
-- vector are evaluated to WHNF. However vector may contain bottoms,
-- since all elements of vector allocated using 'new' or 'unsafeNew'
-- are set to ⊥.
module Data.Vector.Strict.Mutable (
  -- * Mutable boxed vectors
  MVector(MVector), IOVector, STVector,

  -- * Accessors

  -- ** Length information
  length, null,

  -- ** Extracting subvectors
  slice, init, tail, take, drop, splitAt,
  unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop,

  -- ** Overlapping
  overlaps,

  -- * Construction

  -- ** Initialisation
  new, unsafeNew, replicate, replicateM, generate, generateM, clone,

  -- ** Growing
  grow, unsafeGrow,

  -- ** Restricting memory usage
  clear,

  -- * Accessing individual elements
  read, readMaybe, write, modify, modifyM, swap, exchange,
  unsafeRead, unsafeWrite, unsafeModify, unsafeModifyM, unsafeSwap, unsafeExchange,

  -- * Folds
  mapM_, imapM_, forM_, iforM_,
  foldl, foldl', foldM, foldM',
  foldr, foldr', foldrM, foldrM',
  ifoldl, ifoldl', ifoldM, ifoldM',
  ifoldr, ifoldr', ifoldrM, ifoldrM',

  -- * Modifying vectors
  nextPermutation, nextPermutationBy,
  prevPermutation, prevPermutationBy,

  -- ** Filling and copying
  set, copy, move, unsafeCopy, unsafeMove,
  -- ** Lazy arrays
  toLazy, fromLazy,
  -- ** Arrays
  fromMutableArray, toMutableArray,

  -- * Re-exports
  PrimMonad, PrimState, RealWorld
) where

import           Data.Coerce
import qualified Data.Vector.Generic.Mutable as G
import qualified Data.Vector.Mutable as MV
import           Data.Primitive.Array
import           Control.Monad.Primitive

import Prelude
  ( Ord, Monad(..), Bool, Int, Maybe, Ordering(..)
  , return, ($), (<$>) )

import Data.Typeable ( Typeable )

#include "vector.h"

type role MVector nominal representational

-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).
newtype MVector s a = MVector (MV.MVector s a)
        deriving ( Typeable )

type IOVector = MVector RealWorld
type STVector s = MVector s

instance G.MVector MVector a where
  {-# INLINE basicLength #-}
  basicLength :: forall s. MVector s a -> Int
basicLength = (MVector s a -> Int) -> MVector s a -> Int
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
G.basicLength @MV.MVector @a)
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: forall s. Int -> Int -> MVector s a -> MVector s a
basicUnsafeSlice = (Int -> Int -> MVector s a -> MVector s a)
-> Int -> Int -> MVector s a -> MVector s a
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
G.basicUnsafeSlice @MV.MVector @a)
  {-# INLINE basicOverlaps #-}
  basicOverlaps :: forall s. MVector s a -> MVector s a -> Bool
basicOverlaps = (MVector s a -> MVector s a -> Bool)
-> MVector s a -> MVector s a -> Bool
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
G.basicOverlaps @MV.MVector @a)
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: forall s. Int -> ST s (MVector s a)
basicUnsafeNew = (Int -> ST s (MVector s a)) -> Int -> ST s (MVector s a)
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
G.basicUnsafeNew @MV.MVector @a)
  {-# INLINE basicInitialize #-}
  -- initialization is unnecessary for boxed vectors
  basicInitialize :: forall s. MVector s a -> ST s ()
basicInitialize MVector s a
_ = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeReplicate :: forall s. Int -> a -> ST s (MVector s a)
basicUnsafeReplicate Int
n !a
x = (Int -> a -> ST s (MVector s a)) -> Int -> a -> ST s (MVector s a)
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
G.basicUnsafeReplicate @MV.MVector @a) Int
n a
x
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead :: forall s. MVector s a -> Int -> ST s a
basicUnsafeRead = (MVector s a -> Int -> ST s a) -> MVector s a -> Int -> ST s a
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
G.basicUnsafeRead @MV.MVector @a)
  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite :: forall s. MVector s a -> Int -> a -> ST s ()
basicUnsafeWrite MVector s a
vec Int
j !a
x = ((MVector s a -> Int -> a -> ST s ())
-> MVector s a -> Int -> a -> ST s ()
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
G.basicUnsafeWrite @MV.MVector @a)) MVector s a
vec Int
j a
x

  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeCopy :: forall s. MVector s a -> MVector s a -> ST s ()
basicUnsafeCopy = (MVector s a -> MVector s a -> ST s ())
-> MVector s a -> MVector s a -> ST s ()
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
G.basicUnsafeCopy @MV.MVector @a)

  {-# INLINE basicUnsafeMove #-}
  basicUnsafeMove :: forall s. MVector s a -> MVector s a -> ST s ()
basicUnsafeMove = (MVector s a -> MVector s a -> ST s ())
-> MVector s a -> MVector s a -> ST s ()
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
G.basicUnsafeMove @MV.MVector @a)
  {-# INLINE basicClear #-}
  basicClear :: forall s. MVector s a -> ST s ()
basicClear = (MVector s a -> ST s ()) -> MVector s a -> ST s ()
forall a b. Coercible a b => a -> b
coerce (forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
G.basicClear @MV.MVector @a)


-- Length information
-- ------------------

-- | Length of the mutable vector.
--
-- @since 0.13.2.0
length :: MVector s a -> Int
{-# INLINE length #-}
length :: forall s a. MVector s a -> Int
length = MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
G.length

-- | Check whether the vector is empty.
--
-- @since 0.13.2.0
null :: MVector s a -> Bool
{-# INLINE null #-}
null :: forall s a. MVector s a -> Bool
null = MVector s a -> Bool
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Bool
G.null

-- Extracting subvectors
-- ---------------------

-- | Yield a part of the mutable vector without copying it. The vector must
-- contain at least @i+n@ elements.
--
-- @since 0.13.2.0
slice :: Int  -- ^ @i@ starting index
      -> Int  -- ^ @n@ length
      -> MVector s a
      -> MVector s a
{-# INLINE slice #-}
slice :: forall s a. Int -> Int -> MVector s a -> MVector s a
slice = Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
(HasCallStack, MVector v a) =>
Int -> Int -> v s a -> v s a
G.slice

-- | Take the @n@ first elements of the mutable vector without making a
-- copy. For negative @n@, the empty vector is returned. If @n@ is larger
-- than the vector's length, the vector is returned unchanged.
--
-- @since 0.13.2.0
take :: Int -> MVector s a -> MVector s a
{-# INLINE take #-}
take :: forall s a. Int -> MVector s a -> MVector s a
take = Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
G.take

-- | Drop the @n@ first element of the mutable vector without making a
-- copy. For negative @n@, the vector is returned unchanged. If @n@ is
-- larger than the vector's length, the empty vector is returned.
--
-- @since 0.13.2.0
drop :: Int -> MVector s a -> MVector s a
{-# INLINE drop #-}
drop :: forall s a. Int -> MVector s a -> MVector s a
drop = Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
G.drop

-- | /O(1)/ Split the mutable vector into the first @n@ elements
-- and the remainder, without copying.
--
-- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@,
-- but slightly more efficient.
--
-- @since 0.13.2.0
splitAt :: Int -> MVector s a -> (MVector s a, MVector s a)
{-# INLINE splitAt #-}
splitAt :: forall s a. Int -> MVector s a -> (MVector s a, MVector s a)
splitAt = Int -> MVector s a -> (MVector s a, MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> v s a -> (v s a, v s a)
G.splitAt

-- | Drop the last element of the mutable vector without making a copy.
-- If the vector is empty, an exception is thrown.
--
-- @since 0.13.2.0
init :: MVector s a -> MVector s a
{-# INLINE init #-}
init :: forall s a. MVector s a -> MVector s a
init = MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => v s a -> v s a
G.init

-- | Drop the first element of the mutable vector without making a copy.
-- If the vector is empty, an exception is thrown.
--
-- @since 0.13.2.0
tail :: MVector s a -> MVector s a
{-# INLINE tail #-}
tail :: forall s a. MVector s a -> MVector s a
tail = MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => v s a -> v s a
G.tail

-- | Yield a part of the mutable vector without copying it. No bounds checks
-- are performed.
--
-- @since 0.13.2.0
unsafeSlice :: Int  -- ^ starting index
            -> Int  -- ^ length of the slice
            -> MVector s a
            -> MVector s a
{-# INLINE unsafeSlice #-}
unsafeSlice :: forall s a. Int -> Int -> MVector s a -> MVector s a
unsafeSlice = Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
G.unsafeSlice

-- | Unsafe variant of 'take'. If @n@ is out of range, it will
-- simply create an invalid slice that likely violate memory safety.
--
-- @since 0.13.2.0
unsafeTake :: Int -> MVector s a -> MVector s a
{-# INLINE unsafeTake #-}
unsafeTake :: forall s a. Int -> MVector s a -> MVector s a
unsafeTake = Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
G.unsafeTake

-- | Unsafe variant of 'drop'. If @n@ is out of range, it will
-- simply create an invalid slice that likely violate memory safety.
--
-- @since 0.13.2.0
unsafeDrop :: Int -> MVector s a -> MVector s a
{-# INLINE unsafeDrop #-}
unsafeDrop :: forall s a. Int -> MVector s a -> MVector s a
unsafeDrop = Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
G.unsafeDrop

-- | Same as 'init', but doesn't do range checks.
--
-- @since 0.13.2.0
unsafeInit :: MVector s a -> MVector s a
{-# INLINE unsafeInit #-}
unsafeInit :: forall s a. MVector s a -> MVector s a
unsafeInit = MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => v s a -> v s a
G.unsafeInit

-- | Same as 'tail', but doesn't do range checks.
--
-- @since 0.13.2.0
unsafeTail :: MVector s a -> MVector s a
{-# INLINE unsafeTail #-}
unsafeTail :: forall s a. MVector s a -> MVector s a
unsafeTail = MVector s a -> MVector s a
forall (v :: * -> * -> *) a s. MVector v a => v s a -> v s a
G.unsafeTail

-- Overlapping
-- -----------

-- | Check whether two vectors overlap.
--
-- @since 0.13.2.0
overlaps :: MVector s a -> MVector s a -> Bool
{-# INLINE overlaps #-}
overlaps :: forall s a. MVector s a -> MVector s a -> Bool
overlaps = MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
G.overlaps

-- Initialisation
-- --------------

-- | Create a mutable vector of the given length.
--
-- @since 0.13.2.0
new :: PrimMonad m => Int -> m (MVector (PrimState m) a)
{-# INLINE new #-}
new :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
new = Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
G.new

-- | Create a mutable vector of the given length. The vector elements
-- are set to bottom, so accessing them will cause an exception.
--
-- @since 0.13.2.0
unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a)
{-# INLINE unsafeNew #-}
unsafeNew :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
unsafeNew = Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
G.unsafeNew

-- | Create a mutable vector of the given length (0 if the length is negative)
-- and fill it with an initial value.
--
-- @since 0.13.2.0
replicate :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a)
{-# INLINE replicate #-}
replicate :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
replicate = Int -> a -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> a -> m (v (PrimState m) a)
G.replicate

-- | Create a mutable vector of the given length (0 if the length is negative)
-- and fill it with values produced by repeatedly executing the monadic action.
--
-- @since 0.13.2.0
replicateM :: PrimMonad m => Int -> m a -> m (MVector (PrimState m) a)
{-# INLINE replicateM #-}
replicateM :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> m a -> m (MVector (PrimState m) a)
replicateM = Int -> m a -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m a -> m (v (PrimState m) a)
G.replicateM

-- | /O(n)/ Create a mutable vector of the given length (0 if the length is negative)
-- and fill it with the results of applying the function to each index.
-- Iteration starts at index 0.
--
-- @since 0.13.2.0
generate :: (PrimMonad m) => Int -> (Int -> a) -> m (MVector (PrimState m) a)
{-# INLINE generate #-}
generate :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> (Int -> a) -> m (MVector (PrimState m) a)
generate = Int -> (Int -> a) -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> (Int -> a) -> m (v (PrimState m) a)
G.generate

-- | /O(n)/ Create a mutable vector of the given length (0 if the length is
-- negative) and fill it with the results of applying the monadic function to each
-- index. Iteration starts at index 0.
--
-- @since 0.13.2.0
generateM :: (PrimMonad m) => Int -> (Int -> m a) -> m (MVector (PrimState m) a)
{-# INLINE generateM #-}
generateM :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> (Int -> m a) -> m (MVector (PrimState m) a)
generateM = Int -> (Int -> m a) -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> (Int -> m a) -> m (v (PrimState m) a)
G.generateM

-- | Create a copy of a mutable vector.
--
-- @since 0.13.2.0
clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a)
{-# INLINE clone #-}
clone :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (MVector (PrimState m) a)
clone = MVector (PrimState m) a -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
G.clone

-- Growing
-- -------

-- | Grow a boxed vector by the given number of elements. The number must be
-- non-negative. This has the same semantics as 'G.grow' for generic vectors. It differs
-- from @grow@ functions for unpacked vectors, however, in that only pointers to
-- values are copied over, therefore the values themselves will be shared between the
-- two vectors. This is an important distinction to know about during memory
-- usage analysis and in case the values themselves are of a mutable type, e.g.
-- 'Data.IORef.IORef' or another mutable vector.
--
-- ==== __Examples__
--
-- >>> import qualified Data.Vector as V
-- >>> import qualified Data.Vector.Mutable as MV
-- >>> mv <- V.thaw $ V.fromList ([10, 20, 30] :: [Integer])
-- >>> mv' <- MV.grow mv 2
--
-- The two extra elements at the end of the newly allocated vector will be
-- uninitialized and will result in an error if evaluated, so me must overwrite
-- them with new values first:
--
-- >>> MV.write mv' 3 999
-- >>> MV.write mv' 4 777
-- >>> V.freeze mv'
-- [10,20,30,999,777]
--
-- It is important to note that the source mutable vector is not affected when
-- the newly allocated one is mutated.
--
-- >>> MV.write mv' 2 888
-- >>> V.freeze mv'
-- [10,20,888,999,777]
-- >>> V.freeze mv
-- [10,20,30]
--
-- @since 0.13.2.0
grow :: PrimMonad m
     => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
{-# INLINE grow #-}
grow :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
grow = MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
G.grow

-- | Grow a vector by the given number of elements. The number must be non-negative, but
-- this is not checked. This has the same semantics as 'G.unsafeGrow' for generic vectors.
--
-- @since 0.13.2.0
unsafeGrow :: PrimMonad m
           => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
{-# INLINE unsafeGrow #-}
unsafeGrow :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
unsafeGrow = MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
G.unsafeGrow

-- Restricting memory usage
-- ------------------------

-- | Reset all elements of the vector to some undefined value, clearing all
-- references to external objects.
--
-- @since 0.13.2.0
clear :: PrimMonad m => MVector (PrimState m) a -> m ()
{-# INLINE clear #-}
clear :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m ()
clear = MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m ()
G.clear

-- Accessing individual elements
-- -----------------------------

-- | Yield the element at the given position. Will throw an exception if
-- the index is out of range.
--
-- ==== __Examples__
--
-- >>> import qualified Data.Vector.Mutable as MV
-- >>> v <- MV.generate 10 (\x -> x*x)
-- >>> MV.read v 3
-- 9
--
-- @since 0.13.2.0
read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a
{-# INLINE read #-}
read :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
read = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
G.read

-- | Yield the element at the given position. Returns 'Nothing' if
-- the index is out of range.
--
-- @since 0.13.2.0
--
-- ==== __Examples__
--
-- >>> import qualified Data.Vector.Mutable as MV
-- >>> v <- MV.generate 10 (\x -> x*x)
-- >>> MV.readMaybe v 3
-- Just 9
-- >>> MV.readMaybe v 13
-- Nothing
--
-- @since 0.13.2.0
readMaybe :: (PrimMonad m) => MVector (PrimState m) a -> Int -> m (Maybe a)
{-# INLINE readMaybe #-}
readMaybe :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (Maybe a)
readMaybe = MVector (PrimState m) a -> Int -> m (Maybe a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m (Maybe a)
G.readMaybe

-- | Replace the element at the given position.
--
-- @since 0.13.2.0
write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()
{-# INLINE write #-}
write :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
write = MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
G.write

-- | Modify the element at the given position.
--
-- @since 0.13.2.0
modify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m ()
{-# INLINE modify #-}
modify :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
modify = MVector (PrimState m) a -> (a -> a) -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> (a -> a) -> Int -> m ()
G.modify

-- | Modify the element at the given position using a monadic function.
--
-- @since 0.13.2.0
modifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
{-# INLINE modifyM #-}
modifyM :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
modifyM = MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> (a -> m a) -> Int -> m ()
G.modifyM

-- | Swap the elements at the given positions.
--
-- @since 0.13.2.0
swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()
{-# INLINE swap #-}
swap :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> Int -> m ()
swap = MVector (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
G.swap

-- | Replace the element at the given position and return the old element.
--
-- @since 0.13.2.0
exchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a
{-# INLINE exchange #-}
exchange :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m a
exchange = MVector (PrimState m) a -> Int -> a -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m a
G.exchange

-- | Yield the element at the given position. No bounds checks are performed.
--
-- @since 0.13.2.0
unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a
{-# INLINE unsafeRead #-}
unsafeRead :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
unsafeRead = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
G.unsafeRead

-- | Replace the element at the given position. No bounds checks are performed.
--
-- @since 0.13.2.0
unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()
{-# INLINE unsafeWrite #-}
unsafeWrite :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
unsafeWrite = MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
G.unsafeWrite

-- | Modify the element at the given position. No bounds checks are performed.
--
-- @since 0.13.2.0
unsafeModify :: PrimMonad m => MVector (PrimState m) a -> (a -> a) -> Int -> m ()
{-# INLINE unsafeModify #-}
unsafeModify :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
unsafeModify = MVector (PrimState m) a -> (a -> a) -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> (a -> a) -> Int -> m ()
G.unsafeModify

-- | Modify the element at the given position using a monadic
-- function. No bounds checks are performed.
--
-- @since 0.13.2.0
unsafeModifyM :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
{-# INLINE unsafeModifyM #-}
unsafeModifyM :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
unsafeModifyM = MVector (PrimState m) a -> (a -> m a) -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> (a -> m a) -> Int -> m ()
G.unsafeModifyM

-- | Swap the elements at the given positions. No bounds checks are performed.
--
-- @since 0.13.2.0
unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()
{-# INLINE unsafeSwap #-}
unsafeSwap :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> Int -> m ()
unsafeSwap = MVector (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> Int -> m ()
G.unsafeSwap

-- | Replace the element at the given position and return the old element. No
-- bounds checks are performed.
--
-- @since 0.13.2.0
unsafeExchange :: (PrimMonad m) => MVector (PrimState m) a -> Int -> a -> m a
{-# INLINE unsafeExchange #-}
unsafeExchange :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m a
unsafeExchange = MVector (PrimState m) a -> Int -> a -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m a
G.unsafeExchange

-- Filling and copying
-- -------------------

-- | Set all elements of the vector to the given value.
--
-- @since 0.13.2.0
set :: PrimMonad m => MVector (PrimState m) a -> a -> m ()
{-# INLINE set #-}
set :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> a -> m ()
set = MVector (PrimState m) a -> a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> a -> m ()
G.set

-- | Copy a vector. The two vectors must have the same length and may not
-- overlap.
--
-- @since 0.13.2.0
copy :: PrimMonad m => MVector (PrimState m) a   -- ^ target
                    -> MVector (PrimState m) a   -- ^ source
                    -> m ()
{-# INLINE copy #-}
copy :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
copy = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
G.copy

-- | Copy a vector. The two vectors must have the same length and may not
-- overlap, but this is not checked.
--
-- @since 0.13.2.0
unsafeCopy :: PrimMonad m => MVector (PrimState m) a   -- ^ target
                          -> MVector (PrimState m) a   -- ^ source
                          -> m ()
{-# INLINE unsafeCopy #-}
unsafeCopy :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
unsafeCopy = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
G.unsafeCopy

-- | Move the contents of a vector. The two vectors must have the same
-- length.
--
-- If the vectors do not overlap, then this is equivalent to 'copy'.
-- Otherwise, the copying is performed as if the source vector were
-- copied to a temporary vector and then the temporary vector was copied
-- to the target vector.
--
-- @since 0.13.2.0
move :: PrimMonad m => MVector (PrimState m) a   -- ^ target
                    -> MVector (PrimState m) a   -- ^ source
                    -> m ()
{-# INLINE move #-}
move :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
move = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
G.move

-- | Move the contents of a vector. The two vectors must have the same
-- length, but this is not checked.
--
-- If the vectors do not overlap, then this is equivalent to 'unsafeCopy'.
-- Otherwise, the copying is performed as if the source vector were
-- copied to a temporary vector and then the temporary vector was copied
-- to the target vector.
--
-- @since 0.13.2.0
unsafeMove :: PrimMonad m => MVector (PrimState m) a   -- ^ target
                          -> MVector (PrimState m) a   -- ^ source
                          -> m ()
{-# INLINE unsafeMove #-}
unsafeMove :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
unsafeMove = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
G.unsafeMove

-- Modifying vectors
-- -----------------

-- | Compute the (lexicographically) next permutation of the given vector in-place.
-- Returns False when the input is the last item in the enumeration, i.e., if it is in
-- weakly descending order. In this case the vector will not get updated,
-- as opposed to the behavior of the C++ function @std::next_permutation@.
--
-- @since 0.13.2.0
nextPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool
{-# INLINE nextPermutation #-}
nextPermutation :: forall (m :: * -> *) e.
(PrimMonad m, Ord e) =>
MVector (PrimState m) e -> m Bool
nextPermutation = MVector (PrimState m) e -> m Bool
forall (m :: * -> *) e (v :: * -> * -> *).
(PrimMonad m, Ord e, MVector v e) =>
v (PrimState m) e -> m Bool
G.nextPermutation

-- | Compute the (lexicographically) next permutation of the given vector in-place,
-- using the provided comparison function.
-- Returns False when the input is the last item in the enumeration, i.e., if it is in
-- weakly descending order. In this case the vector will not get updated,
-- as opposed to the behavior of the C++ function @std::next_permutation@.
--
-- @since 0.13.2.0
nextPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
{-# INLINE nextPermutationBy #-}
nextPermutationBy :: forall (m :: * -> *) e.
PrimMonad m =>
(e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
nextPermutationBy = (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> e -> Ordering) -> v (PrimState m) e -> m Bool
G.nextPermutationBy

-- | Compute the (lexicographically) previous permutation of the given vector in-place.
-- Returns False when the input is the last item in the enumeration, i.e., if it is in
-- weakly ascending order. In this case the vector will not get updated,
-- as opposed to the behavior of the C++ function @std::prev_permutation@.
--
-- @since 0.13.2.0
prevPermutation :: (PrimMonad m, Ord e) => MVector (PrimState m) e -> m Bool
{-# INLINE prevPermutation #-}
prevPermutation :: forall (m :: * -> *) e.
(PrimMonad m, Ord e) =>
MVector (PrimState m) e -> m Bool
prevPermutation = MVector (PrimState m) e -> m Bool
forall (m :: * -> *) e (v :: * -> * -> *).
(PrimMonad m, Ord e, MVector v e) =>
v (PrimState m) e -> m Bool
G.prevPermutation

-- | Compute the (lexicographically) previous permutation of the given vector in-place,
-- using the provided comparison function.
-- Returns False when the input is the last item in the enumeration, i.e., if it is in
-- weakly ascending order. In this case the vector will not get updated,
-- as opposed to the behavior of the C++ function @std::prev_permutation@.
--
-- @since 0.13.2.0
prevPermutationBy :: PrimMonad m => (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
{-# INLINE prevPermutationBy #-}
prevPermutationBy :: forall (m :: * -> *) e.
PrimMonad m =>
(e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
prevPermutationBy = (e -> e -> Ordering) -> MVector (PrimState m) e -> m Bool
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(e -> e -> Ordering) -> v (PrimState m) e -> m Bool
G.prevPermutationBy


-- Folds
-- -----

-- | /O(n)/ Apply the monadic action to every element of the vector, discarding the results.
--
-- @since 0.13.2.0
mapM_ :: (PrimMonad m) => (a -> m b) -> MVector (PrimState m) a -> m ()
{-# INLINE mapM_ #-}
mapM_ :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> m b) -> MVector (PrimState m) a -> m ()
mapM_ = (a -> m b) -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> m b) -> v (PrimState m) a -> m ()
G.mapM_

-- | /O(n)/ Apply the monadic action to every element of the vector and its index, discarding the results.
--
-- @since 0.13.2.0
imapM_ :: (PrimMonad m) => (Int -> a -> m b) -> MVector (PrimState m) a -> m ()
{-# INLINE imapM_ #-}
imapM_ :: forall (m :: * -> *) a b.
PrimMonad m =>
(Int -> a -> m b) -> MVector (PrimState m) a -> m ()
imapM_ = (Int -> a -> m b) -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(Int -> a -> m b) -> v (PrimState m) a -> m ()
G.imapM_

-- | /O(n)/ Apply the monadic action to every element of the vector,
-- discarding the results. It's the same as @flip mapM_@.
--
-- @since 0.13.2.0
forM_ :: (PrimMonad m) => MVector (PrimState m) a -> (a -> m b) -> m ()
{-# INLINE forM_ #-}
forM_ :: forall (m :: * -> *) a b.
PrimMonad m =>
MVector (PrimState m) a -> (a -> m b) -> m ()
forM_ = MVector (PrimState m) a -> (a -> m b) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> (a -> m b) -> m ()
G.forM_

-- | /O(n)/ Apply the monadic action to every element of the vector
-- and its index, discarding the results. It's the same as @flip imapM_@.
--
-- @since 0.13.2.0
iforM_ :: (PrimMonad m) => MVector (PrimState m) a -> (Int -> a -> m b) -> m ()
{-# INLINE iforM_ #-}
iforM_ :: forall (m :: * -> *) a b.
PrimMonad m =>
MVector (PrimState m) a -> (Int -> a -> m b) -> m ()
iforM_ = MVector (PrimState m) a -> (Int -> a -> m b) -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> (Int -> a -> m b) -> m ()
G.iforM_

-- | /O(n)/ Pure left fold.
--
-- @since 0.13.2.0
foldl :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldl #-}
foldl :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> a -> b) -> b -> MVector (PrimState m) a -> m b
foldl = (b -> a -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> a -> b) -> b -> v (PrimState m) a -> m b
G.foldl

-- | /O(n)/ Pure left fold with strict accumulator.
--
-- @since 0.13.2.0
foldl' :: (PrimMonad m) => (b -> a -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldl' #-}
foldl' :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> a -> b) -> b -> MVector (PrimState m) a -> m b
foldl' = (b -> a -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> a -> b) -> b -> v (PrimState m) a -> m b
G.foldl'

-- | /O(n)/ Pure left fold using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldl :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldl #-}
ifoldl :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
ifoldl = (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> Int -> a -> b) -> b -> v (PrimState m) a -> m b
G.ifoldl

-- | /O(n)/ Pure left fold with strict accumulator using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldl' :: (PrimMonad m) => (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldl' #-}
ifoldl' :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
ifoldl' = (b -> Int -> a -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> Int -> a -> b) -> b -> v (PrimState m) a -> m b
G.ifoldl'

-- | /O(n)/ Pure right fold.
--
-- @since 0.13.2.0
foldr :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldr #-}
foldr :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> b -> b) -> b -> MVector (PrimState m) a -> m b
foldr = (a -> b -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> b -> b) -> b -> v (PrimState m) a -> m b
G.foldr

-- | /O(n)/ Pure right fold with strict accumulator.
--
-- @since 0.13.2.0
foldr' :: (PrimMonad m) => (a -> b -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldr' #-}
foldr' :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> b -> b) -> b -> MVector (PrimState m) a -> m b
foldr' = (a -> b -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> b -> b) -> b -> v (PrimState m) a -> m b
G.foldr'

-- | /O(n)/ Pure right fold using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldr :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldr #-}
ifoldr :: forall (m :: * -> *) a b.
PrimMonad m =>
(Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
ifoldr = (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(Int -> a -> b -> b) -> b -> v (PrimState m) a -> m b
G.ifoldr

-- | /O(n)/ Pure right fold with strict accumulator using a function applied
-- to each element and its index.
--
-- @since 0.13.2.0
ifoldr' :: (PrimMonad m) => (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldr' #-}
ifoldr' :: forall (m :: * -> *) a b.
PrimMonad m =>
(Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
ifoldr' = (Int -> a -> b -> b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(Int -> a -> b -> b) -> b -> v (PrimState m) a -> m b
G.ifoldr'

-- | /O(n)/ Monadic fold.
--
-- @since 0.13.2.0
foldM :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldM #-}
foldM :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
foldM = (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> a -> m b) -> b -> v (PrimState m) a -> m b
G.foldM

-- | /O(n)/ Monadic fold with strict accumulator.
--
-- @since 0.13.2.0
foldM' :: (PrimMonad m) => (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldM' #-}
foldM' :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
foldM' = (b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> a -> m b) -> b -> v (PrimState m) a -> m b
G.foldM'

-- | /O(n)/ Monadic fold using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldM :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldM #-}
ifoldM :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
ifoldM = (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> Int -> a -> m b) -> b -> v (PrimState m) a -> m b
G.ifoldM

-- | /O(n)/ Monadic fold with strict accumulator using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldM' :: (PrimMonad m) => (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldM' #-}
ifoldM' :: forall (m :: * -> *) b a.
PrimMonad m =>
(b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
ifoldM' = (b -> Int -> a -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> Int -> a -> m b) -> b -> v (PrimState m) a -> m b
G.ifoldM'

-- | /O(n)/ Monadic right fold.
--
-- @since 0.13.2.0
foldrM :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldrM #-}
foldrM :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
foldrM = (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> b -> m b) -> b -> v (PrimState m) a -> m b
G.foldrM

-- | /O(n)/ Monadic right fold with strict accumulator.
--
-- @since 0.13.2.0
foldrM' :: (PrimMonad m) => (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE foldrM' #-}
foldrM' :: forall (m :: * -> *) a b.
PrimMonad m =>
(a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
foldrM' = (a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> b -> m b) -> b -> v (PrimState m) a -> m b
G.foldrM'

-- | /O(n)/ Monadic right fold using a function applied to each element and its index.
--
-- @since 0.13.2.0
ifoldrM :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldrM #-}
ifoldrM :: forall (m :: * -> *) a b.
PrimMonad m =>
(Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
ifoldrM = (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(Int -> a -> b -> m b) -> b -> v (PrimState m) a -> m b
G.ifoldrM

-- | /O(n)/ Monadic right fold with strict accumulator using a function applied
-- to each element and its index.
--
-- @since 0.13.2.0
ifoldrM' :: (PrimMonad m) => (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
{-# INLINE ifoldrM' #-}
ifoldrM' :: forall (m :: * -> *) a b.
PrimMonad m =>
(Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
ifoldrM' = (Int -> a -> b -> m b) -> b -> MVector (PrimState m) a -> m b
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(Int -> a -> b -> m b) -> b -> v (PrimState m) a -> m b
G.ifoldrM'

-- Conversions - Lazy vectors
-- -----------------------------

-- | /O(1)/ Convert strict mutable vector to lazy mutable
-- vector. Vectors will share mutable buffer
toLazy :: MVector s a -> MV.MVector s a
{-# INLINE toLazy #-}
toLazy :: forall s a. MVector s a -> MVector s a
toLazy (MVector MVector s a
vec) = MVector s a
vec

-- | /O(n)/ Convert lazy mutable vector to strict mutable
-- vector. Vectors will share mutable buffer. This function evaluates
-- vector elements to WHNF.
fromLazy :: PrimMonad m => MV.MVector (PrimState m) a -> m (MVector (PrimState m) a)
fromLazy :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (MVector (PrimState m) a)
fromLazy MVector (PrimState m) a
mvec = ST (PrimState m) (MVector (PrimState m) a)
-> m (MVector (PrimState m) a)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (MVector (PrimState m) a)
 -> m (MVector (PrimState m) a))
-> ST (PrimState m) (MVector (PrimState m) a)
-> m (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ do
  (() -> a -> ST (PrimState m) ())
-> ()
-> MVector (PrimState (ST (PrimState m))) a
-> ST (PrimState m) ()
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(b -> a -> m b) -> b -> v (PrimState m) a -> m b
G.foldM' (\()
_ !a
_ -> () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () MVector (PrimState m) a
MVector (PrimState (ST (PrimState m))) a
mvec
  MVector (PrimState m) a
-> ST (PrimState m) (MVector (PrimState m) a)
forall a. a -> ST (PrimState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) a
 -> ST (PrimState m) (MVector (PrimState m) a))
-> MVector (PrimState m) a
-> ST (PrimState m) (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ MVector (PrimState m) a -> MVector (PrimState m) a
forall s a. MVector s a -> MVector s a
MVector MVector (PrimState m) a
mvec


-- Conversions - Arrays
-- -----------------------------

-- | /O(n)/ Make a copy of a mutable array to a new mutable
-- vector. All elements of a vector are evaluated to WHNF
--
-- @since 0.13.2.0
fromMutableArray :: PrimMonad m => MutableArray (PrimState m) a -> m (MVector (PrimState m) a)
{-# INLINE fromMutableArray #-}
fromMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (MVector (PrimState m) a)
fromMutableArray MutableArray (PrimState m) a
marr = ST (PrimState m) (MVector (PrimState m) a)
-> m (MVector (PrimState m) a)
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim (ST (PrimState m) (MVector (PrimState m) a)
 -> m (MVector (PrimState m) a))
-> ST (PrimState m) (MVector (PrimState m) a)
-> m (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ do
  MVector (PrimState m) a
mvec <- MVector (PrimState m) a -> MVector (PrimState m) a
forall s a. MVector s a -> MVector s a
MVector (MVector (PrimState m) a -> MVector (PrimState m) a)
-> ST (PrimState m) (MVector (PrimState m) a)
-> ST (PrimState m) (MVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray (PrimState (ST (PrimState m))) a
-> ST (PrimState m) (MVector (PrimState (ST (PrimState m))) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (MVector (PrimState m) a)
MV.fromMutableArray MutableArray (PrimState m) a
MutableArray (PrimState (ST (PrimState m))) a
marr
  (() -> a -> ST (PrimState m) ())
-> ()
-> MVector (PrimState (ST (PrimState m))) a
-> ST (PrimState m) ()
forall (m :: * -> *) b a.
PrimMonad m =>
(b -> a -> m b) -> b -> MVector (PrimState m) a -> m b
foldM' (\()
_ !a
_ -> () -> ST (PrimState m) ()
forall a. a -> ST (PrimState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () MVector (PrimState m) a
MVector (PrimState (ST (PrimState m))) a
mvec
  MVector (PrimState m) a
-> ST (PrimState m) (MVector (PrimState m) a)
forall a. a -> ST (PrimState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return MVector (PrimState m) a
mvec

-- | /O(n)/ Make a copy of a mutable vector into a new mutable array.
--
-- @since 0.13.2.0
toMutableArray :: PrimMonad m => MVector (PrimState m) a -> m (MutableArray (PrimState m) a)
{-# INLINE toMutableArray #-}
toMutableArray :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (MutableArray (PrimState m) a)
toMutableArray (MVector MVector (PrimState m) a
v) = MVector (PrimState m) a -> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (MutableArray (PrimState m) a)
MV.toMutableArray MVector (PrimState m) a
v

-- $setup
-- >>> import Prelude (Integer,Num(..))