#include "fusion-phases.h"
module Data.Array.Parallel.Unlifted.Sequential.Vector (
Unbox,
Vector, MVector,
stream, unstream,
length, null, empty, singleton, cons, units,
replicate,
(++), index,
interleave, indexed, repeat, repeatS,
slice, unsafeSlice,
extract, unsafeExtract,
tail,
take, drop, splitAt,
permute,
bpermute,
mbpermute,
bpermuteDft,
reverse,
update,
map, zipWith, zipWith3,
filter, pack,
combine, combine2ByTag,
foldl, foldl1, foldl1Maybe,
fold, fold1, fold1Maybe,
scanl, scanl1,
scan, scan1,
scanRes,
elem, notElem,
and, or, any, all,
sum, product,
maximum, minimum,
maximumBy, minimumBy,
maxIndex, minIndex,
maxIndexBy, minIndexBy,
zip, unzip, fsts, snds,
zip3, unzip3,
enumFromTo,
enumFromThenTo,
enumFromStepLen,
enumFromToEach,
enumFromStepLenEach,
find, findIndex,
toList, fromList,
random, randomR,
new, copy,
newM, unsafeFreeze, M.write, M.read, mpermute, mupdate,
mdrop, mslice,
UIO(..)
)
where
import Data.Array.Parallel.Unlifted.Stream.Segmented
import Data.Array.Parallel.Base ( Tag, checkEq, ST )
import qualified Data.Array.Parallel.Base as B
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as M
import qualified Data.Vector.Unboxed.Base as VBase
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as MG
import qualified Data.Vector.Storable as Storable
import qualified Data.Vector.Storable.Mutable as MStorable
import qualified Data.Vector.Generic.New as New
import qualified Data.Vector.Fusion.Stream as S
import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) )
import Data.Vector.Fusion.Stream.Size ( Size(..) )
import Data.Vector.Generic ( stream, unstream )
import Data.Vector.Unboxed
hiding ( slice, zip, unzip, zip3, unzip3, foldl, foldl1, scanl, scanl1,
unsafeSlice )
import Prelude
hiding ( length, null,
replicate, (++), repeat,
tail, take, drop, splitAt,
reverse,
map, zipWith, zipWith3, filter,
foldl, foldl1, scanl, scanl1,
elem, notElem,
and, or, any, all,
sum, product,
maximum, minimum,
zip, unzip, zip3, unzip3,
enumFromTo, enumFromThenTo )
import qualified Prelude
import qualified System.Random as R
import Foreign hiding ( new )
import System.IO
import Control.Monad
here s = "Data.Array.Parallel.Unlifted.Sequential.Flat." Prelude.++ s
new :: Unbox a => Int -> (forall s. MVector s a -> ST s ()) -> Vector a
new n p
= V.create
$ do v <- M.new n
p v
return v
newM :: Unbox a => Int -> ST s (MVector s a)
newM = M.new
units :: Int -> Vector ()
units n = replicate n ()
interleave :: Unbox e => Vector e -> Vector e -> Vector e
interleave xs ys = unstream (interleaveS (stream xs) (stream ys))
repeat :: Unbox e => Int -> Vector e -> Vector e
repeat n xs = unstream (repeatS n xs)
repeatS :: Unbox e => Int -> Vector e -> S.Stream e
repeatS k !xs = Stream next (0,k) (Exact (k*n))
where
!n = length xs
next (i,0) = return Done
next (i,k) | i == n = return $ Skip (0,k1)
| otherwise = return $ Yield (unsafeIndex xs i) (i+1,k)
slice :: Unbox a => String -> Vector a -> Int -> Int -> Vector a
slice here xs i n
= B.checkSlice here (V.length xs) i n
$ V.slice i n xs
unsafeSlice :: Unbox a => Vector a -> Int -> Int -> Vector a
unsafeSlice xs i n = V.unsafeSlice i n xs
index :: Unbox a => String -> Vector a -> Int -> a
index here vec ix
= B.check here (V.length vec) ix
$ V.unsafeIndex vec ix
extract :: Unbox a => Vector a -> Int -> Int -> Vector a
extract xs i n
= force (V.slice i n xs)
unsafeExtract :: Unbox a => Vector a -> Int -> Int -> Vector a
unsafeExtract xs i n = force (V.unsafeSlice i n xs)
mupdate :: Unbox e => MVector s e -> Vector (Int,e) -> ST s ()
mupdate marr xs
= MG.update marr (stream xs)
mpermute :: Unbox e => MVector s e -> Vector e -> Vector Int -> ST s ()
mpermute marr xs is
= MG.update marr (stream (zip is xs))
permute :: Unbox e => Vector e -> Vector Int -> Vector e
permute xs is
= create
$ do v <- M.new (length xs)
mpermute v xs is
return v
bpermute :: Unbox e => Vector e -> Vector Int -> Vector e
bpermute = backpermute
mbpermute :: (Unbox e, Unbox d) => (e -> d) -> Vector e -> Vector Int -> Vector d
mbpermute f es is
= unstream (mbpermuteS f es (stream is))
bpermuteS :: Unbox e => Vector e -> S.Stream Int -> S.Stream e
bpermuteS !a s
= S.map (a!) s
mbpermuteS:: Unbox e => (e -> d) -> Vector e -> S.Stream Int -> S.Stream d
mbpermuteS f !a
= S.map (f . (a!))
bpermuteDft :: Unbox e
=> Int
-> (Int -> e)
-> Vector (Int,e)
-> Vector e
bpermuteDft n init
= update (map init (enumFromN 0 n))
pack:: Unbox e => Vector e -> Vector Bool -> Vector e
pack xs = map fst . filter snd . zip xs
combine :: Unbox a
=> Vector Bool -> Vector a -> Vector a -> Vector a
combine bs
= combine2ByTag (map (\b -> if b then 0 else 1) bs)
combine2ByTag :: Unbox a => Vector Tag -> Vector a -> Vector a -> Vector a
combine2ByTag ts xs ys
= checkEq (here "combine2ByTag")
("tags length /= sum of args length")
(length ts) (length xs + length ys)
$ unstream (combine2ByTagS (stream ts) (stream xs) (stream ys))
foldl :: Unbox a => (b -> a -> b) -> b -> Vector a -> b
foldl = foldl'
foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a
foldl1 = foldl1'
fold :: Unbox a => (a -> a -> a) -> a -> Vector a -> a
fold = foldl
fold1 :: Unbox a => (a -> a -> a) -> Vector a -> a
fold1 = foldl1
foldl1Maybe :: Unbox a => (a -> a -> a) -> Vector a -> Maybe a
foldl1Maybe f xs = foldl' join Nothing xs
where
join Nothing y = Just $! y
join (Just x) y = Just $! f x y
fold1Maybe :: Unbox a => (a -> a -> a) -> Vector a -> Maybe a
fold1Maybe = foldl1Maybe
scanl :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Vector a -> Vector b
scanl = prescanl'
scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a
scanl1 = scanl1'
scan :: Unbox a => (a -> a -> a) -> a -> Vector a -> Vector a
scan = scanl
scan1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a
scan1 = scanl1
scanRes :: Unbox a => (a -> a -> a) -> a -> Vector a -> (Vector a,a)
scanRes f z xs
= let ys = scanl' f z xs
in (unsafeInit ys, unsafeLast ys)
fsts :: (Unbox a, Unbox b) => Vector (a,b) -> Vector a
fsts (VBase.V_2 _ xs ys) = xs
snds :: (Unbox a, Unbox b) => Vector (a,b) -> Vector b
snds (VBase.V_2 _ xs ys) = ys
zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a,b)
zip !xs !ys = V.zip xs ys
unzip :: (Unbox a, Unbox b) => Vector (a,b) -> (Vector a, Vector b)
unzip ps = V.unzip ps
zip3 :: (Unbox a, Unbox b, Unbox c)
=> Vector a -> Vector b -> Vector c -> Vector (a,b,c)
zip3 !xs !ys !zs
= V.zip3 xs ys zs
unzip3 :: (Unbox a, Unbox b, Unbox c)
=> Vector (a,b,c) -> (Vector a, Vector b, Vector c)
unzip3 ps = V.unzip3 ps
enumFromStepLen :: Int -> Int -> Int -> Vector Int
enumFromStepLen = enumFromStepN
enumFromToEach :: Int -> Vector (Int,Int) -> Vector Int
enumFromToEach n
= unstream . enumFromToEachS n . stream
enumFromStepLenEach :: Int -> Vector Int -> Vector Int -> Vector Int -> Vector Int
enumFromStepLenEach len starts steps lens
= unstream
$ enumFromStepLenEachS len
$ stream
$ V.zip3 starts steps lens
random :: (Unbox a, R.Random a, R.RandomGen g) => Int -> g -> Vector a
random n = unstream . randomS n
randomR :: (Unbox a, R.Random a, R.RandomGen g) => Int -> (a,a) -> g -> Vector a
randomR n r = unstream . randomRS n r
randomS :: (R.RandomGen g, R.Random a) => Int -> g -> S.Stream a
randomS n g
= Stream step (g,n) (Exact n)
where
step (g,0) = return Done
step (g,n) = let (x,g') = R.random g
in return $ Yield x (g',n1)
randomRS :: (R.RandomGen g, R.Random a) => Int -> (a,a) -> g -> S.Stream a
randomRS n r g
= Stream step (g,n) (Exact n)
where
step (g,0) = return Done
step (g,n) = let (x,g') = R.randomR r g
in return $ Yield x (g',n1)
mdrop :: Unbox a => Int -> MVector s a -> MVector s a
mdrop = M.drop
mslice :: Unbox a => Int -> Int -> MVector s a -> MVector s a
mslice = M.slice
hGetStorable
:: forall a. Storable a
=> Handle -> IO (Storable.Vector a)
hGetStorable h =
alloca $ \iptr ->
do
hGetBuf h iptr (sizeOf (undefined :: Int))
n <- peek iptr
v <- MStorable.unsafeNew n
let bytes = sizeOf (undefined :: a) * MStorable.length v
r <- MStorable.unsafeWith v $ \ptr -> hGetBuf h ptr bytes
Storable.unsafeFreeze (MStorable.take r v)
hPutStorable
:: forall a. Storable a
=> Handle -> Storable.Vector a -> IO ()
hPutStorable h xs =
alloca $ \iptr ->
do
poke iptr n
hPutBuf h iptr (sizeOf n)
Storable.unsafeWith xs $ \ptr ->
do
hPutBuf h ptr (sizeOf (undefined :: a) * n)
return ()
where
!n = Storable.length xs
class Unbox a => UIO a where
hPut :: Handle -> Vector a -> IO ()
hGet :: Handle -> IO (Vector a)
primPut :: (Unbox a, Storable a) => Handle -> Vector a -> IO ()
primPut h = hPutStorable h . Storable.convert
primGet :: (Unbox a, Storable a) => Handle -> IO (Vector a)
primGet = fmap convert . hGetStorable
instance UIO Int where
hPut = primPut
hGet = primGet
instance UIO Double where
hPut = primPut
hGet = primGet
instance (UIO a, UIO b) => UIO (a,b) where
hPut h xs = case V.unzip xs of
(ys,zs) -> do hPut h ys
hPut h zs
hGet h = do xs <- hGet h
ys <- hGet h
return (V.zip xs ys)
newtype instance MVector s Ordering = MV_Ordering (M.MVector s Word8)
newtype instance Vector Ordering = V_Ordering (V.Vector Word8)
instance Unbox Ordering
instance MG.MVector MVector Ordering where
basicLength (MV_Ordering v)
= MG.basicLength v
basicUnsafeSlice i n (MV_Ordering v)
= MV_Ordering $ MG.basicUnsafeSlice i n v
basicOverlaps (MV_Ordering v1) (MV_Ordering v2)
= MG.basicOverlaps v1 v2
basicUnsafeNew n
= MV_Ordering `liftM` MG.basicUnsafeNew n
basicUnsafeReplicate n x
= MV_Ordering `liftM` MG.basicUnsafeReplicate n (fromOrdering x)
basicUnsafeRead (MV_Ordering v) i
= toOrdering `liftM` MG.basicUnsafeRead v i
basicUnsafeWrite (MV_Ordering v) i x
= MG.basicUnsafeWrite v i (fromOrdering x)
basicClear (MV_Ordering v)
= MG.basicClear v
basicSet (MV_Ordering v) x
= MG.basicSet v (fromOrdering x)
basicUnsafeCopy (MV_Ordering v1) (MV_Ordering v2)
= MG.basicUnsafeCopy v1 v2
basicUnsafeMove (MV_Ordering v1) (MV_Ordering v2)
= MG.basicUnsafeMove v1 v2
basicUnsafeGrow (MV_Ordering v) n
= MV_Ordering `liftM` MG.basicUnsafeGrow v n
instance G.Vector Vector Ordering where
basicUnsafeFreeze (MV_Ordering v)
= V_Ordering `liftM` G.basicUnsafeFreeze v
basicUnsafeThaw (V_Ordering v)
= MV_Ordering `liftM` G.basicUnsafeThaw v
basicLength (V_Ordering v)
= G.basicLength v
basicUnsafeSlice i n (V_Ordering v)
= V_Ordering $ G.basicUnsafeSlice i n v
basicUnsafeIndexM (V_Ordering v) i
= toOrdering `liftM` G.basicUnsafeIndexM v i
basicUnsafeCopy (MV_Ordering mv) (V_Ordering v)
= G.basicUnsafeCopy mv v
elemseq _ = seq
fromOrdering :: Ordering -> Word8
fromOrdering LT = 0
fromOrdering EQ = 1
fromOrdering GT = 2
toOrdering :: Word8 -> Ordering
toOrdering 0 = LT
toOrdering 1 = EQ
toOrdering _ = GT
instance Unbox Integer
instance MG.MVector MVector Integer
instance G.Vector Vector Integer