#ifndef MIN_VERSION_vector
#define MIN_VERSION_vector(x,y,z) 1
#endif
module Data.Vector.Vinyl.Default.Internal
( MVector(..)
, MVectorVal(..)
, Vector(..)
, HasDefaultVector(..)
) where
import Control.Monad
import Data.Monoid
import Data.Typeable (Typeable)
import GHC.Exts (Constraint)
import Control.Monad.Primitive (PrimMonad,PrimState)
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Generic as G
import qualified Data.Vector as B
import qualified Data.Vector.Unboxed as U
#if MIN_VERSION_vector(0,11,0)
import Data.Vector.Fusion.Bundle as Stream
#else
import Data.Vector.Fusion.Stream as Stream
#endif
import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, init, tail )
import Text.Read
import Data.Proxy
import Data.Vinyl.Core(Rec(..))
import Data.Vinyl.Functor (Identity(..))
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
class ( GM.MVector (G.Mutable (DefaultVector t)) t
, G.Vector (DefaultVector t) t
) => HasDefaultVector t where
type DefaultVector t :: * -> *
instance HasDefaultVector Int where
type DefaultVector Int = U.Vector
instance HasDefaultVector Char where
type DefaultVector Char = U.Vector
instance HasDefaultVector Bool where
type DefaultVector Bool = U.Vector
instance HasDefaultVector Float where
type DefaultVector Float = U.Vector
instance HasDefaultVector Double where
type DefaultVector Double = U.Vector
instance HasDefaultVector Text.Text where
type DefaultVector Text.Text = B.Vector
instance HasDefaultVector LText.Text where
type DefaultVector LText.Text = B.Vector
instance G.Vector Vector (Rec Identity rs)
=> HasDefaultVector (Rec Identity rs) where
type DefaultVector (Rec Identity rs) = Vector
newtype MVectorVal s t = MVectorVal { getMVectorVal :: G.Mutable (DefaultVector t) s t }
data MVector :: * -> * -> * where
MV :: !Int -> !(Rec (MVectorVal s) rs) -> MVector s (Rec Identity rs)
deriving Typeable
instance GM.MVector MVector (Rec Identity '[]) where
basicLength (MV i _) = i
basicUnsafeSlice _ _ v = v
basicOverlaps _ _ = False
basicUnsafeNew n = return (MV n RNil)
basicUnsafeReplicate n _ = return (MV n RNil)
basicUnsafeRead _ _ = return RNil
basicUnsafeWrite _ _ _ = return ()
basicClear _ = return ()
basicSet _ _ = return ()
basicUnsafeCopy _ _ = return ()
basicUnsafeMove _ _ = return ()
basicUnsafeGrow (MV i _) n = return (MV (i + n) RNil)
#if MIN_VERSION_vector(0,11,0)
basicInitialize _ = return ()
#endif
instance ( GM.MVector MVector (Rec Identity rs)
, HasDefaultVector r
)
=> GM.MVector MVector (Rec Identity (r ': rs)) where
basicLength (MV i _) = i
basicUnsafeSlice s e (MV i (MVectorVal v :& rs)) = case GM.basicUnsafeSlice s e (MV i rs) of
MV _ rsNext -> MV e (MVectorVal (GM.basicUnsafeSlice s e v) :& rsNext)
basicOverlaps (MV i (MVectorVal a :& as)) (MV j (MVectorVal b :& bs)) =
GM.basicOverlaps a b || GM.basicOverlaps (MV i as) (MV j bs)
basicUnsafeNew :: forall m. PrimMonad m => Int -> m (MVector (PrimState m) (Rec Identity (r ': rs)))
basicUnsafeNew n =
consVec (Proxy :: Proxy m) n <$> GM.basicUnsafeNew n <*> GM.basicUnsafeNew n
basicUnsafeReplicate :: forall m. PrimMonad m => Int -> Rec Identity (r ': rs) -> m (MVector (PrimState m) (Rec Identity (r ': rs)))
basicUnsafeReplicate n (Identity v :& rs) =
consVec (Proxy :: Proxy m) n <$> GM.basicUnsafeReplicate n v <*> GM.basicUnsafeReplicate n rs
basicUnsafeRead (MV i (MVectorVal v :& rs)) n = do
r <- GM.basicUnsafeRead v n
rs <- GM.basicUnsafeRead (MV i rs) n
return (Identity r :& rs)
basicUnsafeWrite (MV i (MVectorVal v :& vrs)) n (Identity r :& rs) = do
GM.basicUnsafeWrite v n r
GM.basicUnsafeWrite (MV i vrs) n rs
basicClear (MV i (MVectorVal v :& vrs)) = do
GM.basicClear v
GM.basicClear (MV i vrs)
basicSet (MV i (MVectorVal v :& vrs)) (Identity r :& rs) = do
GM.basicSet v r
GM.basicSet (MV i vrs) rs
basicUnsafeCopy (MV i (MVectorVal a :& as)) (MV j (MVectorVal b :& bs)) = do
GM.basicUnsafeCopy a b
GM.basicUnsafeCopy (MV i as) (MV j bs)
basicUnsafeMove (MV i (MVectorVal a :& as)) (MV j (MVectorVal b :& bs)) = do
GM.basicUnsafeMove a b
GM.basicUnsafeMove (MV i as) (MV j bs)
basicUnsafeGrow :: forall m. PrimMonad m => MVector (PrimState m) (Rec Identity (r ': rs)) -> Int -> m (MVector (PrimState m) (Rec Identity (r ': rs)))
basicUnsafeGrow (MV i (MVectorVal v :& vrs)) n = do
r <- GM.basicUnsafeGrow v n
rs <- GM.basicUnsafeGrow (MV i vrs) n
return (MV (i + n) (MVectorVal r :& stripMV (Proxy :: Proxy m) rs))
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV i (MVectorVal v :& rs)) = do
GM.basicInitialize v
GM.basicInitialize (MV i rs)
#endif
newtype VectorVal t = VectorVal { getVectorVal :: DefaultVector t t }
data Vector :: * -> * where
V :: !Int -> !(Rec VectorVal rs) -> Vector (Rec Identity rs)
deriving Typeable
type instance G.Mutable Vector = MVector
instance G.Vector Vector (Rec Identity '[]) where
basicUnsafeFreeze (MV n _) = return (V n RNil)
basicUnsafeThaw (V i _) = return (MV i RNil)
basicLength (V i _) = i
basicUnsafeSlice _ e _ = V e RNil
basicUnsafeIndexM _ n = return RNil
basicUnsafeCopy _ _ = return ()
elemseq _ RNil b = b
instance ( G.Vector Vector (Rec Identity rs)
, HasDefaultVector r
)
=> G.Vector Vector (Rec Identity (r ': rs)) where
basicUnsafeFreeze (MV i (MVectorVal v :& vrs)) = do
r <- G.basicUnsafeFreeze v
rs <- G.basicUnsafeFreeze (MV i vrs)
return (V i (VectorVal r :& stripV rs))
basicUnsafeThaw :: forall m. PrimMonad m => Vector (Rec Identity (r ': rs)) -> m (G.Mutable Vector (PrimState m) (Rec Identity (r ': rs)))
basicUnsafeThaw (V i (VectorVal v :& vrs)) = do
r <- G.basicUnsafeThaw v
rs <- G.basicUnsafeThaw (V i vrs)
return (MV i (MVectorVal r :& stripMV (Proxy :: Proxy m) rs))
basicLength (V i _) = i
basicUnsafeSlice s e (V i (VectorVal v :& rs)) = case G.basicUnsafeSlice s e (V i rs) of
V _ rsNext -> V e (VectorVal (G.basicUnsafeSlice s e v) :& rsNext)
basicUnsafeIndexM (V i (VectorVal v :& vrs)) n = do
r <- G.basicUnsafeIndexM v n
rs <- G.basicUnsafeIndexM (V i vrs) n
return (Identity r :& rs)
basicUnsafeCopy (MV i (MVectorVal m :& mrs)) (V j (VectorVal v :& vrs)) = do
G.basicUnsafeCopy m v
G.basicUnsafeCopy (MV i mrs) (V j vrs)
elemseq (V i (VectorVal v :& vrs)) (Identity a :& rs) b = G.elemseq v a (G.elemseq (V i vrs) rs b)
consVec :: Proxy m
-> Int
-> G.Mutable (DefaultVector r) (PrimState m) r
-> MVector (PrimState m) (Rec Identity rs)
-> MVector (PrimState m) (Rec Identity (r ': rs))
consVec _ n v (MV _ rs) = MV n (MVectorVal v :& rs)
stripMV :: Proxy m -> MVector (PrimState m) (Rec Identity rs) -> Rec (MVectorVal (PrimState m)) rs
stripMV _ (MV _ rs) = rs
stripV :: Vector (Rec Identity rs) -> Rec VectorVal rs
stripV (V _ rs) = rs