{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Imj.Data.Vector.Unboxed.Mutable.Dynamic(
STVector
, IOVector
, new
, read
, unsafeRead
, length
, capacity
, clear
, pushBack
, unstableSort
, accessUnderlying
) where
import Imj.Prelude
import Data.Data(Typeable)
import Data.Vector.Algorithms.Intro(sort)
import Control.Monad.Primitive(RealWorld, PrimMonad, PrimState)
import Data.Primitive.MutVar(MutVar, readMutVar, newMutVar, writeMutVar)
import qualified Data.Vector.Unboxed.Mutable as MV(MVector, take, length, new, unsafeRead,
unsafeGrow, unsafeWrite)
import qualified Data.Vector.Unboxed as V(Unbox)
newtype MVector s a = MVector (MutVar s (MVectorData s a)) deriving (Typeable)
type IOVector = MVector RealWorld
type STVector = MVector
data MVectorData s a = MVectorData {
_mVectorDatasize :: {-# UNPACK #-} !Int,
_mVectorDataBuffer :: !(MV.MVector s a)}
deriving (Typeable)
{-# INLINABLE accessUnderlying #-}
accessUnderlying :: (PrimMonad m, V.Unbox a)
=> MVector (PrimState m) a
-> m (MV.MVector (PrimState m) a)
accessUnderlying (MVector v') =
readMutVar v'
>>=
\(MVectorData sz v) -> return $ MV.take sz v
unstableSort :: (PrimMonad m, V.Unbox a, Ord a)
=> MVector (PrimState m) a
-> m ()
unstableSort v =
accessUnderlying v
>>= sort
{-# INLINABLE unstableSort #-}
length :: PrimMonad m
=> MVector (PrimState m) a
-> m Int
length (MVector v) =
readMutVar v
>>= \(MVectorData sz _) -> return sz
{-# INLINABLE length #-}
capacity :: (PrimMonad m, V.Unbox a)
=> MVector (PrimState m) a
-> m Int
capacity (MVector v) =
readMutVar v
>>= \(MVectorData _ d) -> return $ MV.length d
{-# INLINABLE capacity #-}
new :: (PrimMonad m, V.Unbox a)
=> Int
-> m (MVector (PrimState m) a)
new i =
MV.new i
>>=
\v -> MVector <$> newMutVar (MVectorData 0 v)
{-# INLINABLE new #-}
read :: (PrimMonad m, V.Unbox a)
=> MVector (PrimState m) a
-> Int
-> m a
read (MVector v') i =
readMutVar v'
>>=
\(MVectorData s v) ->
if i >= s || i < 0
then
error "Data.Vector.Mutable.Dynamic: read: index out of bounds"
else
MV.unsafeRead v i
{-# INLINABLE read #-}
unsafeRead :: (PrimMonad m, V.Unbox a)
=> MVector (PrimState m) a
-> Int
-> m a
unsafeRead (MVector v) i =
readMutVar v
>>=
\(MVectorData _ d) -> d `MV.unsafeRead` i
{-# INLINABLE unsafeRead #-}
clear :: PrimMonad m
=> MVector (PrimState m) a
-> m ()
clear (MVector v) =
readMutVar v
>>=
\(MVectorData _ d) -> writeMutVar v (MVectorData 0 d)
{-# INLINABLE clear #-}
pushBack :: (PrimMonad m, V.Unbox a)
=> MVector (PrimState m) a
-> a
-> m ()
pushBack (MVector v) a =
readMutVar v
>>=
\(MVectorData s v') ->
if s == MV.length v'
then do
v'' <- MV.unsafeGrow v' (s + 1)
MV.unsafeWrite v'' s a
writeMutVar v (MVectorData (s + 1) v'')
else do
MV.unsafeWrite v' s a
writeMutVar v (MVectorData (s + 1) v')
{-# INLINABLE pushBack #-}