#include "fusion-phases.h"
module Data.Array.Parallel.Unlifted.Sequential.Vector (
Unbox,
Vector, MVector,
stream, unstream,
length, null, empty, singleton, cons, units,
replicate,
(!), (++),
interleave, indexed, repeat, repeatS,
slice, extract,
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,
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.Stream
import Data.Array.Parallel.Base ( Tag, checkEq, ST )
import Data.Vector.Unboxed hiding ( slice, zip, unzip, foldl, foldl1, scanl, scanl1 )
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as M
import qualified Data.Vector.Unboxed.Base as VBase
import Data.Vector.Generic ( stream, unstream )
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 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,
enumFromTo, enumFromThenTo )
import qualified Prelude
import qualified System.Random as R
import Foreign hiding ( new )
import System.IO
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 => Vector a -> Int -> Int -> Vector a
slice xs i n = V.slice i n xs
extract :: Unbox a => Vector a -> Int -> Int -> Vector a
extract xs i n = force (V.slice 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
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)