#include "fusion-phases.h"
module Data.Array.Parallel.PArray
( PArray, PA
, valid
, nf
, empty
, singleton, singletonl
, replicate, replicatel, replicates, replicates'
, append, appendl
, concat, concatl
, unconcat
, nestUSegd
, length, lengthl
, index, indexl
, extract, extracts, extracts'
, slice, slicel
, takeUSegd
, pack, packl
, packByTag
, combine2
, enumFromTo, enumFromTol
, zip, zipl
, zip3
, zip4
, zip5
, unzip, unzipl
, fromVector, toVector
, fromList, toList
, fromUArray, toUArray
, fromUArray2)
where
import qualified Data.Array.Parallel.Pretty as T
import Data.Array.Parallel.PArray.PData
import Data.Array.Parallel.PArray.PRepr
import Data.Array.Parallel.PArray.Scalar
import Data.Array.Parallel.PArray.Reference
import GHC.Exts
import Data.Vector (Vector)
import Data.Array.Parallel.Base (Tag)
import qualified Data.Array.Parallel.Array as A
import qualified Data.Array.Parallel.Unlifted as U
import qualified Data.Vector as V
import qualified "dph-lifted-base" Data.Array.Parallel.PArray as R
import qualified "dph-lifted-base" Data.Array.Parallel.PArray.Reference as R
import qualified Prelude as P
import Prelude hiding
( length, replicate, concat
, enumFromTo
, zip, zip3, unzip)
instance PA a => T.PprPhysical (PArray a) where
pprp (PArray n# pdata)
= ( T.text "PArray " T.<+> T.int (I# n#))
T.$+$ ( T.nest 4
$ pprpDataPA pdata)
instance PA a => Similar a where
similar = similarPA
instance PA a => R.PprPhysical1 a where
pprp1 = pprpPA
trace :: String -> a -> a
trace _str x
= x
instance PA e => A.Array PArray e where
valid = valid
singleton = singleton
append = append
length = length
index (PArray _ pdata) ix
= indexPA pdata ix
toVector arr = V.map (A.index arr) $ V.enumFromTo 0 (A.length arr 1)
fromVector = fromVector
instance (Eq a, PA a) => Eq (PArray a) where
(==) (PArray _ xs) (PArray _ ys) = toVectorPA xs == toVectorPA ys
(/=) (PArray _ xs) (PArray _ ys) = toVectorPA xs /= toVectorPA ys
valid :: PA a => PArray a -> Bool
valid (PArray n# darr1)
= trace "valid"
$ validPA darr1
&& coversPA True darr1 (I# n#)
nf :: PA a => PArray a -> ()
nf (PArray _ d)
= trace "nf"
$ nfPA d
empty :: PA a => PArray a
empty
= withRef1 "empty" R.empty
$ PArray 0# emptyPA
singleton :: PA a => a -> PArray a
singleton x
= withRef1 "singleton" (R.singleton x)
$ PArray 1# (replicatePA 1 x)
singletonl :: PA a => PArray a -> PArray (PArray a)
singletonl arr
= withRef2 "singletonl" (R.singletonl (toRef1 arr))
$ replicatel_ (replicate_ (length arr) 1) arr
replicate :: PA a => Int -> a -> PArray a
replicate n x
= withRef1 "replicate" (R.replicate n x)
$ replicate_ n x
replicate_ :: PA a => Int -> a -> PArray a
replicate_ (I# n#) x
= PArray n# (replicatePA (I# n#) x)
replicatel :: PA a => PArray Int -> PArray a -> PArray (PArray a)
replicatel reps arr
= withRef2 "replicatel" (R.replicatel (toRef1 reps) (toRef1 arr))
$ replicatel_ reps arr
replicatel_ :: PA a => PArray Int -> PArray a -> PArray (PArray a)
replicatel_ (PArray n# (PInt lens)) (PArray _ pdata)
= if n# ==# 0# then empty else
let !segd = U.lengthsToSegd lens
!vsegd = U.promoteSegdToVSegd segd
!pdata' = replicatesPA segd pdata
!pdatas' = singletondPA pdata'
in PArray n# $ mkPNestedPA vsegd pdatas' segd pdata'
replicates :: PA a => U.Segd -> PArray a -> PArray a
replicates segd arr@(PArray _ pdata)
= trace (T.render $ T.text "!!! replicates " T.$+$ T.pprp segd T.$+$ T.pprp arr)
$ withRef1 "replicates" (R.replicates segd (toRef1 arr))
$ let !(I# n#) = U.elementsSegd segd
in PArray n# $ replicatesPA segd pdata
replicates' :: PA a => PArray Int -> PArray a -> PArray a
replicates' (PArray _ (PInt reps)) arr
= trace "replicates'"
$ replicates (U.lengthsToSegd reps) arr
append :: PA a => PArray a -> PArray a -> PArray a
append arr1@(PArray n1# darr1) arr2@(PArray n2# darr2)
= withRef1 "append" (R.append (toRef1 arr1) (toRef1 arr2))
$ PArray (n1# +# n2#) (appendPA darr1 darr2)
appendl :: PA a => PArray (PArray a) -> PArray (PArray a) -> PArray (PArray a)
appendl arr1@(PArray n# pdata1) arr2@(PArray _ pdata2)
= withRef2 "appendl" (R.appendl (toRef2 arr1) (toRef2 arr2))
$ PArray n# $ appendlPA pdata1 pdata2
concat :: PA a => PArray (PArray a) -> PArray a
concat arr@(PArray _ darr)
= withRef1 "concat" (R.concat (toRef2 arr))
$ let darr' = concatPA darr
!(I# n#) = lengthPA darr'
in PArray n# darr'
concatl :: PA a => PArray (PArray (PArray a)) -> PArray (PArray a)
concatl arr@(PArray n# pdata1)
= withRef2 "concatl" (R.concatl (toRef3 arr))
$ PArray n# $ concatlPA pdata1
unconcat :: (PA a, PA b) => PArray (PArray a) -> PArray b -> PArray (PArray b)
unconcat (PArray n# pdata1) (PArray _ pdata2)
= trace "! unconcat"
$ PArray n# $ unconcatPA pdata1 pdata2
nestUSegd :: PA a => U.Segd -> PArray a -> PArray (PArray a)
nestUSegd segd (PArray n# pdata)
| U.elementsSegd segd == I# n#
, I# n2# <- U.lengthSegd segd
= PArray n2#
$ PNested (U.promoteSegdToVSegd segd) (singletondPA pdata) segd pdata
| otherwise
= error $ unlines
[ "Data.Array.Parallel.PArray.nestUSegd: number of elements defined by "
++ "segment descriptor and data array do not match"
, " length of segment desciptor = " ++ show (U.elementsSegd segd)
, " length of data array = " ++ show (I# n#) ]
lengthl :: PA a => PArray (PArray a) -> PArray Int
lengthl arr@(PArray n# (PNested vsegd _ _ _))
= withRef1 "lengthl" (R.lengthl (toRef2 arr))
$ PArray n# $ PInt $ U.takeLengthsOfVSegd vsegd
index :: PA a => PArray a -> Int -> a
index (PArray _ arr) ix
= trace "index"
$ indexPA arr ix
indexl :: PA a => PArray (PArray a) -> PArray Int -> PArray a
indexl (PArray n# darr) (PArray _ ixs)
= trace "indexl"
$ PArray n# (indexlPA darr ixs)
extract :: PA a => PArray a -> Int -> Int -> PArray a
extract (PArray _ arr) start len@(I# len#)
= trace "extract"
$ PArray len# (extractPA arr start len)
extracts :: PA a => Vector (PArray a) -> U.SSegd -> PArray a
extracts arrs ssegd
= trace "extracts"
$ let pdatas = fromVectordPA $ V.map (\(PArray _ vec) -> vec) arrs
!(I# n#) = (U.sum $ U.lengthsOfSSegd ssegd)
in PArray n#
(extractssPA pdatas ssegd)
extracts'
:: PA a
=> Vector (PArray a)
-> PArray Int
-> PArray Int
-> PArray Int
-> PArray a
extracts' arrs (PArray _ (PInt sources)) (PArray _ (PInt starts)) (PArray _ (PInt lengths))
= trace "extracts'"
$ let segd = U.lengthsToSegd lengths
ssegd = U.mkSSegd starts sources segd
in extracts arrs ssegd
slice :: PA a => Int -> Int -> PArray a -> PArray a
slice start len@(I# len#) (PArray _ darr)
= trace "slice"
$ PArray len# (extractPA darr start len)
slicel :: PA a => PArray Int -> PArray Int -> PArray (PArray a) -> PArray (PArray a)
slicel (PArray n# sliceStarts) (PArray _ sliceLens) (PArray _ darr)
= trace "slicel"
$ PArray n# (slicelPA sliceStarts sliceLens darr)
takeUSegd :: PArray (PArray a) -> U.Segd
takeUSegd (PArray _ pdata)
= trace "takeUSegd"
$ takeSegdPD pdata
pack :: PA a => PArray a -> PArray Bool -> PArray a
pack arr@(PArray _ xs) flags@(PArray _ (PBool sel2))
= withRef1 "pack" (R.pack (toRef1 arr) (toRef1 flags))
$ let darr' = packByTagPA xs (U.tagsSel2 sel2) 1
!(I# m#) = U.elementsSel2_1 sel2
in PArray m# darr'
packl :: PA a => PArray (PArray a) -> PArray (PArray Bool) -> PArray (PArray a)
packl xss@(PArray n# xdata@(PNested _ _ segd _))
fss@(PArray _ fdata)
= withRef2 "packl" (R.packl (toRef2 xss) (toRef2 fss))
$ let
xdata_flat = concatPA xdata
PBool sel = concatPA fdata
tags = U.tagsSel2 sel
segd' = U.lengthsToSegd $ U.count_s segd tags 1
vsegd' = U.promoteSegdToVSegd segd'
flat' = packByTagPA xdata_flat tags 1
pdatas' = singletondPA flat'
in PArray n# (PNested vsegd' pdatas' segd' flat')
packByTag :: PA a => PArray a -> U.Array Tag -> Tag -> PArray a
packByTag arr@(PArray _ darr) tags tag
= withRef1 "packByTag" (R.packByTag (toRef1 arr) tags tag)
$ let darr' = packByTagPA darr tags tag
!(I# n#) = lengthPA darr'
in PArray n# darr'
combine2 :: forall a. PA a => U.Sel2 -> PArray a -> PArray a -> PArray a
combine2 sel arr1@(PArray _ darr1) arr2@(PArray _ darr2)
= withRef1 "combine2" (R.combine2 sel (toRef1 arr1) (toRef1 arr2))
$ let darr' = combine2PA sel darr1 darr2
!(I# n#) = lengthPA darr'
in PArray n# darr'
zip :: PArray a -> PArray b -> PArray (a, b)
zip (PArray n# pdata1) (PArray _ pdata2)
= trace "zip"
$ PArray n# $ zipPD pdata1 pdata2
zipl :: (PA a, PA b)
=> PArray (PArray a) -> PArray (PArray b) -> PArray (PArray (a, b))
zipl (PArray n# xs) (PArray _ ys)
= trace "zipl"
$ PArray n# $ ziplPA xs ys
zip3 :: PArray a -> PArray b -> PArray c -> PArray (a, b, c)
zip3 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3)
= trace "zip3"
$ PArray n# $ zip3PD pdata1 pdata2 pdata3
zip4 :: PArray a -> PArray b -> PArray c -> PArray d -> PArray (a, b, c, d)
zip4 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3) (PArray _ pdata4)
= trace "zip4"
$ PArray n# $ zip4PD pdata1 pdata2 pdata3 pdata4
zip5 :: PArray a -> PArray b -> PArray c -> PArray d -> PArray e -> PArray (a, b, c, d, e)
zip5 (PArray n# pdata1) (PArray _ pdata2) (PArray _ pdata3) (PArray _ pdata4) (PArray _ pdata5)
= trace "zip5"
$ PArray n# $ zip5PD pdata1 pdata2 pdata3 pdata4 pdata5
unzip :: PArray (a, b) -> (PArray a, PArray b)
unzip (PArray n# (PTuple2 xs ys))
= trace "unzip"
$ (PArray n# xs, PArray n# ys)
unzipl :: PArray (PArray (a, b)) -> PArray (PArray a, PArray b)
unzipl (PArray n# pdata)
= trace "unzipl"
$ PArray n# $ unziplPD pdata
fromVector :: PA a => Vector a -> PArray a
fromVector vec
= trace "fromVector"
$ let !(I# n#) = V.length vec
in PArray n# (fromVectorPA vec)
toVector :: PA a => PArray a -> Vector a
toVector (PArray _ arr)
= trace "toVector"
$ toVectorPA arr
fromList :: PA a => [a] -> PArray a
fromList xx
= trace "fromList"
$ let !(I# n#) = P.length xx
in PArray n# (fromVectorPA $ V.fromList xx)
toList :: PA a => PArray a -> [a]
toList (PArray _ arr)
= trace "toList"
$ V.toList $ toVectorPA arr