Modify and export regular folds
[packages/dph.git] / dph-prim-seq / Data / Array / Parallel / Unlifted / Sequential / Segmented / Combinators.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators
4 -- Copyright : (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
5 -- (c) 2006 Manuel M T Chakravarty & Roman Leshchinskiy
6 -- License : see libraries/ndp/LICENSE
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Stability : internal
10 -- Portability : portable
11 --
12 -- Description ---------------------------------------------------------------
13 --
14 -- Standard combinators for segmented unlifted arrays.
15 --
16 -- Todo ----------------------------------------------------------------------
17 --
18
19 {-# LANGUAGE CPP #-}
20
21 #include "fusion-phases.h"
22
23 module Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators (
24 foldlSU, foldSU, foldl1SU, fold1SU, {-scanSU,-} {-scan1SU,-}
25 foldlRU,
26 combineSU
27 ) where
28
29 import Data.Array.Parallel.Base (
30 sndS)
31 import Data.Array.Parallel.Stream (
32 foldSS, fold1SS, combineSS, foldValuesR )
33 import Data.Array.Parallel.Unlifted.Sequential.Flat (
34 UA, UArr, mapU, zipWithU,
35 unstreamU, streamU)
36 import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd
37
38 import Debug.Trace
39
40 -- |Segmented array reduction proceeding from the left
41 --
42 foldlSU :: (UA a, UA b) => (b -> a -> b) -> b -> USegd -> UArr a -> UArr b
43 {-# INLINE_U foldlSU #-}
44 foldlSU f z segd !xs = unstreamU
45 $ foldSS f z (streamU (lengthsUSegd segd)) (streamU xs)
46
47 -- |Segmented array reduction that requires an associative combination
48 -- function with its unit
49 --
50 foldSU :: UA a => (a -> a -> a) -> a -> USegd -> UArr a -> UArr a
51 foldSU = foldlSU
52
53 -- |Segmented array reduction from left to right with non-empty subarrays only
54 --
55 foldl1SU :: UA a => (a -> a -> a) -> USegd -> UArr a -> UArr a
56 {-# INLINE_U foldl1SU #-}
57 foldl1SU f segd xs = unstreamU
58 $ fold1SS f (streamU (lengthsUSegd segd)) (streamU xs)
59
60 -- |Segmented array reduction with non-empty subarrays and an associative
61 -- combination function
62 --
63 fold1SU :: UA a => (a -> a -> a) -> USegd -> UArr a -> UArr a
64 fold1SU = foldl1SU
65
66
67 -- |Merge two segmented arrays according to flag array
68 --
69 combineSU :: UA a => UArr Bool -> USegd -> UArr a -> USegd -> UArr a -> UArr a
70 {-# INLINE_U combineSU #-}
71 combineSU bs xd xs yd ys = unstreamU
72 $ combineSS (streamU bs)
73 (streamU (lengthsUSegd xd)) (streamU xs)
74 (streamU (lengthsUSegd yd)) (streamU ys)
75
76 {-
77 combineCU:: UA e => UArr Bool -> SUArr e -> SUArr e -> SUArr e
78 {-# INLINE combineCU #-}
79 combineCU flags xssArr1 xssArr2 = trace "combineCU"
80 newSegd >: flatData
81 where
82 newLengths = combineU flags (lengthsSU xssArr1) (lengthsSU xssArr2)
83 newSegd = lengthsToUSegd newLengths
84 repFlags = replicateSU newSegd flags
85 flatData = combineU (concatSU repFlags) (concatSU xssArr1) (concatSU xssArr2)
86
87 packCU:: (UA e) => UArr Bool -> SUArr e -> SUArr e
88 {-# INLINE packCU #-}
89 packCU flags xssArr = segmentArrU newLengths flatData
90 where
91 repFlags = concatSU $ replicateSU (segdSU xssArr) flags
92 flatData = packU (concatSU xssArr) repFlags
93 newLengths = packU (lengthsSU xssArr) flags
94 -}
95
96 -- | Regular arrar reduction
97 --
98
99 foldlRU :: (UA a, UA b) => (b -> a -> b) -> b -> Int -> UArr a -> UArr b
100 {-# INLINE_U foldlRU #-}
101 foldlRU f z segSize = unstreamU . foldValuesR f z segSize . streamU
102