module Data.Vector.Unboxed.Base (
MVector(..), IOVector, STVector, Vector(..), Unbox
) where
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as M
import qualified Data.Vector.Primitive as P
import Control.Monad.Primitive
import Control.Monad ( liftM )
import Data.Word ( Word, Word8, Word16, Word32, Word64 )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Complex
import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp,
#if MIN_VERSION_base(4,4,0)
mkTyCon3
#else
mkTyCon
#endif
)
import Data.Data ( Data(..) )
#include "vector.h"
data family MVector s a
data family Vector a
type IOVector = MVector RealWorld
type STVector s = MVector s
type instance G.Mutable Vector = MVector
class (G.Vector Vector a, M.MVector MVector a) => Unbox a
#if MIN_VERSION_base(4,4,0)
vectorTyCon = mkTyCon3 "vector"
#else
vectorTyCon m s = mkTyCon $ m ++ "." ++ s
#endif
instance Typeable1 Vector where
typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") []
instance Typeable2 MVector where
typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") []
instance (Data a, Unbox a) => Data (Vector a) where
gfoldl = G.gfoldl
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector"
dataCast1 = G.dataCast
newtype instance MVector s () = MV_Unit Int
newtype instance Vector () = V_Unit Int
instance Unbox ()
instance M.MVector MVector () where
basicLength (MV_Unit n) = n
basicUnsafeSlice i m (MV_Unit n) = MV_Unit m
basicOverlaps _ _ = False
basicUnsafeNew n = return (MV_Unit n)
basicUnsafeRead (MV_Unit _) _ = return ()
basicUnsafeWrite (MV_Unit _) _ () = return ()
basicClear _ = return ()
basicSet (MV_Unit _) () = return ()
basicUnsafeCopy (MV_Unit _) (MV_Unit _) = return ()
basicUnsafeGrow (MV_Unit n) m = return $ MV_Unit (n+m)
instance G.Vector Vector () where
basicUnsafeFreeze (MV_Unit n) = return $ V_Unit n
basicUnsafeThaw (V_Unit n) = return $ MV_Unit n
basicLength (V_Unit n) = n
basicUnsafeSlice i m (V_Unit n) = V_Unit m
basicUnsafeIndexM (V_Unit _) i = return ()
basicUnsafeCopy (MV_Unit _) (V_Unit _) = return ()
elemseq _ = seq
#define primMVector(ty,con) \
instance M.MVector MVector ty where { \
\
; \
; \
; \
; \
; \
; \
; \
; \
; \
; \
; basicLength (con v) = M.basicLength v \
; basicUnsafeSlice i n (con v) = con $ M.basicUnsafeSlice i n v \
; basicOverlaps (con v1) (con v2) = M.basicOverlaps v1 v2 \
; basicUnsafeNew n = con `liftM` M.basicUnsafeNew n \
; basicUnsafeReplicate n x = con `liftM` M.basicUnsafeReplicate n x \
; basicUnsafeRead (con v) i = M.basicUnsafeRead v i \
; basicUnsafeWrite (con v) i x = M.basicUnsafeWrite v i x \
; basicClear (con v) = M.basicClear v \
; basicSet (con v) x = M.basicSet v x \
; basicUnsafeCopy (con v1) (con v2) = M.basicUnsafeCopy v1 v2 \
; basicUnsafeMove (con v1) (con v2) = M.basicUnsafeMove v1 v2 \
; basicUnsafeGrow (con v) n = con `liftM` M.basicUnsafeGrow v n }
#define primVector(ty,con,mcon) \
instance G.Vector Vector ty where { \
\
; \
; \
; \
; \
; \
; basicUnsafeFreeze (mcon v) = con `liftM` G.basicUnsafeFreeze v \
; basicUnsafeThaw (con v) = mcon `liftM` G.basicUnsafeThaw v \
; basicLength (con v) = G.basicLength v \
; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v \
; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i \
; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v \
; elemseq _ = seq }
newtype instance MVector s Int = MV_Int (P.MVector s Int)
newtype instance Vector Int = V_Int (P.Vector Int)
instance Unbox Int
primMVector(Int, MV_Int)
primVector(Int, V_Int, MV_Int)
newtype instance MVector s Int8 = MV_Int8 (P.MVector s Int8)
newtype instance Vector Int8 = V_Int8 (P.Vector Int8)
instance Unbox Int8
primMVector(Int8, MV_Int8)
primVector(Int8, V_Int8, MV_Int8)
newtype instance MVector s Int16 = MV_Int16 (P.MVector s Int16)
newtype instance Vector Int16 = V_Int16 (P.Vector Int16)
instance Unbox Int16
primMVector(Int16, MV_Int16)
primVector(Int16, V_Int16, MV_Int16)
newtype instance MVector s Int32 = MV_Int32 (P.MVector s Int32)
newtype instance Vector Int32 = V_Int32 (P.Vector Int32)
instance Unbox Int32
primMVector(Int32, MV_Int32)
primVector(Int32, V_Int32, MV_Int32)
newtype instance MVector s Int64 = MV_Int64 (P.MVector s Int64)
newtype instance Vector Int64 = V_Int64 (P.Vector Int64)
instance Unbox Int64
primMVector(Int64, MV_Int64)
primVector(Int64, V_Int64, MV_Int64)
newtype instance MVector s Word = MV_Word (P.MVector s Word)
newtype instance Vector Word = V_Word (P.Vector Word)
instance Unbox Word
primMVector(Word, MV_Word)
primVector(Word, V_Word, MV_Word)
newtype instance MVector s Word8 = MV_Word8 (P.MVector s Word8)
newtype instance Vector Word8 = V_Word8 (P.Vector Word8)
instance Unbox Word8
primMVector(Word8, MV_Word8)
primVector(Word8, V_Word8, MV_Word8)
newtype instance MVector s Word16 = MV_Word16 (P.MVector s Word16)
newtype instance Vector Word16 = V_Word16 (P.Vector Word16)
instance Unbox Word16
primMVector(Word16, MV_Word16)
primVector(Word16, V_Word16, MV_Word16)
newtype instance MVector s Word32 = MV_Word32 (P.MVector s Word32)
newtype instance Vector Word32 = V_Word32 (P.Vector Word32)
instance Unbox Word32
primMVector(Word32, MV_Word32)
primVector(Word32, V_Word32, MV_Word32)
newtype instance MVector s Word64 = MV_Word64 (P.MVector s Word64)
newtype instance Vector Word64 = V_Word64 (P.Vector Word64)
instance Unbox Word64
primMVector(Word64, MV_Word64)
primVector(Word64, V_Word64, MV_Word64)
newtype instance MVector s Float = MV_Float (P.MVector s Float)
newtype instance Vector Float = V_Float (P.Vector Float)
instance Unbox Float
primMVector(Float, MV_Float)
primVector(Float, V_Float, MV_Float)
newtype instance MVector s Double = MV_Double (P.MVector s Double)
newtype instance Vector Double = V_Double (P.Vector Double)
instance Unbox Double
primMVector(Double, MV_Double)
primVector(Double, V_Double, MV_Double)
newtype instance MVector s Char = MV_Char (P.MVector s Char)
newtype instance Vector Char = V_Char (P.Vector Char)
instance Unbox Char
primMVector(Char, MV_Char)
primVector(Char, V_Char, MV_Char)
fromBool :: Bool -> Word8
fromBool True = 1
fromBool False = 0
toBool :: Word8 -> Bool
toBool 0 = False
toBool _ = True
newtype instance MVector s Bool = MV_Bool (P.MVector s Word8)
newtype instance Vector Bool = V_Bool (P.Vector Word8)
instance Unbox Bool
instance M.MVector MVector Bool where
basicLength (MV_Bool v) = M.basicLength v
basicUnsafeSlice i n (MV_Bool v) = MV_Bool $ M.basicUnsafeSlice i n v
basicOverlaps (MV_Bool v1) (MV_Bool v2) = M.basicOverlaps v1 v2
basicUnsafeNew n = MV_Bool `liftM` M.basicUnsafeNew n
basicUnsafeReplicate n x = MV_Bool `liftM` M.basicUnsafeReplicate n (fromBool x)
basicUnsafeRead (MV_Bool v) i = toBool `liftM` M.basicUnsafeRead v i
basicUnsafeWrite (MV_Bool v) i x = M.basicUnsafeWrite v i (fromBool x)
basicClear (MV_Bool v) = M.basicClear v
basicSet (MV_Bool v) x = M.basicSet v (fromBool x)
basicUnsafeCopy (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeCopy v1 v2
basicUnsafeMove (MV_Bool v1) (MV_Bool v2) = M.basicUnsafeMove v1 v2
basicUnsafeGrow (MV_Bool v) n = MV_Bool `liftM` M.basicUnsafeGrow v n
instance G.Vector Vector Bool where
basicUnsafeFreeze (MV_Bool v) = V_Bool `liftM` G.basicUnsafeFreeze v
basicUnsafeThaw (V_Bool v) = MV_Bool `liftM` G.basicUnsafeThaw v
basicLength (V_Bool v) = G.basicLength v
basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v
basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i
basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v
elemseq _ = seq
newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a))
newtype instance Vector (Complex a) = V_Complex (Vector (a,a))
instance (RealFloat a, Unbox a) => Unbox (Complex a)
instance (RealFloat a, Unbox a) => M.MVector MVector (Complex a) where
basicLength (MV_Complex v) = M.basicLength v
basicUnsafeSlice i n (MV_Complex v) = MV_Complex $ M.basicUnsafeSlice i n v
basicOverlaps (MV_Complex v1) (MV_Complex v2) = M.basicOverlaps v1 v2
basicUnsafeNew n = MV_Complex `liftM` M.basicUnsafeNew n
basicUnsafeReplicate n (x :+ y) = MV_Complex `liftM` M.basicUnsafeReplicate n (x,y)
basicUnsafeRead (MV_Complex v) i = uncurry (:+) `liftM` M.basicUnsafeRead v i
basicUnsafeWrite (MV_Complex v) i (x :+ y) = M.basicUnsafeWrite v i (x,y)
basicClear (MV_Complex v) = M.basicClear v
basicSet (MV_Complex v) (x :+ y) = M.basicSet v (x,y)
basicUnsafeCopy (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeCopy v1 v2
basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2
basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n
instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where
basicUnsafeFreeze (MV_Complex v) = V_Complex `liftM` G.basicUnsafeFreeze v
basicUnsafeThaw (V_Complex v) = MV_Complex `liftM` G.basicUnsafeThaw v
basicLength (V_Complex v) = G.basicLength v
basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v
basicUnsafeIndexM (V_Complex v) i
= uncurry (:+) `liftM` G.basicUnsafeIndexM v i
basicUnsafeCopy (MV_Complex mv) (V_Complex v)
= G.basicUnsafeCopy mv v
elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x
$ G.elemseq (undefined :: Vector a) y z
#define DEFINE_INSTANCES
#include "unbox-tuple-instances"