module Data.Vector.FunctorLazy.Mutable
(
MVector(..), IOVector, STVector,
forceElement, Data.Vector.FunctorLazy.Mutable.mapM,
VGM.length, VGM.null,
VGM.new, VGM.unsafeNew, VGM.replicate, VGM.replicateM, VGM.clone,
VGM.grow, VGM.unsafeGrow,
VGM.clear,
VGM.read, VGM.write, VGM.swap,
VGM.unsafeRead, VGM.unsafeWrite, VGM.unsafeSwap,
VGM.set, VGM.copy, VGM.move, VGM.unsafeCopy, VGM.unsafeMove
)
where
import Data.Monoid hiding (Any)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed.Mutable as VUM
import Data.Vector.Unboxed.Deriving
import Data.Primitive.Array
import Data.Primitive.ByteArray
import Control.Monad.ST
import Control.Monad.Primitive
import Unsafe.Coerce
import System.IO.Unsafe
import GHC.Prim
import Data.Vector.FunctorLazy.Common
data MVector s a = MVector
{ mvecAny :: !(MutableArray s Any)
, mvecInt :: !(MutableByteArray s)
, mlen :: !Int
, mcontrol :: !LazyController
}
type IOVector = MVector RealWorld
type STVector s = MVector s
uninitialized :: a
uninitialized = error "Data.Vector.FunctorLazy: uninitialized element"
instance VGM.MVector MVector a where
basicLength (MVector va bi l c) = l
basicUnsafeNew len = do
mvecAny <- newArray len uninitialized
mvecInt <- newByteArray (len*8)
setByteArray mvecInt 0 len (0::Int)
return $ MVector
{ mvecAny = mvecAny
, mvecInt = mvecInt
, mlen = len
, mcontrol = mempty
}
basicUnsafeRead (MVector va vi len (LazyController fl fc)) i = do
any <- readArray va i
count :: Int <- readByteArray vi i
let val = unsafeCoerce any
if fc == count
then return val
else return $ forceElement (MVector va vi len (LazyController fl fc)) i
basicUnsafeWrite (MVector va vi len (LazyController fl fc)) i a = do
writeArray va i (unsafeCoerce a)
writeByteArray vi i fc
basicOverlaps = error "Data.Vector.FunctorLazy.MVector: basicOverlaps not supported"
basicUnsafeSlice s len v = unsafePerformIO $ do
v' :: MVector RealWorld a <- VGM.basicUnsafeNew len
do_copy s v'
return $ unsafeCoerce v'
where
do_copy i dst
| i < s+len = do
x <- VGM.basicUnsafeRead (unsafeCoerce v :: MVector RealWorld a) (s+i)
VGM.basicUnsafeWrite dst i x
do_copy (i+1) dst
| otherwise = return ()
basicUnsafeGrow v by = do
v' <- VGM.basicUnsafeNew (n+by)
VGM.basicUnsafeCopy v' v
return v'
where
n = VGM.basicLength v
forceElement :: MVector s a -> Int -> a
forceElement (MVector va vi len (LazyController fl fc)) i = unsafePerformIO $ do
any <- readArray (unsafeCoerce va) i
count :: Int <- readByteArray (unsafeCoerce vi) i
let count' = fc
let any' = appList any (take (fc count) fl) :: a
writeArray (unsafeCoerce va) i (unsafeCoerce any')
writeByteArray (unsafeCoerce vi) i (count')
return any'
mapM :: (Monad m) => (a -> b) -> MVector s a -> m (MVector s b)
mapM f v = return $ v { mcontrol = LazyController
{ funcL = (unsafeCoerce f):(funcL $ mcontrol v)
, funcC = 1+(funcC $ mcontrol v)
}}