#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif
module Data.Vector.Mixed.Internal
( MVector(..), mboxed, munboxed
, Vector(..), boxed, unboxed
, Mixed(..)
) where
import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Foldable
import Data.Traversable
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.Mutable as BM
import qualified Data.Vector.Storable as S
import qualified Data.Vector.Primitive as P
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Hybrid as H
import Data.Vector.Fusion.Stream as Stream
import Data.Data
import Prelude hiding ( length, null, replicate, reverse, map, read, take, drop, init, tail )
import Text.Read
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707
#define Typeable2 Typeable
#define Typeable1 Typeable
#endif
class
( Typeable2 mv
, Typeable1 v
, mv ~ G.Mutable v
, GM.MVector mv a
, G.Vector v a
) => Mixed mv v a | mv -> v, v -> mv where
mmix :: mv s a -> MVector s a
mmix = MV
mix :: v a -> Vector a
mix = V
instance Mixed B.MVector B.Vector a
instance S.Storable a => Mixed S.MVector S.Vector a
instance P.Prim a => Mixed P.MVector P.Vector a
instance U.Unbox a => Mixed U.MVector U.Vector a
instance (Mixed u v a, Mixed u' v' b) => Mixed (H.MVector u u') (H.Vector v v') (a, b)
instance Mixed MVector Vector a where
mmix = id
mix = id
data MVector :: * -> * -> * where
MV :: Mixed mv v a => !(mv s a) -> MVector s a
deriving Typeable
munboxed :: U.Unbox a => U.MVector s a -> MVector s a
munboxed = MV
mboxed :: BM.MVector s a -> MVector s a
mboxed = MV
unboxed :: U.Unbox a => U.Vector a -> Vector a
unboxed = V
boxed :: B.Vector a -> Vector a
boxed = V
newtype Id a = Id { runId :: a }
cast2 :: (Typeable2 p, Typeable2 q) => p a b -> Maybe (q a b)
cast2 x = runId <$> gcast2 (Id x)
instance GM.MVector MVector a where
basicLength (MV ks) = GM.basicLength ks
basicUnsafeSlice s e (MV ks) = MV (GM.basicUnsafeSlice s e ks)
basicOverlaps (MV as) (MV bs) = case cast2 as of
Nothing -> True
Just cs -> GM.basicOverlaps cs bs
basicUnsafeNew n = liftM mboxed (GM.basicUnsafeNew n)
basicUnsafeReplicate n k = liftM mboxed (GM.basicUnsafeReplicate n k)
basicUnsafeRead (MV ks) n = GM.basicUnsafeRead ks n
basicUnsafeWrite (MV ks) n k = GM.basicUnsafeWrite ks n k
basicClear (MV ks) = GM.basicClear ks
basicSet (MV ks) k = GM.basicSet ks k
basicUnsafeCopy (MV dst) (MV src) = case cast2 dst of
Nothing -> go 0
Just dst' -> GM.basicUnsafeCopy dst' src
where
n = GM.basicLength src
go i
| i < n = do
x <- GM.basicUnsafeRead src i
GM.basicUnsafeWrite dst i x
go (i+1)
| otherwise = return ()
basicUnsafeMove (MV dst) (MV src) = case cast2 dst of
Just dst' -> GM.basicUnsafeMove dst' src
Nothing -> do
srcCopy <- GM.munstream (GM.mstream src)
GM.basicUnsafeCopy dst srcCopy
basicUnsafeGrow (MV ks) n = liftM MV (GM.basicUnsafeGrow ks n)
data Vector :: * -> * where
V :: Mixed mv v a => !(v a) -> Vector a
deriving Typeable
type instance G.Mutable Vector = MVector
instance G.Vector Vector a where
basicUnsafeFreeze (MV ks) = liftM V (G.basicUnsafeFreeze ks)
basicUnsafeThaw (V ks) = liftM MV (G.basicUnsafeThaw ks)
basicLength (V ks) = G.basicLength ks
basicUnsafeSlice i j (V ks) = V (G.basicUnsafeSlice i j ks)
basicUnsafeIndexM (V ks) n = G.basicUnsafeIndexM ks n
basicUnsafeCopy (MV dst) (V src) = case cast2 dst of
Just dst' -> G.basicUnsafeCopy dst' src
Nothing -> go 0
where
!n = G.basicLength src
go i
| i < n = do
x <- G.basicUnsafeIndexM src i
GM.basicUnsafeWrite dst i x
go (i+1)
| otherwise = return ()
elemseq (V ks) k b = G.elemseq ks k b
instance Monoid (Vector a) where
mappend = (G.++)
mempty = G.empty
mconcat = G.concat
instance Show a => Show (Vector a) where
showsPrec = G.showsPrec
instance Read a => Read (Vector a) where
readPrec = G.readPrec
readListPrec = readListPrecDefault
instance Data a => Data (Vector a) where
gfoldl = G.gfoldl
toConstr _ = error "toConstr"
gunfold _ _ = error "gunfold"
dataTypeOf _ = G.mkType "Data.Vector.Mixed.Vector"
dataCast1 = G.dataCast
instance Eq a => Eq (Vector a) where
xs == ys = Stream.eq (G.stream xs) (G.stream ys)
xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))
instance Ord a => Ord (Vector a) where
compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)
xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT
xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT
xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT
xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT
instance Functor Vector where
fmap = G.map
instance Monad Vector where
return = G.singleton
(>>=) = flip G.concatMap
instance MonadPlus Vector where
mzero = G.empty
mplus = (G.++)
instance Applicative Vector where
pure = G.singleton
(<*>) = ap
instance Alternative Vector where
empty = G.empty
(<|>) = (G.++)
instance Foldable Vector where
foldr = G.foldr
foldl = G.foldl
foldr1 = G.foldr1
foldl1 = G.foldl1
instance Traversable Vector where
traverse f v = G.fromListN (G.length v) <$> traverse f (G.toList v)