{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Trustworthy #-}
-- |
-- Module      : Data.Vector.NonEmpty.Mutable
-- Copyright   : (c) 2019-2020 Emily Pillmore
-- License     : BSD-style
--
-- Maintainer  : Emily Pillmore <emilypi@cohomolo.gy>
-- Stability   : experimental
-- Portability : non-portable
--
-- Non-empty mutable boxed vectors.
--
module Data.Vector.NonEmpty.Mutable
( -- * Mutable boxed vectors
  NonEmptyMVector
, NonEmptyIOVector
, NonEmptySTVector

  -- * Accessors
  -- ** Length information
, length

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

  -- ** Overlapping
, overlaps

  -- ** Conversions
, fromMVector, toMVector, unsafeFromMVector

  -- ** Initialisation
, new, new1, unsafeNew
, replicate, replicate1
, replicateM, replicate1M
, clone

  -- ** Growing
, grow, unsafeGrow

  -- ** Restricting memory usage
, clear

  -- * Accessing individual elements
, read, write, modify, swap
, unsafeRead, unsafeWrite, unsafeModify, unsafeSwap

  -- * Modifying vectors
, nextPermutation

  -- ** Filling and copying
, set, copy, move, unsafeCopy, unsafeMove
) where


import Prelude (Bool, Int, Ord, (.), max)

import Control.Monad.Primitive

import Data.Functor
import Data.Maybe (Maybe(..))
import Data.Vector.Mutable (MVector)
import qualified Data.Vector.Mutable as M
import Data.Vector.NonEmpty.Internal


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

-- | Length of the mutable vector.
length :: NonEmptyMVector s a -> Int
length :: NonEmptyMVector s a -> Int
length = MVector s a -> Int
forall s a. MVector s a -> Int
M.length (MVector s a -> Int)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE length #-}

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

-- | Yield a part of the mutable vector without copying.
--
slice :: Int -> Int -> NonEmptyMVector s a -> MVector s a
slice :: Int -> Int -> NonEmptyMVector s a -> MVector s a
slice Int
n Int
m = Int -> Int -> MVector s a -> MVector s a
forall s a. Int -> Int -> MVector s a -> MVector s a
M.slice Int
n Int
m (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE slice #-}

-- | Yield at the first n elements without copying.
--
take :: Int -> NonEmptyMVector s a -> MVector s a
take :: Int -> NonEmptyMVector s a -> MVector s a
take Int
n = Int -> MVector s a -> MVector s a
forall s a. Int -> MVector s a -> MVector s a
M.take Int
n (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE take #-}

-- | Yield all but the first n elements without copying.
--
drop :: Int -> NonEmptyMVector s a -> MVector s a
drop :: Int -> NonEmptyMVector s a -> MVector s a
drop Int
n = Int -> MVector s a -> MVector s a
forall s a. Int -> MVector s a -> MVector s a
M.drop Int
n (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE drop #-}

-- | Yield the first n elements paired with the remainder without copying.
--
splitAt :: Int -> NonEmptyMVector s a -> (MVector s a, MVector s a)
splitAt :: Int -> NonEmptyMVector s a -> (MVector s a, MVector s a)
splitAt Int
n = Int -> MVector s a -> (MVector s a, MVector s a)
forall s a. Int -> MVector s a -> (MVector s a, MVector s a)
M.splitAt Int
n (MVector s a -> (MVector s a, MVector s a))
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> (MVector s a, MVector s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE splitAt #-}

-- | Yield all but the last element without copying.
--
init :: NonEmptyMVector s a -> MVector s a
init :: NonEmptyMVector s a -> MVector s a
init = MVector s a -> MVector s a
forall s a. MVector s a -> MVector s a
M.unsafeInit (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE init #-}

-- | Yield all but the first element without copying.
--
tail :: NonEmptyMVector s a -> MVector s a
tail :: NonEmptyMVector s a -> MVector s a
tail = MVector s a -> MVector s a
forall s a. MVector s a -> MVector s a
M.unsafeTail (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE tail #-}

-- | Yield a part of the mutable vector without copying it. No bounds checks
-- are performed.
--
unsafeSlice
    :: Int
      -- ^ starting index
    -> Int
      -- ^ length of the slice
    -> NonEmptyMVector s a
    -> MVector s a
unsafeSlice :: Int -> Int -> NonEmptyMVector s a -> MVector s a
unsafeSlice Int
n Int
m = Int -> Int -> MVector s a -> MVector s a
forall s a. Int -> Int -> MVector s a -> MVector s a
M.unsafeSlice Int
n Int
m (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE unsafeSlice #-}

-- | Yield the first n elements without copying. The vector must contain at
-- least n elements but this is not checked.
--
unsafeTake :: Int -> NonEmptyMVector s a -> MVector s a
unsafeTake :: Int -> NonEmptyMVector s a -> MVector s a
unsafeTake Int
n = Int -> MVector s a -> MVector s a
forall s a. Int -> MVector s a -> MVector s a
M.unsafeTake Int
n (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE unsafeTake #-}

-- | Yield all but the first n elements without copying. The vector must
-- contain at least n elements but this is not checked.
--
unsafeDrop :: Int -> NonEmptyMVector s a -> MVector s a
unsafeDrop :: Int -> NonEmptyMVector s a -> MVector s a
unsafeDrop Int
n = Int -> MVector s a -> MVector s a
forall s a. Int -> MVector s a -> MVector s a
M.unsafeDrop Int
n (MVector s a -> MVector s a)
-> (NonEmptyMVector s a -> MVector s a)
-> NonEmptyMVector s a
-> MVector s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE unsafeDrop #-}

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

-- | Check whether two vectors overlap.
--
overlaps :: NonEmptyMVector s a -> NonEmptyMVector s a -> Bool
overlaps :: NonEmptyMVector s a -> NonEmptyMVector s a -> Bool
overlaps (NonEmptyMVector MVector s a
v) (NonEmptyMVector MVector s a
u) = MVector s a -> MVector s a -> Bool
forall s a. MVector s a -> MVector s a -> Bool
M.overlaps MVector s a
v MVector s a
u
{-# INLINE overlaps #-}

-- ---------------------------------------------------------------------- --
-- Conversion

-- | Convert a mutable vector to a non-empty mutable vector
--
fromMVector :: MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector :: MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector MVector s a
v = if MVector s a -> Bool
forall s a. MVector s a -> Bool
M.null MVector s a
v then Maybe (NonEmptyMVector s a)
forall a. Maybe a
Nothing else NonEmptyMVector s a -> Maybe (NonEmptyMVector s a)
forall a. a -> Maybe a
Just (MVector s a -> NonEmptyMVector s a
forall s a. MVector s a -> NonEmptyMVector s a
NonEmptyMVector MVector s a
v)

-- | Convert a non-empty mutable vector to a mutable vector
--
toMVector :: NonEmptyMVector s a -> MVector s a
toMVector :: NonEmptyMVector s a -> MVector s a
toMVector = NonEmptyMVector s a -> MVector s a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec

-- | Convert a mutable vector to a non-empty mutable vector
--
-- /Warning:/ this function is unsafe and can result in empty non-empty
-- mutable vectors. If you call this function, the onus is on you to
-- make sure the mutable vector being converted is not empty.
--
unsafeFromMVector :: MVector s a -> NonEmptyMVector s a
unsafeFromMVector :: MVector s a -> NonEmptyMVector s a
unsafeFromMVector = MVector s a -> NonEmptyMVector s a
forall s a. MVector s a -> NonEmptyMVector s a
NonEmptyMVector
{-# INLINE unsafeFromMVector #-}

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

-- | Create a mutable vector of the given length.
--
new
    :: PrimMonad m
    => Int
    -> m (Maybe (NonEmptyMVector (PrimState m) a))
new :: Int -> m (Maybe (NonEmptyMVector (PrimState m) a))
new = (MVector (PrimState m) a
 -> Maybe (NonEmptyMVector (PrimState m) a))
-> m (MVector (PrimState m) a)
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> Maybe (NonEmptyMVector (PrimState m) a)
forall s a. MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector (m (MVector (PrimState m) a)
 -> m (Maybe (NonEmptyMVector (PrimState m) a)))
-> (Int -> m (MVector (PrimState m) a))
-> Int
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
M.new
{-# INLINE new #-}

-- | Create a mutable vector of the given length which is
-- @max n 1@.
--
new1
    :: PrimMonad m
    => Int
    -> m (NonEmptyMVector (PrimState m) a)
new1 :: Int -> m (NonEmptyMVector (PrimState m) a)
new1 Int
n = (MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a)
-> m (MVector (PrimState m) a)
-> m (NonEmptyMVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a
forall s a. MVector s a -> NonEmptyMVector s a
unsafeFromMVector (Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
M.new (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1))
{-# INLINE new1 #-}

-- | Create a mutable vector of the given length. The memory is not initialized.
--
unsafeNew
    :: PrimMonad m
    => Int
    -> m (Maybe (NonEmptyMVector (PrimState m) a))
unsafeNew :: Int -> m (Maybe (NonEmptyMVector (PrimState m) a))
unsafeNew = (MVector (PrimState m) a
 -> Maybe (NonEmptyMVector (PrimState m) a))
-> m (MVector (PrimState m) a)
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> Maybe (NonEmptyMVector (PrimState m) a)
forall s a. MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector (m (MVector (PrimState m) a)
 -> m (Maybe (NonEmptyMVector (PrimState m) a)))
-> (Int -> m (MVector (PrimState m) a))
-> Int
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
M.unsafeNew
{-# INLINE unsafeNew #-}

-- | Create a mutable vector of the given length (0 if the length is negative)
-- and fill it with an initial value.
--
replicate
    :: PrimMonad m
    => Int
    -> a
    -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicate :: Int -> a -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicate Int
n a
a = (MVector (PrimState m) a
 -> Maybe (NonEmptyMVector (PrimState m) a))
-> m (MVector (PrimState m) a)
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> Maybe (NonEmptyMVector (PrimState m) a)
forall s a. MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector (Int -> a -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
n a
a)
{-# INLINE replicate #-}

-- | Create a mutable vector of the length @max n 1@ for a given length,
-- and fill it with an initial value.
--
replicate1
    :: PrimMonad m
    => Int
    -> a
    -> m (NonEmptyMVector (PrimState m) a)
replicate1 :: Int -> a -> m (NonEmptyMVector (PrimState m) a)
replicate1 Int
n a
a = (MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a)
-> m (MVector (PrimState m) a)
-> m (NonEmptyMVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a
forall s a. MVector s a -> NonEmptyMVector s a
unsafeFromMVector (Int -> a -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) a
a)
{-# INLINE replicate1 #-}

-- | 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.
--
replicateM
    :: PrimMonad m
    => Int
    -> m a
    -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicateM :: Int -> m a -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicateM  Int
n m a
a = (MVector (PrimState m) a
 -> Maybe (NonEmptyMVector (PrimState m) a))
-> m (MVector (PrimState m) a)
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> Maybe (NonEmptyMVector (PrimState m) a)
forall s a. MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector (Int -> m a -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m a -> m (MVector (PrimState m) a)
M.replicateM Int
n m a
a)
{-# INLINE replicateM #-}

-- | Create a mutable vector of the length @max n 1@ for a given length,
-- and fill it with values produced by repeatedly executing the monadic action.
--
replicate1M
    :: PrimMonad m
    => Int
    -> m a
    -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicate1M :: Int -> m a -> m (Maybe (NonEmptyMVector (PrimState m) a))
replicate1M Int
n m a
a = (MVector (PrimState m) a
 -> Maybe (NonEmptyMVector (PrimState m) a))
-> m (MVector (PrimState m) a)
-> m (Maybe (NonEmptyMVector (PrimState m) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> Maybe (NonEmptyMVector (PrimState m) a)
forall s a. MVector s a -> Maybe (NonEmptyMVector s a)
fromMVector (Int -> m a -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m a -> m (MVector (PrimState m) a)
M.replicateM (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
1) m a
a)
{-# INLINE replicate1M #-}

-- | Create a copy of a mutable vector.
--
clone
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> m (NonEmptyMVector (PrimState m) a)
clone :: NonEmptyMVector (PrimState m) a
-> m (NonEmptyMVector (PrimState m) a)
clone (NonEmptyMVector MVector (PrimState m) a
v) = (MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a)
-> m (MVector (PrimState m) a)
-> m (NonEmptyMVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a
forall s a. MVector s a -> NonEmptyMVector s a
NonEmptyMVector (MVector (PrimState m) a -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (MVector (PrimState m) a)
M.clone MVector (PrimState m) a
v)
{-# INLINE clone #-}

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

-- | Grow a vector by the given number of elements. The number must be
-- positive.
--
grow
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> Int
    -> m (NonEmptyMVector (PrimState m) a)
grow :: NonEmptyMVector (PrimState m) a
-> Int -> m (NonEmptyMVector (PrimState m) a)
grow (NonEmptyMVector MVector (PrimState m) a
v) Int
n = (MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a)
-> m (MVector (PrimState m) a)
-> m (NonEmptyMVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a
forall s a. MVector s a -> NonEmptyMVector s a
NonEmptyMVector (MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
M.grow MVector (PrimState m) a
v Int
n)
{-# INLINE grow #-}

-- | Grow a vector by the given number of elements. The number must be
-- positive but this is not checked.
unsafeGrow
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> Int
    -> m (NonEmptyMVector (PrimState m) a)
unsafeGrow :: NonEmptyMVector (PrimState m) a
-> Int -> m (NonEmptyMVector (PrimState m) a)
unsafeGrow (NonEmptyMVector MVector (PrimState m) a
v) Int
n = (MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a)
-> m (MVector (PrimState m) a)
-> m (NonEmptyMVector (PrimState m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVector (PrimState m) a -> NonEmptyMVector (PrimState m) a
forall s a. MVector s a -> NonEmptyMVector s a
NonEmptyMVector (MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
M.unsafeGrow MVector (PrimState m) a
v Int
n)
{-# INLINE unsafeGrow #-}

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

-- | Reset all elements of the vector to some undefined value, clearing all
-- references to external objects. This is usually a noop for unboxed vectors.
clear :: PrimMonad m => NonEmptyMVector (PrimState m) a -> m ()
clear :: NonEmptyMVector (PrimState m) a -> m ()
clear = MVector (PrimState m) a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m ()
M.clear (MVector (PrimState m) a -> m ())
-> (NonEmptyMVector (PrimState m) a -> MVector (PrimState m) a)
-> NonEmptyMVector (PrimState m) a
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector (PrimState m) a -> MVector (PrimState m) a
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE clear #-}

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

-- | Yield the element at the given position.
--
read
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> Int
    -> m a
read :: NonEmptyMVector (PrimState m) a -> Int -> m a
read (NonEmptyMVector MVector (PrimState m) a
v) Int
n = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
M.read MVector (PrimState m) a
v Int
n
{-# INLINE read #-}

-- | Replace the element at the given position.
--
write
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> Int
    -> a
    -> m ()
write :: NonEmptyMVector (PrimState m) a -> Int -> a -> m ()
write (NonEmptyMVector MVector (PrimState m) a
v) Int
n a
a = MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write MVector (PrimState m) a
v Int
n a
a
{-# INLINE write #-}

-- | Modify the element at the given position.
--
modify
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> (a -> a)
    -> Int
    -> m ()
modify :: NonEmptyMVector (PrimState m) a -> (a -> a) -> Int -> m ()
modify (NonEmptyMVector MVector (PrimState m) a
v) a -> a
f Int
n = MVector (PrimState m) a -> (a -> a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
M.modify MVector (PrimState m) a
v a -> a
f Int
n
{-# INLINE modify #-}

-- | Swap the elements at the given positions.
--
swap
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> Int
    -> Int
    -> m ()
swap :: NonEmptyMVector (PrimState m) a -> Int -> Int -> m ()
swap (NonEmptyMVector MVector (PrimState m) a
v) Int
n Int
m = MVector (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> Int -> m ()
M.swap MVector (PrimState m) a
v Int
n Int
m
{-# INLINE swap #-}

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

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

-- | Modify the element at the given position. No bounds checks are performed.
--
unsafeModify
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> (a -> a)
    -> Int
    -> m ()
unsafeModify :: NonEmptyMVector (PrimState m) a -> (a -> a) -> Int -> m ()
unsafeModify (NonEmptyMVector MVector (PrimState m) a
v) a -> a
f Int
n = MVector (PrimState m) a -> (a -> a) -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
M.unsafeModify MVector (PrimState m) a
v a -> a
f Int
n
{-# INLINE unsafeModify #-}

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

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

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

-- | Copy a vector. The two vectors must have the same length and may not
-- overlap.
--
copy
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> NonEmptyMVector (PrimState m) a
    -> m ()
copy :: NonEmptyMVector (PrimState m) a
-> NonEmptyMVector (PrimState m) a -> m ()
copy (NonEmptyMVector MVector (PrimState m) a
v) (NonEmptyMVector MVector (PrimState m) a
v') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
M.copy MVector (PrimState m) a
v MVector (PrimState m) a
v'
{-# INLINE copy #-}

-- | Copy a vector. The two vectors must have the same length and may not
-- overlap. This is not checked.
--
unsafeCopy
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
      -- ^ target
    -> NonEmptyMVector (PrimState m) a
      -- ^ source
    -> m ()
unsafeCopy :: NonEmptyMVector (PrimState m) a
-> NonEmptyMVector (PrimState m) a -> m ()
unsafeCopy (NonEmptyMVector MVector (PrimState m) a
v) (NonEmptyMVector MVector (PrimState m) a
v') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
M.unsafeCopy MVector (PrimState m) a
v MVector (PrimState m) a
v'
{-# INLINE 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.
--
move
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
    -> NonEmptyMVector (PrimState m) a -> m ()
move :: NonEmptyMVector (PrimState m) a
-> NonEmptyMVector (PrimState m) a -> m ()
move (NonEmptyMVector MVector (PrimState m) a
v) (NonEmptyMVector MVector (PrimState m) a
v') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
M.move MVector (PrimState m) a
v MVector (PrimState m) a
v'
{-# INLINE 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.
--
unsafeMove
    :: PrimMonad m
    => NonEmptyMVector (PrimState m) a
      -- ^ target
    -> NonEmptyMVector (PrimState m) a
      -- ^ source
    -> m ()
unsafeMove :: NonEmptyMVector (PrimState m) a
-> NonEmptyMVector (PrimState m) a -> m ()
unsafeMove (NonEmptyMVector MVector (PrimState m) a
v) (NonEmptyMVector MVector (PrimState m) a
v') = MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
M.unsafeMove MVector (PrimState m) a
v MVector (PrimState m) a
v'
{-# INLINE unsafeMove #-}

-- | Compute the next (lexicographically) permutation of given vector in-place.
--   Returns False when input is the last permtuation
--
nextPermutation
    :: (PrimMonad m,Ord e)
    => NonEmptyMVector (PrimState m) e
    -> m Bool
nextPermutation :: NonEmptyMVector (PrimState m) e -> m Bool
nextPermutation = MVector (PrimState m) e -> m Bool
forall (m :: * -> *) e.
(PrimMonad m, Ord e) =>
MVector (PrimState m) e -> m Bool
M.nextPermutation (MVector (PrimState m) e -> m Bool)
-> (NonEmptyMVector (PrimState m) e -> MVector (PrimState m) e)
-> NonEmptyMVector (PrimState m) e
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMVector (PrimState m) e -> MVector (PrimState m) e
forall s a. NonEmptyMVector s a -> MVector s a
_nemVec
{-# INLINE nextPermutation #-}