content: {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns #-}
  
  -- |
  -- Module      : Data.Vector.Mutable
  -- Copyright   : (c) Roman Leshchinskiy 2008-2010
  -- License     : BSD-style
  --
  -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
  -- Stability   : experimental
  -- Portability : non-portable
  -- 
  -- Mutable boxed vectors.
  --
  
  module Data.Vector.Mutable (
    -- * Mutable boxed vectors
    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, clone,
  
    -- ** Growing
    grow, unsafeGrow,
  
    -- ** Restricting memory usage
    clear,
  
    -- * Accessing individual elements
    read, write, swap,
    unsafeRead, unsafeWrite, unsafeSwap,
  
    -- * Modifying vectors
  
    -- ** Filling and copying
    set, copy, move, unsafeCopy, unsafeMove
  ) where
  
  import           Control.Monad (when)
  import qualified Data.Vector.Generic.Mutable as G
  import           Data.Primitive.Array
  import           Control.Monad.Primitive
  
  import Control.DeepSeq ( NFData, rnf )
  
  import Prelude hiding ( length, null, replicate, reverse, map, read,
                          take, drop, splitAt, init, tail )
  
  import Data.Typeable ( Typeable )
  
  #include "vector.h"
  
  -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).
  data MVector s a = MVector {-# UNPACK #-} !Int
                             {-# UNPACK #-} !Int
                             {-# UNPACK #-} !(MutableArray s a)
          deriving ( Typeable )
  
  type IOVector = MVector RealWorld
  type STVector s = MVector s
  
  -- NOTE: This seems unsafe, see http://trac.haskell.org/vector/ticket/54
  {-
  instance NFData a => NFData (MVector s a) where
      rnf (MVector i n arr) = unsafeInlineST $ force i
          where
            force !ix | ix < n    = do x <- readArray arr ix
                                       rnf x `seq` force (ix+1)
                      | otherwise = return ()
  -}
  
  instance G.MVector MVector a where
    {-# INLINE basicLength #-}
    basicLength (MVector _ n _) = n
  
    {-# INLINE basicUnsafeSlice #-}
    basicUnsafeSlice j m (MVector i n arr) = MVector (i+j) m arr
  
    {-# INLINE basicOverlaps #-}
    basicOverlaps (MVector i m arr1) (MVector j n arr2)
      = sameMutableArray arr1 arr2
        && (between i j (j+n) || between j i (i+m))
      where
        between x y z = x >= y && x < z
  
    {-# INLINE basicUnsafeNew #-}
    basicUnsafeNew n
      = do
          arr <- newArray n uninitialised
          return (MVector 0 n arr)
  
    {-# INLINE basicUnsafeReplicate #-}
    basicUnsafeReplicate n x
      = do
          arr <- newArray n x
          return (MVector 0 n arr)
  
    {-# INLINE basicUnsafeRead #-}
    basicUnsafeRead (MVector i n arr) j = readArray arr (i+j)
  
    {-# INLINE basicUnsafeWrite #-}
    basicUnsafeWrite (MVector i n arr) j x = writeArray arr (i+j) x
  
    {-# INLINE basicUnsafeCopy #-}
    basicUnsafeCopy (MVector i n dst) (MVector j _ src)
      = copyMutableArray dst i src j n
    
    basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc)
      = case n of
          0 -> return ()
          1 -> readArray arrSrc iSrc >>= writeArray arrDst iDst
          2 -> do
                 x <- readArray arrSrc iSrc
                 y <- readArray arrSrc (iSrc + 1)
                 writeArray arrDst iDst x
                 writeArray arrDst (iDst + 1) y
          _
            | overlaps dst src
               -> case compare iDst iSrc of
                    LT -> moveBackwards arrDst iDst iSrc n
                    EQ -> return ()
                    GT | (iDst - iSrc) * 2 < n
                          -> moveForwardsLargeOverlap arrDst iDst iSrc n
                       | otherwise
                          -> moveForwardsSmallOverlap arrDst iDst iSrc n
            | otherwise -> G.basicUnsafeCopy dst src
  
    {-# INLINE basicClear #-}
    basicClear v = G.set v uninitialised
  
  {-# INLINE moveBackwards #-}
  moveBackwards :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m ()
  moveBackwards !arr !dstOff !srcOff !len =
    INTERNAL_CHECK(check) "moveBackwards" "not a backwards move" (dstOff < srcOff)
    $ loopM len $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i)
  
  {-# INLINE moveForwardsSmallOverlap #-}
  -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is small.
  moveForwardsSmallOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m ()
  moveForwardsSmallOverlap !arr !dstOff !srcOff !len =
    INTERNAL_CHECK(check) "moveForwardsSmallOverlap" "not a forward move" (dstOff > srcOff)
    $ do
        tmp <- newArray overlap uninitialised
        loopM overlap $ \ i -> readArray arr (dstOff + i) >>= writeArray tmp i
        loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray arr (dstOff + i)
        loopM overlap $ \ i -> readArray tmp i >>= writeArray arr (dstOff + nonOverlap + i)
    where nonOverlap = dstOff - srcOff; overlap = len - nonOverlap
  
  -- Performs a move when dstOff > srcOff, optimized for when the overlap of the intervals is large.
  moveForwardsLargeOverlap :: PrimMonad m => MutableArray (PrimState m) a -> Int -> Int -> Int -> m ()
  moveForwardsLargeOverlap !arr !dstOff !srcOff !len =
    INTERNAL_CHECK(check) "moveForwardsLargeOverlap" "not a forward move" (dstOff > srcOff)
    $ do
        queue <- newArray nonOverlap uninitialised
        loopM nonOverlap $ \ i -> readArray arr (srcOff + i) >>= writeArray queue i
        let mov !i !qTop = when (i < dstOff + len) $ do
              x <- readArray arr i
              y <- readArray queue qTop
              writeArray arr i y
              writeArray queue qTop x
              mov (i+1) (if qTop + 1 >= nonOverlap then 0 else qTop + 1)
        mov dstOff 0
    where nonOverlap = dstOff - srcOff
  
  {-# INLINE loopM #-}
  loopM :: Monad m => Int -> (Int -> m a) -> m ()
  loopM !n k = let
    go i = when (i < n) (k i >> go (i+1))
    in go 0
  
  uninitialised :: a
  uninitialised = error "Data.Vector.Mutable: uninitialised element"
  
  -- Length information
  -- ------------------
  
  -- | Length of the mutable vector.
  length :: MVector s a -> Int
  {-# INLINE length #-}
  length = G.length
  
  -- | Check whether the vector is empty
  null :: MVector s a -> Bool
  {-# INLINE null #-}
  null = G.null
  
  -- Extracting subvectors
  -- ---------------------
  
  -- | Yield a part of the mutable vector without copying it.
  slice :: Int -> Int -> MVector s a -> MVector s a
  {-# INLINE slice #-}
  slice = G.slice
  
  take :: Int -> MVector s a -> MVector s a
  {-# INLINE take #-}
  take = G.take
  
  drop :: Int -> MVector s a -> MVector s a
  {-# INLINE drop #-}
  drop = G.drop
  
  {-# INLINE splitAt #-}
  splitAt :: Int -> MVector s a -> (MVector s a, MVector s a)
  splitAt = G.splitAt
  
  init :: MVector s a -> MVector s a
  {-# INLINE init #-}
  init = G.init
  
  tail :: MVector s a -> MVector s a
  {-# INLINE tail #-}
  tail = G.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
              -> MVector s a
              -> MVector s a
  {-# INLINE unsafeSlice #-}
  unsafeSlice = G.unsafeSlice
  
  unsafeTake :: Int -> MVector s a -> MVector s a
  {-# INLINE unsafeTake #-}
  unsafeTake = G.unsafeTake
  
  unsafeDrop :: Int -> MVector s a -> MVector s a
  {-# INLINE unsafeDrop #-}
  unsafeDrop = G.unsafeDrop
  
  unsafeInit :: MVector s a -> MVector s a
  {-# INLINE unsafeInit #-}
  unsafeInit = G.unsafeInit
  
  unsafeTail :: MVector s a -> MVector s a
  {-# INLINE unsafeTail #-}
  unsafeTail = G.unsafeTail
  
  -- Overlapping
  -- -----------
  
  -- Check whether two vectors overlap.
  overlaps :: MVector s a -> MVector s a -> Bool
  {-# INLINE overlaps #-}
  overlaps = G.overlaps
  
  -- Initialisation
  -- --------------
  
  -- | Create a mutable vector of the given length.
  new :: PrimMonad m => Int -> m (MVector (PrimState m) a)
  {-# INLINE new #-}
  new = G.new
  
  -- | Create a mutable vector of the given length. The length is not checked.
  unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a)
  {-# INLINE unsafeNew #-}
  unsafeNew = 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 => Int -> a -> m (MVector (PrimState m) a)
  {-# INLINE replicate #-}
  replicate = 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 => Int -> m a -> m (MVector (PrimState m) a)
  {-# INLINE replicateM #-}
  replicateM = G.replicateM
  
  -- | Create a copy of a mutable vector.
  clone :: PrimMonad m => MVector (PrimState m) a -> m (MVector (PrimState m) a)
  {-# INLINE clone #-}
  clone = G.clone
  
  -- Growing
  -- -------
  
  -- | Grow a vector by the given number of elements. The number must be
  -- positive.
  grow :: PrimMonad m
                => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
  {-# INLINE grow #-}
  grow = G.grow
  
  -- | Grow a vector by the given number of elements. The number must be
  -- positive but this is not checked.
  unsafeGrow :: PrimMonad m
                 => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
  {-# INLINE unsafeGrow #-}
  unsafeGrow = 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 => MVector (PrimState m) a -> m ()
  {-# INLINE clear #-}
  clear = G.clear
  
  -- Accessing individual elements
  -- -----------------------------
  
  -- | Yield the element at the given position.
  read :: PrimMonad m => MVector (PrimState m) a -> Int -> m a
  {-# INLINE read #-}
  read = G.read
  
  -- | Replace the element at the given position.
  write :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()
  {-# INLINE write #-}
  write = G.write
  
  -- | Swap the elements at the given positions.
  swap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()
  {-# INLINE swap #-}
  swap = G.swap
  
  
  -- | Yield the element at the given position. No bounds checks are performed.
  unsafeRead :: PrimMonad m => MVector (PrimState m) a -> Int -> m a
  {-# INLINE unsafeRead #-}
  unsafeRead = G.unsafeRead
  
  -- | Replace the element at the given position. No bounds checks are performed.
  unsafeWrite :: PrimMonad m => MVector (PrimState m) a -> Int -> a -> m ()
  {-# INLINE unsafeWrite #-}
  unsafeWrite = G.unsafeWrite
  
  -- | Swap the elements at the given positions. No bounds checks are performed.
  unsafeSwap :: PrimMonad m => MVector (PrimState m) a -> Int -> Int -> m ()
  {-# INLINE unsafeSwap #-}
  unsafeSwap = G.unsafeSwap
  
  -- Filling and copying
  -- -------------------
  
  -- | Set all elements of the vector to the given value.
  set :: PrimMonad m => MVector (PrimState m) a -> a -> m ()
  {-# INLINE set #-}
  set = G.set
  
  -- | Copy a vector. The two vectors must have the same length and may not
  -- overlap.
  copy :: PrimMonad m
                   => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
  {-# INLINE copy #-}
  copy = G.copy
  
  -- | Copy a vector. The two vectors must have the same length and may not
  -- overlap. This is not checked.
  unsafeCopy :: PrimMonad m => MVector (PrimState m) a   -- ^ target
                            -> MVector (PrimState m) a   -- ^ source
                            -> m ()
  {-# INLINE unsafeCopy #-}
  unsafeCopy = 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
                   => MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
  {-# INLINE move #-}
  move = 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 => MVector (PrimState m) a   -- ^ target
                            -> MVector (PrimState m) a   -- ^ source
                            -> m ()
  {-# INLINE unsafeMove #-}
  unsafeMove = G.unsafeMove
  
  