{-# LANGUAGE Rank2Types, MultiParamTypeClasses, BangPatterns, TypeFamilies #-}
module Data.RangeMin.Common.Types.IPVector (IP(..), IPVector, IPMVector, unzipIPM) where

import Control.Monad
import Data.RangeMin.Common.ST
import Data.Primitive
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Primitive as P
-- import qualified Data.Vector.Generic.New as New

data IP = IP {-# UNPACK #-} !Int {-# UNPACK #-} !Int

data IPVector a = IPVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !ByteArray 
			{-# UNPACK #-} !ByteArray

data IPMVector s a = IPMVector {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !(MutableByteArray s)
			{-# UNPACK #-} !(MutableByteArray s)

type instance G.Mutable IPVector = IPMVector

{-# INLINE unzipM #-}
unzipM :: IPMVector s IP -> (P.MVector s Int, P.MVector s Int)
unzipM (IPMVector i n xs ys) = (P.MVector i n xs, P.MVector i n ys)

{-# INLINE unzipIPM #-}
unzipIPM :: (forall s . ST s (IPMVector s IP)) -> (P.Vector Int, P.Vector Int)
unzipIPM mvec = inlineRunST $ do
	(!xs, !ys) <- unzipM `liftM` mvec
	liftM2 (,) (G.unsafeFreeze xs) (G.unsafeFreeze ys)

instance G.Vector IPVector IP where
	{-# INLINE unsafeFreeze #-}
	{-# INLINE basicLength #-}
	{-# INLINE basicUnsafeSlice #-}
	{-# INLINE basicUnsafeIndexM #-}
	{-# INLINE basicUnsafeCopy #-}
	unsafeFreeze (IPMVector i n xs ys) = do
		xs' <- unsafeFreezeByteArray xs
		ys' <- unsafeFreezeByteArray ys
		return (IPVector i n xs' ys')
	basicLength (IPVector _ n _ _) = n
	basicUnsafeSlice i k (IPVector j _ xs ys) = IPVector (i + j) k xs ys
	basicUnsafeIndexM (IPVector i _ xs ys) j = 
		return (IP (indexByteArray xs k) (indexByteArray ys k))
			where !k = i + j
	basicUnsafeCopy (IPMVector i n dst1 dst2) (IPVector j _ src1 src2) = do
		let !sz = sizeOf (1 :: Int)
		memcpyByteArray' dst1 (i * sz) src1 (j * sz) (n * sz)
		memcpyByteArray' dst2 (i * sz) src2 (j * sz) (n * sz)
	elemseq _ = seq

instance GM.MVector IPMVector IP where
	{-# INLINE basicLength #-}
	{-# INLINE basicUnsafeSlice #-}
	{-# INLINE basicOverlaps #-}
	{-# INLINE basicUnsafeNew #-}
	{-# INLINE basicUnsafeRead #-}
	{-# INLINE basicUnsafeWrite #-}
	{-# INLINE basicUnsafeCopy #-}
	basicLength (IPMVector _ n _ _) = n
	basicUnsafeSlice !k !m (IPMVector i _ xs ys) = 
		IPMVector (i + k) m xs ys
	basicOverlaps (IPMVector i m xs1 ys1) (IPMVector j n xs2 ys2) =
		(sameMutableByteArray xs1 xs2 || sameMutableByteArray ys1 ys2) && (between i j (j+n) || between j i (i+m))
    		where between x y z = x >= y && x < z
    	basicUnsafeNew !n = do
    		let m = n * sizeOf (0 :: Int)
    		liftM2 (IPMVector 0 n) (newByteArray m) (newByteArray m)
    	basicUnsafeRead (IPMVector i _ xs ys) j = do
    		let !k = i + j
    		liftM2 IP (readByteArray xs k) (readByteArray ys k)
    	basicUnsafeWrite (IPMVector i _ xs ys) j (IP x y) = do
    		let !k = i + j
    		writeByteArray xs k x
    		writeByteArray ys k y
    	basicClear _ = return ()
    	basicUnsafeCopy (IPMVector i n dst1 dst2) (IPMVector j _ src1 src2) = do
    		let !sz = sizeOf (0 :: Int)
    		memcpyByteArray dst1 (i * sz) src1 (j * sz) (n * sz)
    		memcpyByteArray dst2 (i * sz) src2 (j * sz) (n * sz)