#include "fusion-phases.h"
module Data.Array.Parallel.Lifted.Instances (
PData(..),
dPA_Int, dPR_Int,
dPA_Word8, dPR_Word8,
dPA_Double, dPR_Double,
dPA_Bool,
dPA_Unit, dPA_2, dPA_3, dPA_4, dPA_5,
dPA_PArray
) where
import Data.Array.Parallel.Lifted.PArray
import Data.Array.Parallel.Lifted.Repr
import Data.Array.Parallel.Lifted.Unboxed ( elementsSegd# )
import Data.Array.Parallel.Lifted.Selector
import qualified Data.Array.Parallel.Unlifted as U
import GHC.Exts ( Int#, Int(..), (+#), (*#),
Double#, Double(..) )
import GHC.Word ( Word8(..) )
newtype instance PData Int = PInt (U.Array Int)
type instance PRepr Int = Int
dPA_Int :: PA Int
dPA_Int = PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_Int
}
dPR_Int :: PR Int
dPR_Int = PR {
emptyPR = emptyPR_Int
, replicatePR = replicatePR_Int
, replicatelPR = replicatelPR_Int
, repeatPR = repeatPR_Int
, repeatcPR = repeatcPR_Int
, indexPR = indexPR_Int
, bpermutePR = bpermutePR_Int
, extractPR = extractPR_Int
, appPR = appPR_Int
, applPR = applPR_Int
, packPR = packPR_Int
, combine2PR = combine2PR_Int
, fromListPR = fromListPR_Int
, nfPR = nfPR_Int
}
emptyPR_Int = PInt U.empty
replicatePR_Int n# i = PInt (U.replicate (I# n#) i)
replicatelPR_Int segd (PInt xs) = PInt (U.replicate_s segd xs)
repeatPR_Int n# len# (PInt xs) = PInt (U.repeat (I# n#) (I# len#) xs)
repeatcPR_Int n# ns segd (PInt xs) = PInt (U.repeat_c (I# n#) ns segd xs)
indexPR_Int (PInt xs) i# = xs U.!: I# i#
extractPR_Int (PInt xs) i# n# = PInt (U.extract xs (I# i#) (I# n#))
bpermutePR_Int :: T_bpermutePR Int
bpermutePR_Int (PInt xs) _ is = PInt (U.bpermute xs is)
appPR_Int (PInt xs) (PInt ys) = PInt (xs U.+:+ ys)
applPR_Int xsegd (PInt xs) ysegd (PInt ys)
= PInt (U.append_s xsegd xs ysegd ys)
packPR_Int :: T_packPR Int
packPR_Int (PInt ns) n# bs = PInt (U.pack ns bs)
combine2PR_Int :: T_combine2PR Int
combine2PR_Int n# sel (PInt xs) (PInt ys)
= PInt (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
fromListPR_Int :: T_fromListPR Int
fromListPR_Int n# xs = PInt (U.fromList xs)
nfPR_Int (PInt xs) = xs `seq` ()
newtype instance PData Word8 = PWord8 (U.Array Word8)
type instance PRepr Word8 = Word8
dPA_Word8 :: PA Word8
dPA_Word8 = PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_Word8
}
dPR_Word8 :: PR Word8
dPR_Word8 = PR {
emptyPR = emptyPR_Word8
, replicatePR = replicatePR_Word8
, replicatelPR = replicatelPR_Word8
, repeatPR = repeatPR_Word8
, repeatcPR = repeatcPR_Word8
, indexPR = indexPR_Word8
, extractPR = extractPR_Word8
, bpermutePR = bpermutePR_Word8
, appPR = appPR_Word8
, applPR = applPR_Word8
, packPR = packPR_Word8
, combine2PR = combine2PR_Word8
, fromListPR = fromListPR_Word8
, nfPR = nfPR_Word8
}
emptyPR_Word8 = PWord8 U.empty
replicatePR_Word8 n# i = PWord8 (U.replicate (I# n#) i)
replicatelPR_Word8 segd (PWord8 xs) = PWord8 (U.replicate_s segd xs)
repeatPR_Word8 n# len# (PWord8 xs) = PWord8 (U.repeat (I# n#) (I# len#) xs)
repeatcPR_Word8 n# ns segd (PWord8 xs) = PWord8 (U.repeat_c (I# n#) ns segd xs)
indexPR_Word8 (PWord8 xs) i# = xs U.!: I# i#
extractPR_Word8 (PWord8 xs) i# n# = PWord8 (U.extract xs (I# i#) (I# n#))
bpermutePR_Word8 :: T_bpermutePR Word8
bpermutePR_Word8 (PWord8 xs) _ is = PWord8 (U.bpermute xs is)
appPR_Word8 (PWord8 xs) (PWord8 ys) = PWord8 (xs U.+:+ ys)
applPR_Word8 xsegd (PWord8 xs) ysegd (PWord8 ys)
= PWord8 (U.append_s xsegd xs ysegd ys)
packPR_Word8 :: T_packPR Word8
packPR_Word8 (PWord8 ns) n# bs = PWord8 (U.pack ns bs)
combine2PR_Word8 :: T_combine2PR Word8
combine2PR_Word8 n# sel (PWord8 xs) (PWord8 ys)
= PWord8 (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
fromListPR_Word8 :: T_fromListPR Word8
fromListPR_Word8 n# xs = PWord8 (U.fromList xs)
nfPR_Word8 (PWord8 xs) = xs `seq` ()
newtype instance PData Double = PDouble (U.Array Double)
type instance PRepr Double = Double
dPA_Double :: PA Double
dPA_Double = PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_Double
}
dPR_Double :: PR Double
dPR_Double = PR {
emptyPR = emptyPR_Double
, replicatePR = replicatePR_Double
, replicatelPR = replicatelPR_Double
, repeatPR = repeatPR_Double
, repeatcPR = repeatcPR_Double
, indexPR = indexPR_Double
, extractPR = extractPR_Double
, bpermutePR = bpermutePR_Double
, appPR = appPR_Double
, applPR = applPR_Double
, packPR = packPR_Double
, combine2PR = combine2PR_Double
, fromListPR = fromListPR_Double
, nfPR = nfPR_Double
}
emptyPR_Double = PDouble U.empty
replicatePR_Double n# i = PDouble (U.replicate (I# n#) i)
replicatelPR_Double segd (PDouble xs) = PDouble (U.replicate_s segd xs)
repeatPR_Double n# len# (PDouble xs) = PDouble (U.repeat (I# n#) (I# len#) xs)
repeatcPR_Double n# ns segd (PDouble xs) = PDouble (U.repeat_c (I# n#) ns segd xs)
indexPR_Double (PDouble xs) i# = xs U.!: I# i#
extractPR_Double (PDouble xs) i# n# = PDouble (U.extract xs (I# i#) (I# n#))
bpermutePR_Double :: T_bpermutePR Double
bpermutePR_Double (PDouble xs) _ is = PDouble (U.bpermute xs is)
appPR_Double (PDouble xs) (PDouble ys) = PDouble (xs U.+:+ ys)
applPR_Double xsegd (PDouble xs) ysegd (PDouble ys)
= PDouble (U.append_s xsegd xs ysegd ys)
packPR_Double :: T_packPR Double
packPR_Double (PDouble ns) n# bs = PDouble (U.pack ns bs)
combine2PR_Double :: T_combine2PR Double
combine2PR_Double n# sel (PDouble xs) (PDouble ys)
= PDouble (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
fromListPR_Double :: T_fromListPR Double
fromListPR_Double n# xs = PDouble (U.fromList xs)
nfPR_Double (PDouble xs) = xs `seq` ()
data instance PData Bool
= PBool Sel2
type instance PRepr Bool = Sum2 Void Void
dPA_Bool :: PA Bool
dPA_Bool = PA {
toPRepr = toPRepr_Bool
, fromPRepr = fromPRepr_Bool
, toArrPRepr = toArrPRepr_Bool
, fromArrPRepr = fromArrPRepr_Bool
, dictPRepr = dPR_Sum2 dPR_Void dPR_Void
}
toPRepr_Bool False = Alt2_1 void
toPRepr_Bool True = Alt2_2 void
fromPRepr_Bool (Alt2_1 _) = False
fromPRepr_Bool (Alt2_2 _) = True
toArrPRepr_Bool (PBool sel) = PSum2 sel pvoid pvoid
fromArrPRepr_Bool (PSum2 sel _ _) = PBool sel
type instance PRepr () = ()
dPA_Unit :: PA ()
dPA_Unit = PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_Unit
}
type instance PRepr (a,b) = (a,b)
dPA_2 :: PA a -> PA b -> PA (a,b)
dPA_2 pa pb = PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_2 (mkPR pa) (mkPR pb)
}
type instance PRepr (a,b,c) = (a,b,c)
dPA_3 :: PA a -> PA b -> PA c -> PA (a,b,c)
dPA_3 pa pb pc
= PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_3 (mkPR pa) (mkPR pb) (mkPR pc)
}
type instance PRepr (a,b,c,d) = (a,b,c,d)
dPA_4 :: PA a -> PA b -> PA c -> PA d -> PA (a,b,c,d)
dPA_4 pa pb pc pd
= PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_4 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd)
}
type instance PRepr (a,b,c,d,e) = (a,b,c,d,e)
dPA_5 :: PA a -> PA b -> PA c -> PA d -> PA e -> PA (a,b,c,d,e)
dPA_5 pa pb pc pd pe
= PA {
toPRepr = id
, fromPRepr = id
, toArrPRepr = id
, fromArrPRepr = id
, dictPRepr = dPR_5 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd) (mkPR pe)
}
type instance PRepr (PArray a) = PArray (PRepr a)
dPA_PArray :: PA a -> PA (PArray a)
dPA_PArray pa
= PA {
toPRepr = toPArrayPRepr pa
, fromPRepr = fromPArrayPRepr pa
, toArrPRepr = toNestedPRepr pa
, fromArrPRepr = fromNestedPRepr pa
, dictPRepr = dPR_PArray (dictPRepr pa)
}
toPArrayPRepr pa (PArray n# xs) = PArray n# (toArrPRepr pa xs)
fromPArrayPRepr pa (PArray n# xs) = PArray n# (fromArrPRepr pa xs)
toNestedPRepr pa (PNested segd xs) = PNested segd (toArrPRepr pa xs)
fromNestedPRepr pa (PNested segd xs) = PNested segd (fromArrPRepr pa xs)