{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-}



-- |
-- Module      : Data.Vector.Storable.Mutable
-- Copyright   : (c) Roman Leshchinskiy 2009-2010
-- License     : BSD-style
--
-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable
--
-- Mutable vectors based on Storable.
--

module Data.Vector.Storable.Mutable(
  -- * Mutable vectors of 'Storable' types
  MVector(..), IOVector, STVector, Storable,

  -- * 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, clone,

  -- ** Growing
  grow, unsafeGrow,

  -- ** Restricting memory usage
  clear,

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

  -- * Modifying vectors

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

  -- * Unsafe conversions
  unsafeCast,


  -- * Raw pointers
  unsafeFromForeignPtr, unsafeFromForeignPtr0,
  unsafeToForeignPtr,   unsafeToForeignPtr0,
  unsafeWith
) where

import Control.DeepSeq ( NFData(rnf)
#if MIN_VERSION_deepseq(1,4,3)
                       , NFData1(liftRnf)
#endif
                       )

import qualified Data.Vector.Generic.Mutable as G
import Data.Vector.Storable.Internal

import Foreign.Storable
import Foreign.ForeignPtr

#if __GLASGOW_HASKELL__ >= 706
import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)
#elif __GLASGOW_HASKELL__ >= 700
import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray,
                                 unsafeFreezeByteArray)
import GHC.Prim (byteArrayContents#, unsafeCoerce#)
import GHC.ForeignPtr
#endif

import GHC.Base ( Int(..) )

import Foreign.Ptr (castPtr,plusPtr)
import Foreign.Marshal.Array ( advancePtr, copyArray, moveArray )

import Control.Monad.Primitive
import Data.Primitive.Types (Prim)
import qualified Data.Primitive.Types as DPT

import GHC.Word (Word8, Word16, Word32, Word64)
import GHC.Ptr (Ptr(..))

import Prelude hiding ( length, null, replicate, reverse, map, read,
                        take, drop, splitAt, init, tail )

import Data.Typeable ( Typeable )


-- Data.Vector.Internal.Check is not needed
#define NOT_VECTOR_MODULE
#include "vector.h"



-- | Mutable 'Storable'-based vectors
data MVector s a = MVector {-# UNPACK #-} !Int
                           {-# UNPACK #-} !(ForeignPtr a)
        deriving ( Typeable )

type IOVector = MVector RealWorld
type STVector s = MVector s

instance NFData (MVector s a) where
  rnf :: MVector s a -> ()
rnf (MVector Int
_ ForeignPtr a
_) = ()

#if MIN_VERSION_deepseq(1,4,3)
instance NFData1 (MVector s) where
  liftRnf :: (a -> ()) -> MVector s a -> ()
liftRnf a -> ()
_ (MVector Int
_ ForeignPtr a
_) = ()
#endif

instance Storable a => G.MVector MVector a where
  {-# INLINE basicLength #-}
  basicLength :: MVector s a -> Int
basicLength (MVector Int
n ForeignPtr a
_) = Int
n

  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice :: Int -> Int -> MVector s a -> MVector s a
basicUnsafeSlice Int
j Int
m (MVector Int
_ ForeignPtr a
fp) = Int -> ForeignPtr a -> MVector s a
forall s a. Int -> ForeignPtr a -> MVector s a
MVector Int
m ((Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a
forall a. (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a
updPtr (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
j) ForeignPtr a
fp)

  -- FIXME: this relies on non-portable pointer comparisons
  {-# INLINE basicOverlaps #-}
  basicOverlaps :: MVector s a -> MVector s a -> Bool
basicOverlaps (MVector Int
m ForeignPtr a
fp) (MVector Int
n ForeignPtr a
fq)
    = Ptr a -> Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> a -> Bool
between Ptr a
p Ptr a
q (Ptr a
q Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
n) Bool -> Bool -> Bool
|| Ptr a -> Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> a -> Bool
between Ptr a
q Ptr a
p (Ptr a
p Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
m)
    where
      between :: a -> a -> a -> Bool
between a
x a
y a
z = a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z
      p :: Ptr a
p = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
getPtr ForeignPtr a
fp
      q :: Ptr a
q = ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
getPtr ForeignPtr a
fq

  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) a)
basicUnsafeNew Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> m (MVector (PrimState m) a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (MVector (PrimState m) a))
-> [Char] -> m (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Storable.basicUnsafeNew: negative length: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mx = [Char] -> m (MVector (PrimState m) a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (MVector (PrimState m) a))
-> [Char] -> m (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ [Char]
"Storable.basicUnsafeNew: length too large: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    | Bool
otherwise = IO (MVector (PrimState m) a) -> m (MVector (PrimState m) a)
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (MVector (PrimState m) a) -> m (MVector (PrimState m) a))
-> IO (MVector (PrimState m) a) -> m (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ do
        ForeignPtr a
fp <- Int -> IO (ForeignPtr a)
forall a. Storable a => Int -> IO (ForeignPtr a)
mallocVector Int
n
        MVector (PrimState m) a -> IO (MVector (PrimState m) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector (PrimState m) a -> IO (MVector (PrimState m) a))
-> MVector (PrimState m) a -> IO (MVector (PrimState m) a)
forall a b. (a -> b) -> a -> b
$ Int -> ForeignPtr a -> MVector (PrimState m) a
forall s a. Int -> ForeignPtr a -> MVector s a
MVector Int
n ForeignPtr a
fp
    where
      size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
1
      mx :: Int
mx = Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
size :: Int

  {-# INLINE basicInitialize #-}
  basicInitialize :: MVector (PrimState m) a -> m ()
basicInitialize = MVector (PrimState m) a -> m ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m ()
storableZero

  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead :: MVector (PrimState m) a -> Int -> m a
basicUnsafeRead (MVector Int
_ ForeignPtr a
fp) Int
i
    = IO a -> m a
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim
    (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp (Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
`peekElemOff` Int
i)

  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite :: MVector (PrimState m) a -> Int -> a -> m ()
basicUnsafeWrite (MVector Int
_ ForeignPtr a
fp) Int
i a
x
    = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim
    (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
p Int
i a
x

  {-# INLINE basicSet #-}
  basicSet :: MVector (PrimState m) a -> a -> m ()
basicSet = MVector (PrimState m) a -> a -> m ()
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> a -> m ()
storableSet

  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeCopy :: MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
basicUnsafeCopy (MVector Int
n ForeignPtr a
fp) (MVector Int
_ ForeignPtr a
fq)
    = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim
    (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fq ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
q ->
      Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr a
p Ptr a
q Int
n

  {-# INLINE basicUnsafeMove #-}
  basicUnsafeMove :: MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
basicUnsafeMove (MVector Int
n ForeignPtr a
fp) (MVector Int
_ ForeignPtr a
fq)
    = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim
    (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
p ->
      ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fq ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
q ->
      Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
moveArray Ptr a
p Ptr a
q Int
n

storableZero :: forall a m. (Storable a, PrimMonad m) => MVector (PrimState m) a -> m ()
{-# INLINE storableZero #-}
storableZero :: MVector (PrimState m) a -> m ()
storableZero (MVector Int
n ForeignPtr a
fp) = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ())
-> ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> m ()) -> (Ptr a -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr-> do
  Ptr Any -> Int -> Word8 -> IO ()
forall a c (m :: * -> *).
(Prim c, PrimMonad m) =>
Ptr a -> Int -> c -> m ()
memsetPrimPtr_vector (Ptr a -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
byteSize (Word8
0 :: Word8)
 where
 x :: a
 x :: a
x = a
forall a. HasCallStack => a
undefined
 byteSize :: Int
 byteSize :: Int
byteSize = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf a
x

storableSet :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> a -> m ()
{-# INLINE storableSet #-}
storableSet :: MVector (PrimState m) a -> a -> m ()
storableSet (MVector Int
n ForeignPtr a
fp) a
x
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
                case a -> Int
forall a. Storable a => a -> Int
sizeOf a
x of
                  Int
1 -> Int -> ForeignPtr a -> a -> Word8 -> IO ()
forall a b.
(Storable a, Prim b) =>
Int -> ForeignPtr a -> a -> b -> IO ()
storableSetAsPrim Int
n ForeignPtr a
fp a
x (Word8
forall a. HasCallStack => a
undefined :: Word8)
                  Int
2 -> Int -> ForeignPtr a -> a -> Word16 -> IO ()
forall a b.
(Storable a, Prim b) =>
Int -> ForeignPtr a -> a -> b -> IO ()
storableSetAsPrim Int
n ForeignPtr a
fp a
x (Word16
forall a. HasCallStack => a
undefined :: Word16)
                  Int
4 -> Int -> ForeignPtr a -> a -> Word32 -> IO ()
forall a b.
(Storable a, Prim b) =>
Int -> ForeignPtr a -> a -> b -> IO ()
storableSetAsPrim Int
n ForeignPtr a
fp a
x (Word32
forall a. HasCallStack => a
undefined :: Word32)
                  Int
8 -> Int -> ForeignPtr a -> a -> Word64 -> IO ()
forall a b.
(Storable a, Prim b) =>
Int -> ForeignPtr a -> a -> b -> IO ()
storableSetAsPrim Int
n ForeignPtr a
fp a
x (Word64
forall a. HasCallStack => a
undefined :: Word64)
                  Int
_ -> ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr a
p -> do
                       Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
p a
x

                       let do_set :: Int -> IO ()
do_set Int
i
                             | Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = do
                                 Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray (Ptr a
p Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
i) Ptr a
p Int
i
                                 Int -> IO ()
do_set (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)
                             | Bool
otherwise = Ptr a -> Ptr a -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray (Ptr a
p Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
i) Ptr a
p (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)

                       Int -> IO ()
do_set Int
1

storableSetAsPrim
  :: forall a b . (Storable a, Prim b) => Int -> ForeignPtr a -> a -> b -> IO ()
{-# INLINE [0] storableSetAsPrim #-}
storableSetAsPrim :: Int -> ForeignPtr a -> a -> b -> IO ()
storableSetAsPrim Int
n ForeignPtr a
fp a
x b
_y = ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr a
ptr  -> do
    Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
     -- we dont equate storable and prim reps, so we need to write to a slot
     -- in storable
     -- then read it back as a prim
    b
w<- Ptr b -> Int -> IO b
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
Ptr a -> Int -> m a
peakPrimPtr_vector ((Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) :: Ptr  b) Int
0
    Ptr Any -> Int -> b -> IO ()
forall a c (m :: * -> *).
(Prim c, PrimMonad m) =>
Ptr a -> Int -> c -> m ()
memsetPrimPtr_vector ((Ptr a -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf a
x ) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)  b
w



{-
AFTER primitive 0.7 is pretty old, move to using setPtr. which is really
a confusing misnomer for whats often called memset (intialize )
-}
-- Fill a memory block with the given value. The length is in
-- elements of type @a@ rather than in bytes.
memsetPrimPtr_vector :: forall a c m. (Prim c, PrimMonad m) => Ptr a -> Int -> c -> m ()
memsetPrimPtr_vector :: Ptr a -> Int -> c -> m ()
memsetPrimPtr_vector (Ptr Addr#
addr#) (I# Int#
n#) c
x = (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (Addr#
-> Int#
-> Int#
-> c
-> State# (PrimState m)
-> State# (PrimState m)
forall a s.
Prim a =>
Addr# -> Int# -> Int# -> a -> State# s -> State# s
DPT.setOffAddr# Addr#
addr# Int#
0# Int#
n# c
x)
{-# INLINE memsetPrimPtr_vector #-}


-- Read a value from a memory position given by an address and an offset.
-- The offset is in elements of type @a@ rather than in bytes.
peakPrimPtr_vector :: (Prim a, PrimMonad m) => Ptr a -> Int -> m a
peakPrimPtr_vector :: Ptr a -> Int -> m a
peakPrimPtr_vector (Ptr Addr#
addr#) (I# Int#
i#) = (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (Addr#
-> Int# -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall a s.
Prim a =>
Addr# -> Int# -> State# s -> (# State# s, a #)
DPT.readOffAddr# Addr#
addr# Int#
i#)
{-# INLINE peakPrimPtr_vector #-}

{-# INLINE mallocVector #-}
mallocVector :: Storable a => Int -> IO (ForeignPtr a)
mallocVector :: Int -> IO (ForeignPtr a)
mallocVector =
#if __GLASGOW_HASKELL__ >= 706
  a -> Int -> IO (ForeignPtr a)
forall b. Storable b => b -> Int -> IO (ForeignPtr b)
doMalloc a
forall a. HasCallStack => a
undefined
  where
    doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
    doMalloc :: b -> Int -> IO (ForeignPtr b)
doMalloc b
dummy Int
size =
      Int -> Int -> IO (ForeignPtr b)
forall a. Int -> Int -> IO (ForeignPtr a)
mallocPlainForeignPtrAlignedBytes (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* b -> Int
forall a. Storable a => a -> Int
sizeOf b
dummy) (b -> Int
forall a. Storable a => a -> Int
alignment b
dummy)
#elif __GLASGOW_HASKELL__ >= 700
  doMalloc undefined
  where
    doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b)
    doMalloc dummy size = do
      arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign
      newConcForeignPtr
        (Ptr (byteArrayContents# (unsafeCoerce# arr#)))
        -- Keep reference to mutable byte array until whole ForeignPtr goes out
        -- of scope.
        (touch arr)
      where
        arrSize  = size * sizeOf dummy
        arrAlign = alignment dummy
#else
    mallocForeignPtrArray
#endif

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

-- | Length of the mutable vector.
length :: Storable a => MVector s a -> Int
{-# INLINE length #-}
length :: 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
null :: Storable a => MVector s a -> Bool
{-# INLINE null #-}
null :: 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.
slice :: Storable a
      => Int  -- ^ @i@ starting index
      -> Int  -- ^ @n@ length
      -> MVector s a
      -> MVector s a
{-# INLINE slice #-}
slice :: Int -> Int -> MVector s a -> MVector s a
slice = Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
G.slice

take :: Storable a => Int -> MVector s a -> MVector s a
{-# INLINE take #-}
take :: 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 :: Storable a => Int -> MVector s a -> MVector s a
{-# INLINE drop #-}
drop :: 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

splitAt :: Storable a => Int -> MVector s a -> (MVector s a, MVector s a)
{-# INLINE splitAt #-}
splitAt :: 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

init :: Storable a => MVector s a -> MVector s a
{-# INLINE init #-}
init :: 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

tail :: Storable a => MVector s a -> MVector s a
{-# INLINE tail #-}
tail :: 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.
unsafeSlice :: Storable a
            => Int  -- ^ starting index
            -> Int  -- ^ length of the slice
            -> MVector s a
            -> MVector s a
{-# INLINE unsafeSlice #-}
unsafeSlice :: 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

unsafeTake :: Storable a => Int -> MVector s a -> MVector s a
{-# INLINE unsafeTake #-}
unsafeTake :: 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

unsafeDrop :: Storable a => Int -> MVector s a -> MVector s a
{-# INLINE unsafeDrop #-}
unsafeDrop :: 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

unsafeInit :: Storable a => MVector s a -> MVector s a
{-# INLINE unsafeInit #-}
unsafeInit :: 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

unsafeTail :: Storable a => MVector s a -> MVector s a
{-# INLINE unsafeTail #-}
unsafeTail :: 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.
overlaps :: Storable a => MVector s a -> MVector s a -> Bool
{-# INLINE overlaps #-}
overlaps :: 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.
new :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)
{-# INLINE new #-}
new :: Int -> m (MVector (PrimState m) a)
new = Int -> m (MVector (PrimState m) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
G.new

-- | Create a mutable vector of the given length. The vector content
--   is uninitialized, which means it is filled with whatever underlying memory
--   buffer happens to contain.
--
-- @since 0.5
unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a)
{-# INLINE unsafeNew #-}
unsafeNew :: 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.
replicate :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a)
{-# INLINE replicate #-}
replicate :: 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.
replicateM :: (PrimMonad m, Storable a) => Int -> m a -> m (MVector (PrimState m) a)
{-# INLINE replicateM #-}
replicateM :: 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

-- | Create a copy of a mutable vector.
clone :: (PrimMonad m, Storable a)
      => MVector (PrimState m) a -> m (MVector (PrimState m) a)
{-# INLINE clone #-}
clone :: 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 storable vector by the given number of elements. The number must be
-- non-negative. Same semantics as in `G.grow` for generic vector.
--
-- ====__Examples__
--
-- >>> import qualified Data.Vector.Storable as VS
-- >>> import qualified Data.Vector.Storable.Mutable as MVS
-- >>> mv <- VS.thaw $ VS.fromList ([10, 20, 30] :: [Int])
-- >>> mv' <- MVS.grow mv 2
--
-- Extra memory at the end of the newly allocated vector is initialized to 0
-- bytes, which for `Storable` instance will usually correspond to some default
-- value for a particular type, eg. @0@ for @Int@, @False@ for @Bool@,
-- etc. However, if `unsafeGrow` was used instead this would not have been
-- guaranteed and some garbage would be there instead:
--
-- >>> VS.unsafeFreeze mv'
-- [10,20,30,0,0]
--
-- Having the extra space we can write new values in there:
--
-- >>> MVS.write mv' 3 999
-- >>> VS.unsafeFreeze mv'
-- [10,20,30,999,0]
--
-- It is important to note that the source mutable vector is not affected when
-- the newly allocated one is mutated.
--
-- >>> MVS.write mv' 2 888
-- >>> VS.unsafeFreeze mv'
-- [10,20,888,999,0]
-- >>> VS.unsafeFreeze mv
-- [10,20,30]
--
-- @since 0.5
grow :: (PrimMonad m, Storable a)
     => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
{-# INLINE grow #-}
grow :: 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.
(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. Same semantics as in `G.unsafeGrow` for generic vector.
--
-- @since 0.5
unsafeGrow :: (PrimMonad m, Storable a)
           => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
{-# INLINE unsafeGrow #-}
unsafeGrow :: 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. This is usually a noop for unboxed vectors.
clear :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> m ()
{-# INLINE clear #-}
clear :: 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.
read :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a
{-# INLINE read #-}
read :: MVector (PrimState m) a -> Int -> m a
read = MVector (PrimState m) a -> Int -> m a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
G.read

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

-- | Modify the element at the given position.
modify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()
{-# INLINE modify #-}
modify :: MVector (PrimState m) a -> (a -> a) -> Int -> m ()
modify = 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.modify

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


-- | Yield the element at the given position. No bounds checks are performed.
unsafeRead :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> m a
{-# INLINE unsafeRead #-}
unsafeRead :: 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.
unsafeWrite
    :: (PrimMonad m, Storable a) =>  MVector (PrimState m) a -> Int -> a -> m ()
{-# INLINE unsafeWrite #-}
unsafeWrite :: 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.
unsafeModify :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> (a -> a) -> Int -> m ()
{-# INLINE unsafeModify #-}
unsafeModify :: 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

-- | Swap the elements at the given positions. No bounds checks are performed.
unsafeSwap
    :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> Int -> Int -> m ()
{-# INLINE unsafeSwap #-}
unsafeSwap :: 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

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

-- | Set all elements of the vector to the given value.
set :: (PrimMonad m, Storable a) => MVector (PrimState m) a -> a -> m ()
{-# INLINE set #-}
set :: 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.
copy :: (PrimMonad m, Storable a)
     => MVector (PrimState m) a   -- ^ target
     -> MVector (PrimState m) a   -- ^ source
     -> m ()
{-# INLINE copy #-}
copy :: MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
copy = 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.copy

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

-- Unsafe conversions
-- ------------------

-- | /O(1)/ Unsafely cast a mutable vector from one element type to another.
-- The operation just changes the type of the underlying pointer and does not
-- modify the elements.
--
-- The resulting vector contains as many elements as can fit into the
-- underlying memory block.
--
unsafeCast :: forall a b s.
              (Storable a, Storable b) => MVector s a -> MVector s b
{-# INLINE unsafeCast #-}
unsafeCast :: MVector s a -> MVector s b
unsafeCast (MVector Int
n ForeignPtr a
fp)
  = Int -> ForeignPtr b -> MVector s b
forall s a. Int -> ForeignPtr a -> MVector s a
MVector ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` b -> Int
forall a. Storable a => a -> Int
sizeOf (b
forall a. HasCallStack => a
undefined :: b))
            (ForeignPtr a -> ForeignPtr b
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr a
fp)

-- Raw pointers
-- ------------

-- | Create a mutable vector from a 'ForeignPtr' with an offset and a length.
--
-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector
-- could have been frozen before the modification.
--
--  If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'.
unsafeFromForeignPtr :: Storable a
                     => ForeignPtr a    -- ^ pointer
                     -> Int             -- ^ offset
                     -> Int             -- ^ length
                     -> MVector s a
{-# INLINE_FUSED unsafeFromForeignPtr #-}
unsafeFromForeignPtr :: ForeignPtr a -> Int -> Int -> MVector s a
unsafeFromForeignPtr ForeignPtr a
fp Int
i Int
n = ForeignPtr a -> Int -> MVector s a
forall a s. Storable a => ForeignPtr a -> Int -> MVector s a
unsafeFromForeignPtr0 ForeignPtr a
fp' Int
n
    where
      fp' :: ForeignPtr a
fp' = (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a
forall a. (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a
updPtr (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
`advancePtr` Int
i) ForeignPtr a
fp

{-# RULES
"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n.
  unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n   #-}


-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length.
--
-- It is assumed the pointer points directly to the data (no offset).
-- Use `unsafeFromForeignPtr` if you need to specify an offset.
--
-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector
-- could have been frozen before the modification.
unsafeFromForeignPtr0 :: Storable a
                      => ForeignPtr a    -- ^ pointer
                      -> Int             -- ^ length
                      -> MVector s a
{-# INLINE unsafeFromForeignPtr0 #-}
unsafeFromForeignPtr0 :: ForeignPtr a -> Int -> MVector s a
unsafeFromForeignPtr0 ForeignPtr a
fp Int
n = Int -> ForeignPtr a -> MVector s a
forall s a. Int -> ForeignPtr a -> MVector s a
MVector Int
n ForeignPtr a
fp

-- | Yield the underlying 'ForeignPtr' together with the offset to the data
-- and its length. Modifying the data through the 'ForeignPtr' is
-- unsafe if the vector could have frozen before the modification.
unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int)
{-# INLINE unsafeToForeignPtr #-}
unsafeToForeignPtr :: MVector s a -> (ForeignPtr a, Int, Int)
unsafeToForeignPtr (MVector Int
n ForeignPtr a
fp) = (ForeignPtr a
fp, Int
0, Int
n)

-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length.
--
-- You can assume the pointer points directly to the data (no offset).
--
-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could
-- have frozen before the modification.
unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int)
{-# INLINE unsafeToForeignPtr0 #-}
unsafeToForeignPtr0 :: MVector s a -> (ForeignPtr a, Int)
unsafeToForeignPtr0 (MVector Int
n ForeignPtr a
fp) = (ForeignPtr a
fp, Int
n)

-- | Pass a pointer to the vector's data to the IO action. Modifying data
-- through the pointer is unsafe if the vector could have been frozen before
-- the modification.
unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
{-# INLINE unsafeWith #-}
unsafeWith :: IOVector a -> (Ptr a -> IO b) -> IO b
unsafeWith (MVector Int
_ ForeignPtr a
fp) = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
fp