dph-prim-seq 0.5.1.1 → 0.6.0.1

raw patch · 25 files changed

+3168/−606 lines, 25 filesdep +ghc-primdep +primitivedep ~basedep ~dph-basedep ~dph-prim-interfacePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim, primitive

Dependency ranges changed: base, dph-base, dph-prim-interface, vector

API changes (from Hackage documentation)

Files

• Data/Array/Parallel/Unlifted.hs +193/−81
• Data/Array/Parallel/Unlifted/ArrayArray.hs +115/−0
• Data/Array/Parallel/Unlifted/Sequential.hs +46/−0
• Data/Array/Parallel/Unlifted/Sequential/Basics.hs +61/−0
• Data/Array/Parallel/Unlifted/Sequential/Combinators.hs +123/−0
• Data/Array/Parallel/Unlifted/Sequential/Extracts.hs +78/−0
• Data/Array/Parallel/Unlifted/Sequential/Segmented.hs +0/−27
• Data/Array/Parallel/Unlifted/Sequential/Segmented/Basics.hs +0/−48
• Data/Array/Parallel/Unlifted/Sequential/Segmented/Combinators.hs +0/−56
• Data/Array/Parallel/Unlifted/Sequential/Segmented/Sums.hs +0/−50
• Data/Array/Parallel/Unlifted/Sequential/Segmented/Text.hs +0/−11
• Data/Array/Parallel/Unlifted/Sequential/Segmented/USegd.hs +0/−137
• Data/Array/Parallel/Unlifted/Sequential/Sums.hs +55/−0
• Data/Array/Parallel/Unlifted/Sequential/USSegd.hs +293/−0
• Data/Array/Parallel/Unlifted/Sequential/USegd.hs +181/−0
• Data/Array/Parallel/Unlifted/Sequential/USel.hs +38/−59
• Data/Array/Parallel/Unlifted/Sequential/UVSegd.hs +510/−0
• Data/Array/Parallel/Unlifted/Sequential/Vector.hs +308/−121
• Data/Array/Parallel/Unlifted/Stream.hs +18/−0
• Data/Array/Parallel/Unlifted/Stream/Elems.hs +79/−0
• Data/Array/Parallel/Unlifted/Stream/Ixs.hs +61/−0
• Data/Array/Parallel/Unlifted/Stream/Segmented.hs +541/−0
• Data/Array/Parallel/Unlifted/Stream/Segments.hs +222/−0
• Data/Array/Parallel/Unlifted/Vectors.hs +211/−0
• dph-prim-seq.cabal +35/−16

@@ -1,97 +1,209 @@ {-# LANGUAGE CPP #-}---- | Primitive sequential combinators that work on flat, unlifted arrays.------   This set of combinators is used when the program is compiled with @-fdph-seq@.---   When compiling with @-fdph-par@, the ones in the @dph-prim-par package@ are used---   instead. The @dph-prim-par package@ exports the same names, but all combinators---   are implemented sequentially.+{-# OPTIONS -fno-warn-missing-signatures #-}+-- | Sequential implementation of the segmented array API defined in +--   @dph-prim-interface@.  --+--   There is a parallel implementation in @dph-prim-par@, +--   so you probably want that instead.+ --   The API is defined in @DPH_Header.h@ and @DPH_Interface.h@ to ensure that both --   @dph-prim-par@ and @dph-prim-seq@ really do export the same symbols.- #include "DPH_Header.h"--import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as V import Data.Array.Parallel.Unlifted.Sequential.USel-import Data.Array.Parallel.Unlifted.Sequential.Segmented-+import Data.Array.Parallel.Unlifted.Sequential+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd   as USegd+import qualified Data.Array.Parallel.Unlifted.Sequential.USSegd  as USSegd+import qualified Data.Array.Parallel.Unlifted.Sequential.UVSegd  as UVSegd+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector  as U+import qualified Data.Array.Parallel.Unlifted.Vectors            as US #include "DPH_Interface.h" -class V.Unbox a => Elt a-type Array              = V.Vector-type Segd               = USegd-type Sel2               = USel2-type SelRep2            = ()+-- NOTE:+-- See DPH_Interface.h for documentation. +-- The defs should appear in the same order as they are listed in DPH_Interface.h -length                  = V.length-empty                   = V.empty-replicate               = V.replicate-repeat n _              = V.repeat n-(!:)                    = (V.!)-extract                 = V.extract-drop                    = V.drop-permute                 = V.permute-bpermute                = V.bpermute-mbpermute               = V.mbpermute-bpermuteDft             = V.bpermuteDft-update                  = V.update-(+:+)                   = (V.++)-interleave              = V.interleave-pack                    = V.pack-combine                 = V.combine-combine2 tags _         = V.combine2ByTag tags-map                     = V.map-filter                  = V.filter-zip                     = V.zip-unzip                   = V.unzip-fsts                    = V.fsts-snds                    = V.snds-zipWith                 = V.zipWith-fold                    = V.fold-fold1                   = V.fold1-and                     = V.and-sum                     = V.sum-scan                    = V.scan-indexed                 = V.indexed-enumFromTo              = V.enumFromTo-enumFromThenTo          = V.enumFromThenTo-enumFromStepLen         = V.enumFromStepLen-enumFromStepLenEach     = V.enumFromStepLenEach -mkSel2 tags idxs n0 n1 _ = mkUSel2 tags idxs n0 n1-tagsSel2                = tagsUSel2-indicesSel2             = indicesUSel2-elementsSel2_0          = elementsUSel2_0-elementsSel2_1          = elementsUSel2_1-repSel2 _               = ()+-- Basics ---------------------------------------------------------------------+class U.Unbox a => Elt a -mkSelRep2 tags          = ()-indicesSelRep2 tags _   = tagsToIndices2 tags-elementsSelRep2_0 tags _ = count tags 0-elementsSelRep2_1 tags _ = count tags 1+-- | Arrays are stored as unboxed vectors. +--   They have bulk-strict semantics, so demanding one element demands them all.+type Array                      = U.Vector -replicate_s             = replicateSU-replicate_rs            = replicateRSU-append_s _              = appendSU-fold_s                  = foldSU-fold1_s                 = fold1SU-fold_r                  = foldlRU-sum_r                   = sumRU -indices_s               = indicesSU+-- Constructors ---------------------------------------------------------------+empty                           = U.empty+(+:+)                           = (U.++)+append_s _                      = appendSU+replicate                       = U.replicate+replicate_s                     = replicateSU+replicate_rs                    = replicateRSU+repeat n _                      = U.repeat n+indexed                         = U.indexed+indices_s                       = indicesSU+enumFromTo                      = U.enumFromTo+enumFromThenTo                  = U.enumFromThenTo+enumFromStepLen                 = U.enumFromStepLen+enumFromStepLenEach             = U.enumFromStepLenEach -lengthSegd              = lengthUSegd-lengthsSegd             = lengthsUSegd-indicesSegd             = indicesUSegd-elementsSegd            = elementsUSegd-mkSegd                  = mkUSegd-randoms                 = V.random-randomRs                = V.randomR -class V.UIO a => IOElt a-hPut                    = V.hPut-hGet                    = V.hGet-toList                  = V.toList-fromList                = V.fromList+-- Projections ----------------------------------------------------------------+length                          = U.length+index                           = U.index+indexs                          = indexsFromVector+indexs_avs                      = indexsFromVectorsUVSegd++extract                         = U.extract+extracts_nss                    = extractsFromNestedUSSegd+extracts_ass                    = extractsFromVectorsUSSegd+extracts_avs                    = extractsFromVectorsUVSegd+drop                            = U.drop+++-- Update ---------------------------------------------------------------------+update                          = U.update+++-- Permutation ----------------------------------------------------------------+permute                         = U.permute+bpermute                        = U.bpermute+mbpermute                       = U.mbpermute+bpermuteDft                     = U.bpermuteDft+++-- Zipping and Unzipping ------------------------------------------------------+zip                             = U.zip+zip3                            = U.zip3+unzip                           = U.unzip+unzip3                          = U.unzip3+fsts                            = U.fsts+snds                            = U.snds+++-- Map and ZipWith ------------------------------------------------------------+map                             = U.map+zipWith                         = U.zipWith+++-- Scans and Folds ------------------------------------------------------------+scan                            = U.scan+fold                            = U.fold+fold_s                          = foldSU+fold_ss                         = foldSSU+fold_r                          = foldlRU+fold1                           = U.fold1+fold1_s                         = fold1SU+fold1_ss                        = fold1SSU+sum                             = U.sum+sum_r                           = sumRU+and                             = U.and+++-- Packing and Filter ---------------------------------------------------------+pack                            = U.pack+filter                          = U.filter+++-- Combine and Interleave -----------------------------------------------------+combine                         = U.combine+combine2 tags _                 = U.combine2ByTag tags+interleave                      = U.interleave+++-- Selectors ------------------------------------------------------------------+type Sel2                       = USel2+mkSel2 tags idxs n0 n1 _        = mkUSel2 tags idxs n0 n1+tagsSel2                        = tagsUSel2+indicesSel2                     = indicesUSel2+elementsSel2_0                  = elementsUSel2_0+elementsSel2_1                  = elementsUSel2_1+repSel2 _                       = ()++type SelRep2                    = ()+mkSelRep2 _                     = ()+indicesSelRep2 tags _           = tagsToIndices2 tags+elementsSelRep2_0 tags _        = count tags 0+elementsSelRep2_1 tags _        = count tags 1+++-- Segment Descriptors --------------------------------------------------------+type Segd                       = USegd.USegd+mkSegd                          = USegd.mkUSegd+validSegd                       = USegd.valid+emptySegd                       = USegd.empty+singletonSegd                   = USegd.singleton+lengthSegd                      = USegd.length+lengthsSegd                     = USegd.takeLengths+indicesSegd                     = USegd.takeIndices+elementsSegd                    = USegd.takeElements+++-- Slice Segment Descriptors --------------------------------------------------+type SSegd                      = USSegd.USSegd+mkSSegd                         = USSegd.mkUSSegd+validSSegd                      = USSegd.valid+emptySSegd                      = USSegd.empty+singletonSSegd                  = USSegd.singleton+promoteSegdToSSegd              = USSegd.fromUSegd+isContiguousSSegd               = USSegd.isContiguous+lengthOfSSegd                   = USSegd.length+lengthsOfSSegd                  = USSegd.takeLengths+indicesOfSSegd                  = USSegd.takeIndices+startsOfSSegd                   = USSegd.takeStarts+sourcesOfSSegd                  = USSegd.takeSources+getSegOfSSegd                   = USSegd.getSeg+appendSSegd                     = USSegd.appendWith+++-- Virtual Segment Descriptors ------------------------------------------------+type VSegd                      = UVSegd.UVSegd+mkVSegd                         = UVSegd.mkUVSegd+validVSegd                      = UVSegd.valid+emptyVSegd                      = UVSegd.empty+singletonVSegd                  = UVSegd.singleton+replicatedVSegd                 = UVSegd.replicated+promoteSegdToVSegd              = UVSegd.fromUSegd+promoteSSegdToVSegd             = UVSegd.fromUSSegd+isManifestVSegd                 = UVSegd.isManifest+isContiguousVSegd               = UVSegd.isContiguous+lengthOfVSegd                   = UVSegd.length+takeVSegidsOfVSegd              = UVSegd.takeVSegids+takeVSegidsRedundantOfVSegd     = UVSegd.takeVSegids+takeSSegdOfVSegd                = UVSegd.takeUSSegd+takeSSegdRedundantOfVSegd       = UVSegd.takeUSSegd+takeLengthsOfVSegd              = UVSegd.takeLengths+getSegOfVSegd                   = UVSegd.getSeg+unsafeDemoteToSSegdOfVSegd      = UVSegd.unsafeDemoteToUSSegd+unsafeDemoteToSegdOfVSegd       = UVSegd.unsafeDemoteToUSegd+updateVSegsOfVSegd              = UVSegd.updateVSegs+updateVSegsReachableOfVSegd     = UVSegd.updateVSegsReachable+appendVSegd                     = UVSegd.appendWith+combine2VSegd                   = UVSegd.combine2+++-- Irregular 2D Arrays --------------------------------------------------------+class US.Unboxes a => Elts a+type Arrays                     = US.Vectors+emptys                          = US.empty+lengths                         = US.length+singletons                      = US.singleton+unsafeIndexs                    = US.unsafeIndex+unsafeIndex2s                   = US.unsafeIndex2+appends                         = US.append+fromVectors                     = US.fromVector+toVectors                       = US.toVector+++-- Random Arrays --------------------------------------------------------------+randoms                         = U.random+randomRs                        = U.randomR+++-- Array IO -------------------------------------------------------------------+class U.UIO a => IOElt a+hPut                            = U.hPut+hGet                            = U.hGet++toList                          = U.toList+fromList                        = U.fromList 

@@ -0,0 +1,115 @@++-- | Irregular 2D unboxed arrays.+--+--   The difference between this type and something like +--   @Data.Vector (Data.Vector.Unboxed a)@ is that the inner arrays have kind+--   @#@ and cannot be bottom. This ensures that we can always lookup an element+--   from an `ArrayArray#` without performing unboxings or checking for thunks.+---+--   TODO: move this into the Data.Primitive library.+module Data.Array.Parallel.Unlifted.ArrayArray+        ( MutableArrayArray (..)+        , ArrayArray(..)+        , newArrayArray+        , writeArrayArrayMut+        , writeArrayArray+        , readArrayArray+        , indexArrayArray+        , unsafeFreezeArrayArray+        , unsafeDeepFreezeArrayArray+        , copyArrayArray)+where	+import GHC.Prim+import GHC.Base+import GHC.ST+import Data.Primitive.ByteArray+++data MutableArrayArray s e +        = MutableArrayArray (MutableArrayArray# s)++data ArrayArray e +        = ArrayArray ArrayArray#+++-- | Create an `ArrayArray` with the given number of elements.+newArrayArray :: Int -> ST s (MutableArrayArray s e)+newArrayArray (I# n#)+  = ST $ \s# -> case newArrayArray# n# s# of+           (# s'#, arr# #) -> (# s'#, MutableArrayArray arr# #)+{-# INLINE newArrayArray #-}+++-- | Write a `MutableByteArray` to an `MutableArrayArray`.+writeArrayArrayMut :: MutableArrayArray s (MutableByteArray s) -> Int -> MutableByteArray s -> ST s ()+writeArrayArrayMut (MutableArrayArray arrs#) (I# i#) (MutableByteArray mba#)+  = ST $ \s# -> case writeMutableByteArrayArray# arrs# i# mba# s# of+           s'# -> (# s'#, () #)+{-# INLINE writeArrayArrayMut #-}+++-- | Write a `ByteArray` to a `MutableArrayArray`.+writeArrayArray :: MutableArrayArray s ByteArray -> Int -> ByteArray -> ST s ()+writeArrayArray (MutableArrayArray arrs#) (I# i#) (ByteArray ba#)+  = ST $ \s# -> case writeByteArrayArray# arrs# i# ba# s# of+           s'# -> (# s'#, () #)+{-# INLINE writeArrayArray #-}+++-- | Read a `MutableByteArray` from a `MutableArrayArray`.+readArrayArray :: MutableArrayArray s (MutableByteArray s) -> Int -> ST s (MutableByteArray s)+readArrayArray (MutableArrayArray arrs#) (I# i#)+  = ST $ \s# -> case readMutableByteArrayArray# arrs# i# s# of+           (# s'#, mba# #) -> (# s'#, MutableByteArray mba# #)+{-# INLINE readArrayArray #-}+++-- | Index an `ArrayArray` of `ByteArray`s.+indexArrayArray :: ArrayArray ByteArray -> Int -> ByteArray+indexArrayArray (ArrayArray arrs#) (I# i#)+  = ByteArray (indexByteArrayArray# arrs# i#)+{-# INLINE indexArrayArray #-}+++-- | Freeze a `MutableArrayArray` into a plain `ArrayArray`.+unsafeFreezeArrayArray :: MutableArrayArray s e -> ST s (ArrayArray e)+unsafeFreezeArrayArray (MutableArrayArray marrs#)+  = ST $ \s# -> case unsafeFreezeArrayArray# marrs# s# of+           (# s'#, arrs# #)  -> (# s'#, ArrayArray arrs# #)+{-# INLINE unsafeFreezeArrayArray #-}+++-- | Freeze a nested `MutableArrayArray` into an `ArrayArray`.+unsafeDeepFreezeArrayArray +        :: forall s+        .  MutableArrayArray s (MutableByteArray s) +        -> ST s (ArrayArray ByteArray)++unsafeDeepFreezeArrayArray marrs@(MutableArrayArray marrs#)+ = do   let n = I# (sizeofMutableArrayArray# marrs#)+            marrs_halfFrozen = MutableArrayArray marrs#  -- :: MutableArrayArray s (ByteArray e)+        mapM_ (freezeSubArray marrs_halfFrozen) [0..n - 1]+        unsafeFreezeArrayArray marrs_halfFrozen+       +  where+    freezeSubArray marrs_halfFrozen i+      = do  mba <- readArrayArray marrs i+            ba  <- unsafeFreezeByteArray mba+            writeArrayArray marrs_halfFrozen i ba+{-# INLINE unsafeDeepFreezeArrayArray #-}+++-- | Copy an ArrayArray+copyArrayArray +        :: MutableArrayArray s ByteArray -> Int+        -> ArrayArray ByteArray -> Int+        -> Int -> ST s ()++copyArrayArray dst startDst src startSrc len+ = loop startDst startSrc len+ where  loop !ixDst !ixSrc !len'+         | len' <= 0     = return ()+         | otherwise+         = do   writeArrayArray dst ixDst $ indexArrayArray src ixSrc+                loop (ixDst + 1) (ixSrc + 1) (len' - 1)+

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Sequential operations on unlifted arrays.+-- +--   * This is an internal API and shouldn't need to be used directly.+--     Client programs should use "Data.Array.Parallel.Unlifted"+module Data.Array.Parallel.Unlifted.Sequential+        ( -- * Constructors+          replicateSU+        , replicateRSU+        , appendSU+        , indicesSU,    indicesSU'++          -- * Folds+        , foldSU,       foldSSU+        , foldlSU,      foldlSSU,   foldlRU+        , foldl1SU,     foldl1SSU+        , fold1SU,      fold1SSU+        +          -- * Sums+        , andSU+        , orSU+        , sumSU,         sumRU+        , productSU+        , maximumSU+        , minimumSU++          -- * Pack and Combine+        , combineSU+        +          -- * Extracts and Indexing+        , indexsFromVector+        , indexsFromVectorsUVSegd+        , extractsFromNestedUSSegd+        , extractsFromVectorsUSSegd+        , extractsFromVectorsUVSegd)+where+import Data.Array.Parallel.Unlifted.Sequential.Basics+import Data.Array.Parallel.Unlifted.Sequential.Combinators+import Data.Array.Parallel.Unlifted.Sequential.Sums+import Data.Array.Parallel.Unlifted.Sequential.Extracts+import Data.Array.Parallel.Unlifted.Sequential.USegd     ()+import Data.Array.Parallel.Unlifted.Sequential.USel      ()+import Data.Array.Parallel.Unlifted.Sequential.UVSegd    ()+import Prelude hiding (zip)

@@ -0,0 +1,61 @@+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Basic segmented operations on unlifted arrays.+module Data.Array.Parallel.Unlifted.Sequential.Basics+        ( replicateSU, replicateRSU+        , appendSU+        , indicesSU, indicesSU')+where+import Data.Array.Parallel.Unlifted.Stream+import Data.Array.Parallel.Unlifted.Sequential.Vector+import Data.Array.Parallel.Unlifted.Sequential.USegd            (USegd)+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd+import qualified Data.Vector.Fusion.Stream as S+++-- | Segmented replicate of a vector based on the lengths of the segments+--   of the provided `USegd`.+replicateSU :: Unbox a => USegd -> Vector a -> Vector a+replicateSU segd xs +        = unstream+             (replicateEachS (USegd.takeElements segd)+             (S.zip (stream (USegd.takeLengths segd)) (stream xs)))+{-# INLINE_U replicateSU #-}+++-- | Regular sgemented replicate.+replicateRSU :: Unbox a => Int -> Vector a -> Vector a+replicateRSU n xs+        = unstream+        . replicateEachRS n+        $ stream xs+{-# INLINE_U replicateRSU #-}+                  ++-- | Segmented append.+appendSU :: Unbox a +         => USegd -> Vector a   -- segd/data of first array+         -> USegd -> Vector a   -- segd/data of second array+         -> Vector a+appendSU xd xs yd ys+        = unstream+        $ appendSS (stream (USegd.takeLengths xd)) (stream xs)+                   (stream (USegd.takeLengths yd)) (stream ys)+{-# INLINE_U appendSU #-}+++-- | Segmented indices.+indicesSU :: USegd -> Vector Int+indicesSU = indicesSU' 0+{-# INLINE_U indicesSU #-}+++indicesSU' :: Int -> USegd -> Vector Int+indicesSU' i segd+        = unstream+        . indicesSS (USegd.takeElements segd) i+        . stream+        $ USegd.takeLengths segd+{-# INLINE_U indicesSU' #-}+

@@ -0,0 +1,123 @@+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Standard combinators for segmented unlifted arrays.+module Data.Array.Parallel.Unlifted.Sequential.Combinators +        ( foldlSU,      foldlSSU+        , foldSU,       foldSSU+        , foldl1SU,     foldl1SSU+        , fold1SU,      fold1SSU+        , foldlRU+        , combineSU)+where+import Data.Array.Parallel.Unlifted.Stream+import Data.Array.Parallel.Unlifted.Vectors                     as US+import Data.Array.Parallel.Unlifted.Sequential.Vector           as U+import Data.Array.Parallel.Unlifted.Sequential.USSegd           (USSegd)+import Data.Array.Parallel.Unlifted.Sequential.USegd            (USegd)+import qualified Data.Array.Parallel.Unlifted.Sequential.USSegd as USSegd+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd++-- NOTE: +-- Even though some of these functions are trivial aliases, we use INLINE_U +-- pragmas on them to delay inlining. This lets us see what functions are being+-- called from higher layers of the library when browsing the core IR.+++-- foldl ----------------------------------------------------------------------+-- | Segmented array reduction proceeding from the left+foldlSU  :: (Unbox a, Unbox b)+         => (b -> a -> b) -> b -> USegd -> Vector a -> Vector b+foldlSU f !z segd xs +        = unstream+        $ foldSS f z    (stream (USegd.takeLengths segd))+                        (stream xs)+{-# INLINE_U foldlSU #-}+++-- | Segmented array reduction proceeding from the left.+--   For scattered segments.+foldlSSU :: (Unbox a, Unboxes a, Unbox b)+         => (b -> a -> b) -> b -> USSegd -> Vectors a -> Vector b+foldlSSU f !z ssegd xss+        = unstream+        $ foldSS f z    (stream (USSegd.takeLengths ssegd))+                        (streamSegsFromVectorsUSSegd xss ssegd)+{-# INLINE_U foldlSSU #-}+++-- fold -----------------------------------------------------------------------+-- | Segmented array reduction that requires an associative combination+--   function with its unit+foldSU  :: Unbox a+        => (a -> a -> a) -> a -> USegd -> Vector a -> Vector a+foldSU = foldlSU+{-# INLINE_U foldSU #-}+++-- | Segmented array reduction that requires an associative combination+--   function with its unit. For scattered segments.+foldSSU :: (Unbox a, Unboxes a)+        => (a -> a -> a) -> a -> USSegd -> Vectors a -> Vector a+foldSSU = foldlSSU       +{-# INLINE_U foldSSU #-}+++-- foldl1 ---------------------------------------------------------------------+-- | Segmented array reduction from left to right with non-empty subarrays only+foldl1SU :: Unbox a+         => (a -> a -> a) -> USegd -> Vector a -> Vector a+foldl1SU f segd xs +        = unstream+        $ fold1SS f     (stream (USegd.takeLengths segd))+                        (stream xs)+{-# INLINE_U foldl1SU #-}+++-- | Segmented array reduction from left to right with non-empty subarrays only.+--   For scattered segments.+foldl1SSU :: (Unbox a, Unboxes a)+          => (a -> a -> a) -> USSegd -> Vectors a -> Vector a+foldl1SSU f ssegd xxs+        = unstream+        $ fold1SS f     (stream (USSegd.takeLengths ssegd))+                        (streamSegsFromVectorsUSSegd xxs ssegd)+{-# INLINE_U foldl1SSU #-}+++-- fold1 ----------------------------------------------------------------------+-- | Segmented array reduction with non-empty subarrays and an associative+--   combination function.+fold1SU :: Unbox a+        => (a -> a -> a) -> USegd -> Vector a -> Vector a+fold1SU = foldl1SU+{-# INLINE_U fold1SU #-}+++-- | Segmented array reduction with non-empty subarrays and an associative+--   combination function. For scattered segments.+fold1SSU :: (Unbox a, Unboxes a)+        => (a -> a -> a) -> USSegd -> Vectors a -> Vector a+fold1SSU = foldl1SSU+{-# INLINE_U fold1SSU #-}++++-- foldlR ---------------------------------------------------------------------+-- | Regular arrar reduction +foldlRU :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Int -> Vector a -> Vector b+foldlRU f !z segSize+        = unstream . foldValuesR f z segSize . stream+{-# INLINE_U foldlRU #-}+++-- | Merge two segmented arrays according to flag array+combineSU :: Unbox a => Vector Bool -> USegd -> Vector a -> USegd -> Vector a -> Vector a+combineSU bs xd xs yd ys+        = unstream+        $ combineSS (stream bs)+                    (stream (USegd.takeLengths xd)) (stream xs)+                    (stream (USegd.takeLengths yd)) (stream ys)+{-# INLINE_U combineSU #-}++

@@ -0,0 +1,78 @@+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Standard combinators for segmented unlifted arrays.+module Data.Array.Parallel.Unlifted.Sequential.Extracts+        ( -- * Scattered indexing.+          indexsFromVector+        , indexsFromVectorsUVSegd++          -- * Scattered extracts+        , extractsFromNestedUSSegd+        , extractsFromVectorsUSSegd+        , extractsFromVectorsUVSegd)+where+import Data.Array.Parallel.Unlifted.Stream                      as US+import Data.Array.Parallel.Unlifted.Vectors                     as US+import Data.Array.Parallel.Unlifted.Sequential.Vector           as U+import Data.Array.Parallel.Unlifted.Sequential.USSegd           (USSegd)+import Data.Array.Parallel.Unlifted.Sequential.UVSegd           (UVSegd)+import qualified Data.Vector                                    as V+++-- Indexs --------------------------------------------------------------------+-- | Lookup elements from a `Vector`.+indexsFromVector+        :: Unbox a+        => Vector a -> Vector Int -> Vector a++indexsFromVector vector ixs+        = U.unstream +        $ streamElemsFromVector vector +        $ U.stream ixs+{-# INLINE_U indexsFromVector #-}+++-- | Lookup elements from some `Vectors` through a `UPVSegd`.+indexsFromVectorsUVSegd +        :: (Unbox a, US.Unboxes a)+        => Vectors a -> UVSegd -> Vector (Int, Int) -> Vector a++indexsFromVectorsUVSegd vectors uvsegd vsrcixs+        = U.unstream +        $ streamElemsFromVectorsVSegd vectors uvsegd +        $ U.stream vsrcixs+{-# INLINE_U indexsFromVectorsUVSegd #-}+++-- Extracts wrappers ---------------------------------------------------------+-- | Copy segments from a `Vectors`, concatenating them into a new array.+extractsFromNestedUSSegd+        :: (U.Unbox a)+        => USSegd -> V.Vector (Vector a) -> U.Vector a++extractsFromNestedUSSegd ussegd vectors+        = U.unstream $ streamSegsFromNestedUSSegd vectors ussegd+{-# INLINE_U extractsFromNestedUSSegd #-}+++-- | Copy segments from a `Vectors`, concatenating them into a new array.+extractsFromVectorsUSSegd+        :: (Unboxes a, U.Unbox a)+        => USSegd -> Vectors a -> U.Vector a++extractsFromVectorsUSSegd ussegd vectors+        = U.unstream $ streamSegsFromVectorsUSSegd vectors ussegd+{-# INLINE_U extractsFromVectorsUSSegd #-}+++-- | Copy segments from a `Vectors`, concatenating them into a new array.+extractsFromVectorsUVSegd+        :: (Unbox a, US.Unboxes a)+        => UVSegd+        -> Vectors a+        -> Vector a++extractsFromVectorsUVSegd uvsegd vectors+        = U.unstream  $ US.streamSegsFromVectorsUVSegd vectors uvsegd+{-# INLINE_U extractsFromVectorsUVSegd #-}

@@ -1,27 +0,0 @@--- | Interface to operations on segmented unlifted arrays.-module Data.Array.Parallel.Unlifted.Sequential.Segmented (--  replicateSU, replicateRSU, appendSU, indicesSU, indicesSU',--  foldlSU, foldSU, fold1SU,-  foldlRU,-  combineSU,--  -- * Logical operations-  andSU, orSU,--  -- * Arithmetic operations-  sumSU, productSU, maximumSU, minimumSU,-  sumRU,-  USegd,--  -- * Operations on segment descriptors-  lengthUSegd, lengthsUSegd, indicesUSegd, elementsUSegd,-  lengthsToUSegd, mkUSegd-) where-import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd-import Data.Array.Parallel.Unlifted.Sequential.Segmented.Basics-import Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators-import Data.Array.Parallel.Unlifted.Sequential.Segmented.Sums-import Data.Array.Parallel.Unlifted.Sequential.Segmented.Text ()-

@@ -1,48 +0,0 @@-{-# LANGUAGE CPP #-}-#include "fusion-phases.h"---- | Basic segmented operations on unlifted arrays.-module Data.Array.Parallel.Unlifted.Sequential.Segmented.Basics (-  replicateSU, replicateRSU, appendSU, indicesSU, indicesSU'-) where-import Data.Array.Parallel.Stream-import Data.Array.Parallel.Unlifted.Sequential.Vector-import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd-import qualified Data.Vector.Fusion.Stream as S---replicateSU :: Unbox a => USegd -> Vector a -> Vector a-{-# INLINE_U replicateSU #-}-replicateSU segd xs = unstream-                     (replicateEachS (elementsUSegd segd)-                     (S.zip (stream (lengthsUSegd segd)) (stream xs)))---replicateRSU :: Unbox a => Int -> Vector a -> Vector a-{-# INLINE_U replicateRSU #-}-replicateRSU n xs = unstream-                  . replicateEachRS n-                  $ stream xs-                  --appendSU :: Unbox a => USegd -> Vector a -> USegd -> Vector a -> Vector a-{-# INLINE_U appendSU #-}-appendSU xd xs yd ys = unstream-                     $ appendSS (stream (lengthsUSegd xd))-                                (stream xs)-                                (stream (lengthsUSegd yd))-                                (stream ys)---indicesSU' :: Int -> USegd -> Vector Int-{-# INLINE_U indicesSU' #-}-indicesSU' i segd = unstream-                  . indicesSS (elementsUSegd segd) i-                  . stream-                  $ lengthsUSegd segd---indicesSU :: USegd -> Vector Int-{-# INLINE_U indicesSU #-}-indicesSU = indicesSU' 0-

@@ -1,56 +0,0 @@-{-# LANGUAGE CPP #-}-#include "fusion-phases.h"---- | Standard combinators for segmented unlifted arrays.-module Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators (-  foldlSU, foldSU, foldl1SU, fold1SU, {-scanSU,-} {-scan1SU,-}-  foldlRU,-  combineSU-) where-import Data.Array.Parallel.Stream (-  foldSS, fold1SS, combineSS, foldValuesR )-import Data.Array.Parallel.Unlifted.Sequential.Vector as V-import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd-import Debug.Trace----- | Segmented array reduction proceeding from the left-foldlSU :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> USegd -> Vector a -> Vector b-{-# INLINE_U foldlSU #-}-foldlSU f z segd xs = unstream-                    $ foldSS f z (stream (lengthsUSegd segd)) (stream xs)----- | Segmented array reduction that requires an associative combination---   function with its unit-foldSU :: Unbox a => (a -> a -> a) -> a -> USegd -> Vector a -> Vector a-foldSU = foldlSU----- | Segmented array reduction from left to right with non-empty subarrays only-foldl1SU :: Unbox a => (a -> a -> a) -> USegd -> Vector a -> Vector a-{-# INLINE_U foldl1SU #-}-foldl1SU f segd xs = unstream-                   $ fold1SS f (stream (lengthsUSegd segd)) (stream xs)----- | Segmented array reduction with non-empty subarrays and an associative---   combination function-fold1SU :: Unbox a => (a -> a -> a) -> USegd -> Vector a -> Vector a-fold1SU = foldl1SU----- | Merge two segmented arrays according to flag array-combineSU :: Unbox a => Vector Bool -> USegd -> Vector a -> USegd -> Vector a -> Vector a-{-# INLINE_U combineSU #-}-combineSU bs xd xs yd ys = unstream-                         $ combineSS (stream bs)-                                     (stream (lengthsUSegd xd)) (stream xs)-                                     (stream (lengthsUSegd yd)) (stream ys)----- | Regular arrar reduction -foldlRU :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Int -> Vector a -> Vector b-{-# INLINE_U foldlRU #-}-foldlRU f z segSize = unstream . foldValuesR f z segSize . stream-

@@ -1,50 +0,0 @@--- | Sum-like operations on segmented list-like combinators.-module Data.Array.Parallel.Unlifted.Sequential.Segmented.Sums (-  andSU, orSU, sumSU, productSU, maximumSU, minimumSU,-  sumRU-) where-import Data.Array.Parallel.Unlifted.Sequential.Vector as V-import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd (-  USegd )-import Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators (-  foldSU, fold1SU, foldlRU)----- | Compute the boolean AND of all segments in a segmented array.-andSU :: USegd -> Vector Bool -> Vector Bool-andSU = foldSU (&&) True----- | Compute the boolean OR of all segments in a segmented array.-orSU :: USegd -> Vector Bool -> Vector Bool-orSU = foldSU (||) False----- | Compute the segmented sum of an array of numerals-sumSU :: (Num e, Unbox e) => USegd -> Vector e -> Vector e-{-# INLINE sumSU #-}-sumSU = foldSU (+) 0----- | Compute the segmented product of an array of numerals-productSU :: (Num e, Unbox e) => USegd -> Vector e -> Vector e-{-# INLINE productSU #-}-productSU = foldSU (*) 1----- | Determine the maximum element in each subarray-maximumSU :: (Ord e, Unbox e) => USegd -> Vector e -> Vector e-{-# INLINE maximumSU #-}-maximumSU = fold1SU max----- | Determine the minimum element in each subarray-minimumSU :: (Ord e, Unbox e) => USegd -> Vector e -> Vector e-{-# INLINE minimumSU #-}-minimumSU = fold1SU min----- | Compute the segmented sum of an array of numerals-sumRU :: (Num e, Unbox e) => Int ->Vector e -> Vector e-{-# INLINE sumRU #-}-sumRU = foldlRU (+) 0

@@ -1,11 +0,0 @@--- | Read\/Show instances for segmented unlifted arrays.-module Data.Array.Parallel.Unlifted.Sequential.Segmented.Text ()-where-import Data.Array.Parallel.Base (-  Read(..), showsApp, readApp)-import Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd (-  USegd, lengthsUSegd )--instance Show USegd where-  showsPrec k = showsApp k "toUSegd" . lengthsUSegd-

@@ -1,137 +0,0 @@-{-# LANGUAGE CPP #-}-#include "fusion-phases.h"---- | Segment Descriptors-module Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd (-  -- * Types-  USegd,--  -- * Constructors-  mkUSegd,-  emptyUSegd, singletonUSegd, lengthsToUSegd,--  -- * Projections-  lengthUSegd, lengthsUSegd, indicesUSegd, elementsUSegd, --  -- * Operations-  sliceUSegd, extractUSegd-) where-import Data.Array.Parallel.Unlifted.Sequential.Vector as V---- | Segment descriptors represent the structure of nested arrays.---  For each segment, it stores the length and the starting index in the flat data array.------   Example:------   @---    flat array data:  [1, 2, 3, 4, 5, 6, 7, 8]---      (segmentation)   ----  -------  -  -------      segd  lengths: [2, 3, 1, 2]---            indices: [0, 2, 5, 6]---           elements: 8 ---   @-data USegd -        = USegd -        { usegd_lengths  :: !(Vector Int)  -- ^ length of each segment-        , usegd_indices  :: !(Vector Int)  -- ^ starting index of each segment in the flat array-        , usegd_elements :: !Int           -- ^ total number of elements in the flat array-        }----- Constructors ------------------------------------------------------------------ | O(1). Construct a new segment descriptor.-mkUSegd -        :: Vector Int   -- ^ length of each segment-        -> Vector Int   -- ^ starting index of each segment-        -> Int          -- ^ total number of elements in the flat array-        -> USegd--{-# INLINE mkUSegd #-}-mkUSegd = USegd----- | O(1). Yield an empty segment descriptor, with no elements or segments.-emptyUSegd :: USegd-{-# INLINE emptyUSegd #-}-emptyUSegd = USegd V.empty V.empty 0----- | O(1). Yield a singleton segment descriptor.---         The single segment covers the given number of elements.-singletonUSegd :: Int -> USegd-{-# INLINE singletonUSegd #-}-singletonUSegd n = USegd (V.singleton n) (V.singleton 0) n----- | O(n). Convert a length array into a segment descriptor.--- ---   The array contains the length of each segment, and we compute the ---   indices from that. Runtime is O(n) in the number of segments.----lengthsToUSegd :: Vector Int -> USegd-{-# INLINE lengthsToUSegd #-}-lengthsToUSegd lens-        = USegd lens (V.scanl (+) 0 lens) (V.sum lens)----- Projections ------------------------------------------------------------------- | O(1). Yield the overall number of segments.-lengthUSegd :: USegd -> Int-{-# INLINE lengthUSegd #-}-lengthUSegd = V.length . usegd_lengths----- | O(1). Yield the lengths of the individual segments.-lengthsUSegd :: USegd -> Vector Int-{-# INLINE lengthsUSegd #-}-lengthsUSegd = usegd_lengths----- | O(1). Yield the segment indices of a segment descriptor.-indicesUSegd :: USegd -> Vector Int-{-# INLINE indicesUSegd #-}-indicesUSegd = usegd_indices----- | O(1). Yield the number of data elements.-elementsUSegd :: USegd -> Int-{-# INLINE elementsUSegd #-}-elementsUSegd = usegd_elements----- | O(n). Extract a slice of a segment descriptor, avoiding copying where possible.------   We can share the segment lengths with the original segment descriptor, ---   but still need to recompute the starting indices of each. Hence---   runtime is O(n) in the number of segments sliced out.--- ---   NOTE: In the new segment descriptor, the starting index of the first---         segment will be 0.-sliceUSegd -        :: USegd        -- ^ source segment descriptor-        -> Int          -- ^ index of first segment-        -> Int          -- ^ number of segments to slice out-        -> USegd-        -{-# INLINE sliceUSegd #-}-sliceUSegd segd i n-        = lengthsToUSegd $ V.slice (lengthsUSegd segd) i n----- | O(n). Extract a slice of a segment descriptor, copying everything.------   In contrast to `sliceUSegd`, this function copies the array of ---   segment lengths as well as recomputing the starting indices of each.------   NOTE: In the new segment descriptor, the starting index of the first---         segment will be 0.-extractUSegd -        :: USegd        -- ^ source segment desciptor-        -> Int          -- ^ index of the first segment-        -> Int          -- ^ number of segments to extract out-        -> USegd--{-# INLINE extractUSegd #-}-extractUSegd segd i n -        = lengthsToUSegd $ V.extract (lengthsUSegd segd) i n-

@@ -0,0 +1,55 @@+{-# LANGUAGE CPP #-}+#include "fusion-phases.h"++-- | Sum-like operations on segmented list-like combinators.+module Data.Array.Parallel.Unlifted.Sequential.Sums+        ( andSU, orSU+        , sumSU, sumRU+        , productSU+        , maximumSU, minimumSU)+where+import Data.Array.Parallel.Unlifted.Sequential.Vector as V+import Data.Array.Parallel.Unlifted.Sequential.USegd +import Data.Array.Parallel.Unlifted.Sequential.Combinators+++-- | Compute the boolean AND of all segments in a segmented array.+andSU :: USegd -> Vector Bool -> Vector Bool+andSU = foldSU (&&) True+{-# INLINE_U andSU #-}+++-- | Compute the boolean OR of all segments in a segmented array.+orSU :: USegd -> Vector Bool -> Vector Bool+orSU = foldSU (||) False+{-# INLINE_U orSU #-}+++-- | Compute the segmented sum of an array of numerals+sumSU :: (Num e, Unbox e) => USegd -> Vector e -> Vector e+sumSU = foldSU (+) 0+{-# INLINE_U sumSU #-}+++-- | Compute the segmented product of an array of numerals+productSU :: (Num e, Unbox e) => USegd -> Vector e -> Vector e+productSU = foldSU (*) 1+{-# INLINE_U productSU #-}+++-- | Determine the maximum element in each subarray+maximumSU :: (Ord e, Unbox e) => USegd -> Vector e -> Vector e+maximumSU = fold1SU max+{-# INLINE_U maximumSU #-}+++-- | Determine the minimum element in each subarray+minimumSU :: (Ord e, Unbox e) => USegd -> Vector e -> Vector e+minimumSU = fold1SU min+{-# INLINE_U minimumSU #-}+++-- | Compute the segmented sum of an array of numerals+sumRU :: (Num e, Unbox e) => Int ->Vector e -> Vector e+sumRU = foldlRU (+) 0+{-# INLINE_U sumRU #-}

@@ -0,0 +1,293 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -Wall -fno-warn-orphans #-}+#include "fusion-phases.h"++-- | Scattered Segment Descriptors.+--+--   See "Data.Array.Parallel.Unlifted" for how this works.+--+module Data.Array.Parallel.Unlifted.Sequential.USSegd +        ( -- * Types+          USSegd(..)+        , valid++        -- * Constructors+        , mkUSSegd+        , empty+        , singleton+        , fromUSegd+        +        -- * Predicates+        , isContiguous+        +        -- * Projections+        , length+        , takeUSegd, takeLengths, takeIndices, takeElements+        , takeSources, takeStarts+        , getSeg+        +        -- * Operators+        , appendWith+        , cullOnVSegids)+where+import Data.Array.Parallel.Unlifted.Sequential.USegd            (USegd)+import Data.Array.Parallel.Unlifted.Sequential.Vector           (Vector)+import Data.Array.Parallel.Pretty                               hiding (empty)+import Prelude                                                  hiding (length)+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as U++here :: String -> String +here s = "Data.Array.Parallel.Unlifted.Sequential.USSegd." ++ s+++-- USSegd ---------------------------------------------------------------------+-- | Scattered Segment Descriptor.+data USSegd+        = USSegd+        { ussegd_contiguous     :: !Bool+          -- ^ True when the starts are identical to the usegd indices field+          --        and the sources are all 0's. +          --+          --   In this case all the data elements are in one contiguous flat+          --   array, and consumers can avoid looking at the real starts and+          --   sources fields.++        , ussegd_starts         :: Vector Int+          -- ^ Starting index of each segment in its flat array.+          -- +          --   IMPORTANT: this field is lazy so we can avoid creating it when+          --              the flat array is contiguous.++        , ussegd_sources        :: Vector Int+          -- ^ Which flat array to take each segment from.+          -- +          --   IMPORTANT: this field is lazy so we can avoid creating it when+          --              the flat array is contiguous.++        , ussegd_usegd          :: !USegd+          -- ^ Segment descriptor relative to a contiguous index space.+          --   This defines the length of each segment.+        }+        deriving (Show)+++-- | Pretty print the physical representation of a `UVSegd`+instance PprPhysical USSegd where+ pprp (USSegd _ starts sources ssegd)+  = vcat+  [ text "USSegd" +        $$ (nest 7 $ vcat+                [ text "starts:  " <+> (text $ show $ U.toList starts)+                , text "sources: " <+> (text $ show $ U.toList sources) ])+  , pprp ssegd ]+++-- Constructors ---------------------------------------------------------------+-- | O(1). Construct a new scattered segment descriptor.+--   All the provided arrays must have the same lengths.+mkUSSegd+        :: Vector Int   -- ^ Starting index of each segment in its flat array.+        -> Vector Int   -- ^ Which array to take each segment from.+        -> USegd        -- ^ Contiguous segment descriptor.+        -> USSegd++mkUSSegd = USSegd False+{-# INLINE mkUSSegd #-}+++-- | O(1). Check the internal consistency of a scattered segment descriptor.+valid :: USSegd -> Bool+valid (USSegd _ starts srcids usegd)+        =  (U.length starts == USegd.length usegd)+        && (U.length srcids == USegd.length usegd)++{-# NOINLINE valid #-}+--  NOINLINE because it's only enabled during debugging anyway.+++-- | O(1). Construct an empty segment descriptor, with no elements or segments.+empty :: USSegd+empty   = USSegd True U.empty U.empty USegd.empty+{-# INLINE_U empty #-}+++-- | O(1). Construct a singleton segment descriptor.+--   The single segment covers the given number of elements in a flat array+--   with sourceid 0.+singleton :: Int -> USSegd+singleton n +        = USSegd True (U.singleton 0) (U.singleton 0) (USegd.singleton n)+{-# INLINE_U singleton #-}+++-- | O(segs). Promote a plain `USegd` to a `USSegd`.+--   All segments are assumed to come from a flat array with sourceid 0.+fromUSegd :: USegd -> USSegd+fromUSegd usegd+        = USSegd True +                 (USegd.takeIndices usegd)+                 (U.replicate (USegd.length usegd) 0)+                 usegd+{-# INLINE_U fromUSegd #-}+++-- Predicates -----------------------------------------------------------------+-- INLINE trivial projections as they'll expand to a single record selector.+-- | O(1). True when the starts are identical to the usegd indices field and+--   the sources are all 0's. +--+--   In this case all the data elements are in one contiguous flat+--   array, and consumers can avoid looking at the real starts and+--   sources fields.+--+isContiguous :: USSegd -> Bool+isContiguous    = ussegd_contiguous+{-# INLINE isContiguous #-}+++-- Projections ----------------------------------------------------------------+-- INLINE trivial projections as they'll expand to a single record selector.++-- | O(1). Yield the overall number of segments.+length :: USSegd -> Int+length          = USegd.length . ussegd_usegd +{-# INLINE length #-}+++-- | O(1). Yield the `USegd` of a `USSegd`.+takeUSegd   :: USSegd -> USegd+takeUSegd       = ussegd_usegd+{-# INLINE takeUSegd #-}+++-- | O(1). Yield the lengths of the segments of a `USSegd`.+takeLengths :: USSegd -> Vector Int+takeLengths     = USegd.takeLengths . ussegd_usegd+{-# INLINE takeLengths #-}+++-- | O(1). Yield the segment indices of a `USSegd`.+takeIndices :: USSegd -> Vector Int+takeIndices     = USegd.takeIndices . ussegd_usegd+{-# INLINE takeIndices #-}+++-- | O(1). Yield the total number of elements covered by a `USSegd`.+takeElements :: USSegd -> Int+takeElements    = USegd.takeElements . ussegd_usegd+{-# INLINE takeElements #-}+++-- | O(1). Yield the starting indices of a `USSegd`.+takeStarts :: USSegd -> Vector Int+takeStarts      = ussegd_starts+{-# INLINE takeStarts #-}+++-- | O(1). Yield the source ids of a `USSegd`.+takeSources :: USSegd -> Vector Int+takeSources     = ussegd_sources+{-# INLINE takeSources #-}+++-- | O(1). Get the length, segment index, starting index, and source id of a segment.+getSeg :: USSegd -> Int -> (Int, Int, Int, Int)+getSeg (USSegd _ starts sources usegd) ix+ = let  (len, ixl) = USegd.getSeg usegd ix+   in   ( len+        , ixl+        , U.index (here "getSeg") starts  ix+        , U.index (here "getSeg") sources ix)+{-# INLINE_U getSeg #-}+++-- Operators ==================================================================++-- | O(n). Produce a segment descriptor that describes the result of appending+--   two arrays.+appendWith+        :: USSegd               -- ^ Segment descriptor of first nested array.+        -> Int                  -- ^ Number of flat data arrays used to represent first nested array.+        -> USSegd               -- ^ Segment descriptor of second nested array. +        -> Int                  -- ^ Number of flat data arrays used to represent second nested array.+        -> USSegd+appendWith+        (USSegd _ starts1 srcs1 usegd1) pdatas1+        (USSegd _ starts2 srcs2 usegd2) _+        = USSegd False+                 (starts1  U.++  starts2)+                 (srcs1    U.++  U.map (+ pdatas1) srcs2)+                 (USegd.append usegd1 usegd2)+{-# NOINLINE appendWith #-}+--  NOINLINE because we're worried about code explosion. Might be useful though.+++-- | Cull the segments of a `USSegd` down to only those reachable from an array+--   of @vsegids@, and also update the @vsegids@ to point to the same segments+--   in the result.+--+cullOnVSegids :: Vector Int -> USSegd -> (Vector Int, USSegd)+cullOnVSegids vsegids (USSegd _ starts sources usegd)+ = {-# SCC "cullOnVSegids" #-}+ let    -- Determine which of the psegs are still reachable from the vsegs.+        -- This produces an array of flags, +        --    with reachable   psegs corresponding to 1+        --    and  unreachable psegs corresponding to 0+        -- +        --  eg  vsegids:        [0 1 1 3 5 5 6 6]+        --   => psegids_used:   [1 1 0 1 0 1 1]+        --  +        --  Note that psegids '2' and '4' are not in vsegids_packed.+        psegids_used+         = U.bpermuteDft (USegd.length usegd)+                         (const False)+                         (U.zip vsegids (U.replicate (U.length vsegids) True))++        -- Produce an array of used psegs.+        --  eg  psegids_used:   [1 1 0 1 0 1 1]+        --      psegids_packed: [0 1 3 5 6]+        psegids_packed+         = U.pack (U.enumFromTo 0 (U.length psegids_used)) psegids_used++        -- Produce an array that maps psegids in the source array onto+        -- psegids in the result array. If a particular pseg isn't present+        -- in the result this maps onto -1.++        --  Note that if psegids_used has 0 in some position, then psegids_map+        --  has -1 in the same position, corresponding to an unused pseg.+         +        --  eg  psegids_packed: [0 1 3 5 6]+        --                      [0 1 2 3 4]+        --      psegids_map:    [0 1 -1 2 -1 3 4]+        psegids_map+         = U.bpermuteDft (USegd.length usegd)+                         (const (-1))+                         (U.zip psegids_packed (U.enumFromTo 0 (U.length psegids_packed - 1)))++        -- Use the psegids_map to rewrite the packed vsegids to point to the +        -- corresponding psegs in the result.+        -- +        --  eg  vsegids:        [0 1 1 3 5 5 6 6]+        --      psegids_map:    [0 1 -1 2 -1 3 4]+        -- +        --      vsegids':       [0 1 1 2 3 3 4 4]+        --+        vsegids'  = U.map (U.index (here "cullOnVSegids") psegids_map) vsegids++        -- Rebuild the usegd.+        starts'   = U.pack starts  psegids_used+        sources'  = U.pack sources psegids_used++        lengths'  = U.pack (USegd.takeLengths usegd) psegids_used+        usegd'    = USegd.fromLengths lengths'+        +        ussegd'   = USSegd False starts' sources' usegd'++     in  (vsegids', ussegd')++{-# NOINLINE cullOnVSegids #-}+--  NOINLINE because it's complicated and won't fuse with anything+--  This can also be expensive and we want to see the SCC in profiling builds.++

@@ -0,0 +1,181 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -fno-warn-orphans #-}+#include "fusion-phases.h"++-- | Segment Descriptors.+--+--   See "Data.Array.Parallel.Unlifted" for how this works.+--+module Data.Array.Parallel.Unlifted.Sequential.USegd +        ( -- * Types+          USegd(..)++          -- * Constructors+        , mkUSegd, valid+        , empty, singleton+        , fromLengths++          -- * Projections+        , length+        , takeLengths, takeIndices, takeElements+        , getSeg++          -- * Operations+        , append, slice, extract)+where+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as U+import Data.Array.Parallel.Unlifted.Sequential.Vector           (Vector)+import Data.Array.Parallel.Pretty                               hiding (empty)+import Prelude                                                  hiding (length)++here :: String -> String +here s = "Data.Array.Parallel.Unlifted.Sequential.USegd." ++ s+++-- | Segment descriptor. +data USegd +        = USegd +        { usegd_lengths  :: !(Vector Int)  -- ^ Length of each segment.+        , usegd_indices  :: !(Vector Int)  -- ^ Starting index of each segment.+        , usegd_elements :: !Int           -- ^ Total number of elements in the flat array.+        } deriving (Show, Eq)+++instance PprPhysical USegd where+ pprp (USegd lengths indices elements)+  =   text "USegd" +  $$  (nest 7 $ vcat+        [ text "lengths: " <+> (text $ show $ U.toList lengths)+        , text "indices: " <+> (text $ show $ U.toList indices)+        , text "elements:" <+> (text $ show elements)])+++-- Constructors ---------------------------------------------------------------+-- | O(1). Construct a new segment descriptor.+mkUSegd +        :: Vector Int   -- ^ Length of each segment.+        -> Vector Int   -- ^ Starting index of each segment.+        -> Int          -- ^ Total number of elements in the flat array.+        -> USegd++mkUSegd = USegd+{-# INLINE_U mkUSegd #-}+++-- | O(1). Check the internal consistency of a segment descriptor.+--+--   As the indices and elemens field can be generated based on the segment+--   lengths, we check the consistency by rebuilding these fields and +--   comparing the rebuilt ones against the originals.+valid :: USegd -> Bool+valid usegd@(USegd lengths _ _)+        = usegd == fromLengths lengths+{-# NOINLINE valid #-}+--  NOINLINE because it's only enabled during debugging anyway.+++-- | O(1). Construct an empty segment descriptor, with no elements or segments.+empty :: USegd+empty   = USegd U.empty U.empty 0+{-# INLINE_U empty #-}+++-- | O(1). Construct a singleton segment descriptor.+--   The single segment covers the given number of elements.+singleton :: Int -> USegd+singleton n+        = USegd (U.singleton n) (U.singleton 0) n+{-# INLINE_U singleton #-}+++-- | O(segs). Convert an array of segment lengths into a segment descriptor.+-- +--   The array contains the length of each segment, and we compute the +--   indices from that.+fromLengths :: Vector Int -> USegd+fromLengths lens+        = USegd lens (U.scanl (+) 0 lens) (U.sum lens)+{-# INLINE_U fromLengths #-}+++-- Projections ----------------------------------------------------------------+-- INLINE trivial projections as they'll expand to a single record selector.++-- | O(1). Yield the overall number of segments.+length :: USegd -> Int+length          = U.length . usegd_lengths+{-# INLINE length #-}+++-- | O(1). Yield the lengths of the individual segments.+takeLengths :: USegd -> Vector Int+takeLengths     = usegd_lengths+{-# INLINE takeLengths #-}+++-- | O(1). Yield the segment indices of a segment descriptor.+takeIndices :: USegd -> Vector Int+takeIndices     = usegd_indices+{-# INLINE takeIndices #-}+++-- | O(1). Yield the number of data elements.+takeElements :: USegd -> Int+takeElements    = usegd_elements+{-# INLINE takeElements #-}+++-- | O(1). Get the length and segment index of a segment+getSeg :: USegd -> Int -> (Int, Int)+getSeg (USegd lengths indices _ ) ix+ =      ( U.index (here "getSeg") lengths ix+        , U.index (here "getSeg") indices ix)+{-# INLINE_U getSeg #-}+++-- Operators ------------------------------------------------------------------+-- | O(segs). Produce a segment descriptor that describes the result of appending +--   two arrays.+append :: USegd -> USegd -> USegd+append (USegd lengths1 indices1 elems1)+            (USegd lengths2 indices2 elems2)+ = USegd (lengths1 U.++ lengths2)+         (indices1 U.++ U.map (+ elems1) indices2)+         (elems1 + elems2)+{-# INLINE_U append #-}+++-- | O(segs) Extract a slice of a segment descriptor, avoiding copying where possible.+--+--   We can share the segment lengths with the original segment descriptor, +--   but still need to recompute the starting indices of each. Hence+--   runtime is O(segs) in the number of segments sliced out.++--   NOTE: In the new segment descriptor, the starting index of the first+--         segment will be 0.+slice+        :: USegd        -- ^ Source segment descriptor.+        -> Int          -- ^ Index of first segment.+        -> Int          -- ^ Number of segments to slice out.+        -> USegd+slice segd i n+        = fromLengths $ U.unsafeSlice (takeLengths segd) i n+{-# INLINE_U slice #-}+++-- | Extract a slice of a segment descriptor, copying everything.+--+--   In contrast to `slice`, this function copies the array of +--   segment lengths as well as recomputing the starting indices of each.++--   NOTE: In the new segment descriptor, the starting index of the first+--         segment will be 0.+extract+        :: USegd        -- ^ Source segment desciptor.+        -> Int          -- ^ Undex of the first segment.+        -> Int          -- ^ Number of segments to extract out.+        -> USegd+extract segd i n +        = fromLengths $ U.extract (takeLengths segd) i n+{-# INLINE_U extract #-}+

@@ -1,116 +1,94 @@--- | A selector is a description of how to perform a `combine` operation.------ Suppose we are evaluating the following expression:------   @combine [F,F,T,F,T,T] [1,2,3] [4,5,6] = [4,5,1,6,2,3]@------ This is difficult to parallelise. For each element in the result, the source --- array we get this element from depends on the tag values associated with --- all previous elements.------ However, if we going to perform several combines with the same tag array, we--- can precompute a selector that tells us where to get each element. The selector--- contains the original tags, as well as the source index telling us where to get--- each element for the result array.------ For example:------  @---  tagsToIndices2 [F,F,T,F,T,T]   -- tags---               = [0,1,0,2,1,2]   -- indices---  @------  This says get the first element from index 0 in the second array, then from index 1 in the second array,---  then index 0 in the first array ...---  ---  The selector then consists of both the @tag@ and @indices@ arrays.--- {-# LANGUAGE CPP #-}- #include "fusion-phases.h" -module Data.Array.Parallel.Unlifted.Sequential.USel (-  -- * Types-  USel2,+-- | Selectors. +--+--   See "Data.Array.Parallel.Unlifted" for how this works.+--+module Data.Array.Parallel.Unlifted.Sequential.USel +        ( -- * Types+          USel2(..) -  -- * Operations on selectors-  mkUSel2,-  lengthUSel2,-  tagsUSel2, indicesUSel2, elementsUSel2_0, elementsUSel2_1,-  tagsToIndices2-) where-import Data.Array.Parallel.Unlifted.Sequential.Vector as V-import qualified Data.Vector.Fusion.Stream as S-import Data.Vector.Fusion.Stream.Monadic ( Stream(..) )-import Data.Array.Parallel.Base (Tag)+          -- * Operations on selectors+        , mkUSel2+        , lengthUSel2+        , tagsUSel2, indicesUSel2+        , elementsUSel2_0, elementsUSel2_1+        , tagsToIndices2)+where+import Data.Array.Parallel.Unlifted.Sequential.Vector   as V+import qualified Data.Vector.Fusion.Stream              as S+import Data.Vector.Fusion.Stream.Monadic                ( Stream(..) )+import Data.Array.Parallel.Base                         (Tag)  --- | Abstract selector. ---   Contains both the @tags@ and @indices@ arrays outlined above.+-- | Selector. data USel2          = USel2         { usel2_tags      :: !(Vector Tag)         , usel2_indices   :: !(Vector Int)-        , usel2_elements0 :: !Int               -- ^ number of tags with value 0-        , usel2_elements1 :: !Int               -- ^ number of tags with value 1+        , usel2_elements0 :: !Int       -- ^ Number of tags with value 0.+        , usel2_elements1 :: !Int       -- ^ Number of tags with value 1.         }   -- | O(1). Construct a selector.-mkUSel2 :: Vector Tag           -- ^ tags array -        -> Vector Int           -- ^ indices array-        -> Int                  -- ^ number of elements taken from first array-        -> Int                  -- ^ number of elements taken from second array+mkUSel2 :: Vector Tag           -- ^ Tags array.+        -> Vector Int           -- ^ Indices array+        -> Int                  -- ^ Number of elements taken from first array.+        -> Int                  -- ^ Number of elements taken from second array.         -> USel2-{-# INLINE mkUSel2 #-} mkUSel2 = USel2+{-# INLINE mkUSel2 #-}  +-- Projections ----------------------------------------------------------------+-- INLINE trivial projections as they'll expand to a single record selector.+ -- | O(1). Get the number of elements represented by this selector. --         This is the length of the array returned by `combine`. lengthUSel2 :: USel2 -> Int+lengthUSel2     = V.length . usel2_tags {-# INLINE lengthUSel2 #-}-lengthUSel2 = V.length . usel2_tags   -- | O(1). Get the tags array of a selector. tagsUSel2 :: USel2 -> Vector Tag {-# INLINE tagsUSel2 #-}-tagsUSel2 = usel2_tags+tagsUSel2       = usel2_tags   -- | O(1). Get the indices array of a selector. indicesUSel2 :: USel2 -> Vector Int+indicesUSel2    = usel2_indices {-# INLINE indicesUSel2 #-}-indicesUSel2 = usel2_indices   -- | O(1). Get the number of elements that will be taken from the first array. elementsUSel2_0 :: USel2 -> Int-{-# INLINE elementsUSel2_0 #-} elementsUSel2_0 = usel2_elements0+{-# INLINE elementsUSel2_0 #-}   -- | O(1). Get the number of elements that will be taken from the second array. elementsUSel2_1 :: USel2 -> Int-{-# INLINE elementsUSel2_1 #-} elementsUSel2_1 = usel2_elements1+{-# INLINE elementsUSel2_1 #-}   -- | O(n). Compute the source index for each element of the result array. tagsToIndices2 :: Vector Tag -> Vector Int-{-# INLINE tagsToIndices2 #-} tagsToIndices2 tags    = unstream (mapAccumS add (0,0) (stream tags))   where     add (i,j) 0 = ((i+1,j),i)     add (i,j) _ = ((i,j+1),j)+{-# INLINE_STREAM tagsToIndices2 #-}   mapAccumS :: (acc -> a -> (acc,b)) -> acc -> S.Stream a -> S.Stream b-{-# INLINE_STREAM mapAccumS #-}-mapAccumS f acc (Stream step s n)-  = Stream step' (acc,s) n+mapAccumS f acc0 (Stream step s0 n)+  = Stream step' (acc0,s0) n   where    {-# INLINE_INNER step' #-}    step' (acc,s) @@ -120,3 +98,4 @@                           in return $ S.Yield y (acc',s')           S.Skip    s' -> return $ S.Skip (acc,s')           S.Done       -> return S.Done+{-# INLINE_STREAM mapAccumS #-}

@@ -0,0 +1,510 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-missing-signatures #-}+#include "fusion-phases.h"++-- | Virtual Segment Descriptors.+--+--   See "Data.Array.Parallel.Unlifted" for how this works.+--+module Data.Array.Parallel.Unlifted.Sequential.UVSegd+        ( -- * Types+          UVSegd(..)++          -- * Consistency check+        , valid+        +          -- * Constructors+        , mkUVSegd+        , fromUSegd+        , fromUSSegd+        , empty+        , singleton+        , replicated+        +          -- * Predicates+        , isManifest+        , isContiguous+        +          -- * Projections+        , length+        , takeVSegids,  takeVSegidsRedundant+        , takeUSSegd,   takeUSSegdRedundant+        , takeLengths+        , getSeg++          -- * Operators+        , appendWith+        , combine2+        , updateVSegs+        , updateVSegsReachable+        , unsafeDemoteToUSSegd+        , unsafeDemoteToUSegd)+where+import Data.Array.Parallel.Unlifted.Sequential.USel+import Data.Array.Parallel.Unlifted.Sequential.USSegd           (USSegd)+import Data.Array.Parallel.Unlifted.Sequential.USegd            (USegd)+import Data.Array.Parallel.Unlifted.Sequential.Vector           (Vector)+import Data.Array.Parallel.Pretty                               hiding (empty)+import Prelude                                                  hiding (length)+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as U+import qualified Data.Array.Parallel.Unlifted.Sequential.USSegd as USSegd+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd++here :: String -> String +here s = "Data.Array.Parallel.Unlifted.Sequential.UVSegd." ++ s+++-- UVSegd ---------------------------------------------------------------------+-- | Virtual segment descriptor.+----   +--   * TODO: It would probably be better to represent the vsegids as a lens (function)+--           instead of a vector of segids. Much of the time the vsegids are just @[0..n]@+--+data UVSegd +        = UVSegd +        { uvsegd_manifest       :: !Bool+          -- ^ When the vsegids field holds a lazy @(U.enumFromTo 0 (len - 1))@+          --   then this field is True. This lets us perform some operations like+          --   `demoteToUPSSegd` without actually creating it.++          -- | Virtual segment identifiers that indicate what physical segment+          --   to use for each virtual segment.+        , uvsegd_vsegids_redundant     :: Vector Int           -- LAZY FIELD +        , uvsegd_vsegids_culled        :: Vector Int           -- LAZY FIELD+        +          -- | Scattered segment descriptor that defines how physical segments+          --   are layed out in memory.+        , uvsegd_ussegd_redundant      :: USSegd               -- LAZY FIELD+        , uvsegd_ussegd_culled         :: USSegd               -- LAZY FIELD+        +          -- IMPORTANT:+          -- When vsegids are transformed due to a segmented replication operation, +          -- if some of the segment lengths were zero, then we will end up with +          -- physical segments that are unreachable from the vsegids.+          -- +          -- For some operations (like indexing) the fact that we have unreachable+          -- psegids doesn't matter, but for others (like segmented fold) it does.+          -- The problem is that we perform segmented fold by first folding all +          -- the physical segments, then replicating the results according to the +          -- vsegids. If no vsegids referenced a physical segment then we didn't +          -- need to fold it.+          -- +          -- When vsegids are updated the version that may have unreachable psegs+          -- is stored in the vsegids_redundant and upssegd_redundant. The _culled+          -- versions are then set to a SUSPENDED call to callOnVSegids. If no+          -- consumers every demand the culled version then we never need to compute+          -- it.+          -- +          -- The vsegids_redundant field must also be lazy (no bang) because when it+          -- has the value (V.enumFromTo 0 (len - 1)) we want to avoid building the+          -- enumeration unless it's strictly demanded.+        }+        deriving (Show)+++instance PprPhysical UVSegd where+ pprp (UVSegd _ _ vsegids _ ussegd)+  = vcat+  [ text "UVSegd" $$ (nest 7 $ text "vsegids: " <+> (text $ show $ U.toList vsegids))+  , pprp ussegd ]++++-- | O(1). Check the internal consistency of a virutal segmentation descriptor.+---+--   * TODO: check that all vsegs point to a valid pseg+valid :: UVSegd -> Bool+valid (UVSegd _ _ vsegids _ ussegd)+        = U.length vsegids == USSegd.length ussegd+{-# NOINLINE valid #-}+--  NOINLINE because it's only enabled during debugging anyway.+++-- Constructors ---------------------------------------------------------------+-- | O(1). Construct a new virtual segment descriptor.+--   All the provided arrays must have the same lengths.+mkUVSegd+        :: Vector Int   -- ^ (vsegids) Mapping from virtual to physical segments.+        -> USSegd       -- ^ Scattered Segment descriptor defining the +                        --   physical segments.+        -> UVSegd++mkUVSegd vsegids ussegd+        = UVSegd False vsegids vsegids ussegd ussegd+{-# INLINE mkUVSegd #-}+++-- | O(segs). Promote a plain `USegd` to a `UVSegd`.+--+--   The result contains one virtual segment for every physical segment+--   the provided `Segd`.+fromUSSegd :: USSegd -> UVSegd+fromUSSegd ussegd+ = let  vsegids = U.enumFromTo 0 (USSegd.length ussegd - 1)+   in   UVSegd True vsegids vsegids ussegd ussegd+{-# INLINE_U fromUSSegd #-}+++-- | O(segs). Promote a plain `Segd` to a `VSegd`.+--+--   The result contains one virtual segment for every physical segment+--   the provided `SSegd`.+fromUSegd :: USegd -> UVSegd+fromUSegd+        = fromUSSegd . USSegd.fromUSegd+{-# INLINE_U fromUSegd #-}+++-- | O(1). Construct an empty segment descriptor, with no elements or segments.+empty :: UVSegd+empty   + = let  vsegids = U.empty+        ssegd   = USSegd.empty+   in   UVSegd True vsegids vsegids ssegd ssegd+{-# INLINE_U empty #-}+++-- | O(1). Construct a singleton segment descriptor.+--   The single segment covers the given number of elements in a flat array+--   with sourceid 0.+singleton :: Int -> UVSegd+singleton n + = let  vsegids = U.singleton 0+        ssegd   = USSegd.singleton n+   in   UVSegd True vsegids vsegids ssegd ssegd+{-# INLINE_U singleton #-}+++-- | O(1). Construct a `UVSegd` that describes an array created by replicating+--   a single segment several times.+---+--   NOTE: This is a helpful target for rewrite rules, because when we +--   see a 'replicated' we know that all segments in the virtual array+--   point to the same data.+replicated +        :: Int          -- ^ Length of segment.+        -> Int          -- ^ Number of times replicated.+        -> UVSegd++replicated len reps+ = let  -- We have a single physical segment.+        ssegd   = USSegd.singleton len++        -- All virtual segments point to the same physical segment.+   in   mkUVSegd (U.replicate reps 0) ssegd+{-# INLINE_U replicated #-}+++-- Predicates -----------------------------------------------------------------+-- | O(1). Checks whether all the segments are manifest (unshared / non-virtual).+--   If this is the case, then the vsegids field will be [0..len-1]. +--+--   Consumers can check this field, avoid demanding the vsegids field.+--   This can avoid the need for it to be generated in the first place, due to+--   lazy evaluation.+--+isManifest :: UVSegd -> Bool+isManifest      = uvsegd_manifest+{-# INLINE isManifest #-}+++-- | O(1). Checks whether the starts are identical to the usegd indices field and+--   the sourceids are all 0's. +--+--   In this case all the data elements are in one contiguous flat+--   array, and consumers can avoid looking at the real starts and+--   sources fields.+--+isContiguous :: UVSegd -> Bool+isContiguous    = USSegd.isContiguous . uvsegd_ussegd_culled+{-# INLINE isContiguous #-}+++-- Projections ----------------------------------------------------------------+-- INLINE trivial projections as they'll expand to a single record selector.++-- | O(1). Yield the vsegids of a `UVSegd`+takeVSegids :: UVSegd -> Vector Int+takeVSegids     = uvsegd_vsegids_culled+{-# INLINE takeVSegids #-}+++-- | O(1). Take the vsegids of a `UVSegd`, but don't require that every physical+--   segment is referenced by some virtual segment.+--+--   If you're just performing indexing and don't need the invariant that all+--   physical segments are reachable from some virtual segment, then use this+--   version as it's faster. This sidesteps the code that maintains the invariant.+--+--   The stated O(1) complexity assumes that the array has already been fully+--   evalauted. If this is not the case then we can avoid demanding the result+--   of a prior computation on the vsegids, thus reducing the cost attributed+--   to that prior computation.+takeVSegidsRedundant :: UVSegd -> Vector Int+takeVSegidsRedundant = uvsegd_vsegids_redundant+{-# INLINE takeVSegidsRedundant #-}+++-- | O(1). Yield the `USSegd` of a `UVSegd`.+takeUSSegd :: UVSegd -> USSegd+takeUSSegd      = uvsegd_ussegd_culled+{-# INLINE takeUSSegd #-}+++-- | O(1). Take the `UPSSegd` of a `UPVSegd`, but don't require that every physical+--   segment is referenced by some virtual segment.+--+--   See the note in `takeVSegidsRedundant`.+takeUSSegdRedundant :: UVSegd -> USSegd+takeUSSegdRedundant    = uvsegd_ussegd_redundant+{-# INLINE takeUSSegdRedundant #-}+++-- | O(1). Yield the overall number of segments described by a `UVSegd`.+length :: UVSegd -> Int+length          = U.length . uvsegd_vsegids_redundant+{-# INLINE length #-}+++-- | O(segs). Yield the lengths of the segments described by a `UVSegd`.+takeLengths :: UVSegd -> Vector Int+takeLengths (UVSegd manifest _ vsegids _ ussegd)+ | manifest     = USSegd.takeLengths ussegd + | otherwise+ = let 	!lengths	= USSegd.takeLengths ussegd+   in	U.map (U.index (here "takeLengths") lengths) vsegids+{-# NOINLINE takeLengths #-}+--  NOINLINE because we don't want a case expression due to the test on the +--  manifest flag to appear in the core program.+++-- | O(1). Get the length, starting index, and source id of a segment.++--  NOTE: We don't return the segment index field from the USSegd as this refers+--        to the flat index relative to the SSegd array, rather than +--        relative to the UVSegd array. If we tried to promote the USSegd index+--        to a UVSegd index it could overflow.+--+getSeg :: UVSegd -> Int -> (Int, Int, Int)+getSeg uvsegd ix+ = let  vsegids = uvsegd_vsegids_redundant uvsegd+        ussegd  = uvsegd_ussegd_redundant  uvsegd+        (len, _index, start, source) +                = USSegd.getSeg ussegd (U.index (here "getSeg") vsegids ix)+   in   (len, start, source)+{-# INLINE_U getSeg #-}+++-- Demotion -------------------------------------------------------------------+-- | O(segs). Yield a `USSegd` that describes each segment of a `UVSegd` +--   individually.+-- +--   * By doing this we lose information about virtual segments corresponding+--     to the same physical segments.+-- +--   * This operation is used in concatPR as the first step in eliminating+--     segmentation from a nested array.+-- +unsafeDemoteToUSSegd :: UVSegd -> USSegd+unsafeDemoteToUSSegd uvsegd+ | uvsegd_manifest uvsegd       = uvsegd_ussegd_culled uvsegd           -- TODO: take the redundant ones+ | otherwise+ = let  vsegids         = uvsegd_vsegids_culled uvsegd+        ussegd          = uvsegd_ussegd_culled  uvsegd+        starts'         = U.bpermute (USSegd.takeStarts  ussegd) vsegids+        sources'        = U.bpermute (USSegd.takeSources ussegd) vsegids+        lengths'        = U.bpermute (USSegd.takeLengths ussegd) vsegids+        usegd'          = USegd.fromLengths lengths'+   in   USSegd.mkUSSegd starts' sources' usegd'+{-# NOINLINE unsafeDemoteToUSSegd #-}+--  NOINLINE because it's complicated and won't fuse with anything.+++-- | O(segs). Yield a `USegd` that describes each segment of a `UVSegd`+--   individually, assuming all segments have been concatenated to +--   remove scattering.+--+--   /WARNING/: Trying to take the `UPSegd` of a nested array that has been+--   constructed with replication can cause index space overflow. This is+--   because the virtual size of the corresponding flat data can be larger+--   than physical memory. If this happens then indices fields and +--   element count in the result will be invalid.+-- +--+unsafeDemoteToUSegd :: UVSegd -> USegd+unsafeDemoteToUSegd (UVSegd _ _ vsegids _ ussegd)+        = USegd.fromLengths+        $ U.bpermute (USSegd.takeLengths ussegd) vsegids+{-# NOINLINE unsafeDemoteToUSegd #-}+--  NOINLINE because it won't fuse with anything.++++   +-- Operators ------------------------------------------------------------------+-- | Update the vsegids of `UPVSegd`, and then cull the physical+--   segment descriptor so that all phsyical segments are reachable from+--   some virtual segment.+--+--   This function lets you perform filtering operations on the virtual segments,+--   while maintaining the invariant that all physical segments are referenced+--   by some virtual segment.+-- +updateVSegs :: (Vector Int -> Vector Int) -> UVSegd -> UVSegd+updateVSegs fUpdate (UVSegd _ _ vsegids _ ussegd)+ = let  -- When we transform the vsegids, we don't know whether they all +        -- made it into the result. +        vsegids_redundant      = fUpdate vsegids+ +        -- Cull the psegs down to just those reachable from the vsegids, +        -- but do it lazilly so consumers can avoid demanding this +        -- culled version and save creating it.+        (  vsegids_culled+         , ussegd_culled)       = USSegd.cullOnVSegids vsegids_redundant ussegd++   in   UVSegd False+               vsegids_redundant vsegids_culled+               ussegd            ussegd_culled+{-# INLINE_U updateVSegs #-}+--  INLINE_UP because we want to inline the parameter function fUpdate.+++-- | Update the vsegids of `UPVSegd`, where the result covers+--   all physical segments.+--+--   * The resulting vsegids must cover all physical segments.+--     If they do not then there will be physical segments that are not +--     reachable from some virtual segment, and performing operations like+--     segmented fold will waste work.+--+--   * Using this version saves performing the 'cull' operation which +--     discards unreachable physical segments. This is O(result segments), +--     but can be expensive in absolute terms.+--   +updateVSegsReachable :: (Vector Int -> Vector Int) -> UVSegd -> UVSegd+updateVSegsReachable fUpdate (UVSegd _ _ vsegids _ ssegd)+ = let  vsegids' = fUpdate vsegids+   in   UVSegd False vsegids' vsegids' ssegd ssegd+{-# INLINE_UP updateVSegsReachable #-}+--  INLINE_UP because we want to inline the parameter function fUpdate.++++-- append ---------------------------------------------------------------------+-- | O(n)+--   Produce a segment descriptor describing the result of appending two arrays.++--   Note that the implementation of this is similar to `combine2UVSegd`+-- @+--  source1+--    VIRT1 [[0],[4,2],[5,6,7,8,9]]+--    PHYS1 UVSegd  vsegids:    [0,1,2]+--          USSegd  pseglens:   [1,2,5]+--                  psegstarts: [0,1,3]+--                  psegsrcs:   [0,0,0]+--          PData   PInt [0,4,2,5,6,7,8,9]+--+--  source2+--    VIRT2 [[1,2,3],[8,6,3],[9,3]]+--    PHYS2 UVSegd  vsegids:    [0,1,2]+--          USSegd  pseglens:   [3,3,2]+--                  psegstarts: [0,3,6]+--                  psegsrcs:   [0,0,0]+--          PData   PInt [1,2,3,8,6,3,9,3]+--+--   appended+--    VIRT  [[0],[4,2],[5,6,7,8,9],[1,2,3],[8,6,3],[9,3]]+--          UVSegd  vsegids:    [0,1,2,3,4,5]  -- shift second half+--          USSegd  pseglens:   [1,2,5,3,3,2]  -- appended+--                  psegstarts: [0,1,3,0,3,6]  -- appended+--                  psegsrcs:   [0,0,0,1,1,1]  -- shift second half+--          PData   PInt [0,4,2,5,6,7,8,9]     -- both pdatas in result+--                  PInt [1,2,3,8,6,3,9,3]     -- ...+-- @+-- +appendWith+        :: UVSegd       -- ^ Descriptor of first array.+        -> Int          -- ^ Number of flat physical arrays for first descriptor.+        -> UVSegd       -- ^ Descriptor of second array.+        -> Int          -- ^ Number of flat physical arrays for second descriptor.+        -> UVSegd++appendWith+        (UVSegd _ _ vsegids1 _ ussegd1) pdatas1+        (UVSegd _ _ vsegids2 _ ussegd2) pdatas2++ = let  -- vsegids releative to appended psegs+        vsegids1' = vsegids1+        vsegids2' = U.map (+ USSegd.length ussegd1) vsegids2+        +        -- append the vsegids+        vsegids'  = vsegids1' U.++ vsegids2'++        -- All data from the source arrays goes into the result+        ussegd'   = USSegd.appendWith+                                ussegd1 pdatas1+                                ussegd2 pdatas2+                                 +   in   UVSegd False vsegids' vsegids' ussegd' ussegd'+{-# INLINE_U appendWith #-}+++-- combine --------------------------------------------------------------------+-- | O(n). Combine two virtual segment descriptors.+++-- Note that the implementation of this is similar to `appendUVSegd`+-- @+-- source1+--    VIRT1 [[0],[4,2],[5,6,7,8,9]]+--    PHYS1 UVSegd  vsegids:    [0,1,2]+--          USSegd  pseglens:   [1,2,5]+--                  psegstarts: [0,1,3]+--                  psegsrcs:   [0,0,0]+--          PDATA   PInt [0,4,2,5,6,7,8,9]+--+-- source2+--    VIRT2 [[1,2,3],[8,6,3],[9,3]]+--    PHYS2 UVSegd  vsegids:    [0,1,2]+--          USSegd  pseglens:   [3,3,2]+--                  psegstarts: [0,3,6]+--                  psegsrcs:   [0,0,0]+--          PData   PInt [1,2,3,8,6,3,9,3]+--+--   combined with tags [1,0,0,1,0,1]+--    VIRT  [[1,2,3],[0],[4,2],[8,6,3],[5,6,7,8,9],[9,3]]+--    PHYS  VSSegd  vsegids:    [3,0,1,4,2,5] -- combine shifted vsegs+--          USSegd  pseglens:   [1,2,5,3,3,2] -- appended+--                  psegstarts: [0,1,3,0,3,6] -- appended+--                  psegsrcs:   [0,0,0,1,1,1] -- shift second half+--          PData   PInt [0,4,2,5,6,7,8,9]    -- both pdatas in result+--                  PInt [1,2,3,8,6,3,9,3]+-- @  +-- +combine2+        :: USel2       -- ^ Selector for the combine operation.+        -> UVSegd      -- ^ Descriptor of first array.+        -> Int          -- ^ Number of flat physical arrays for first descriptor.+        -> UVSegd      -- ^ Descriptor of second array.+        -> Int          -- ^ Number of flat physical arrays for second descriptor.+        -> UVSegd+        +combine2  usel2+        (UVSegd _ _ vsegids1 _ ussegd1) pdatas1+        (UVSegd _ _ vsegids2 _ ussegd2) pdatas2++ = let  -- vsegids relative to combined psegs+        vsegids1' = vsegids1+        vsegids2' = U.map (+ (U.length vsegids1)) vsegids2++        -- combine the vsegids+        vsegids'  = U.combine2ByTag (tagsUSel2 usel2)+                                    vsegids1' vsegids2'++         -- All data from the source arrays goes into the result+        ussegd'   = USSegd.appendWith+                                ussegd1 pdatas1+                                ussegd2 pdatas2+                                  +   in   UVSegd False vsegids' vsegids' ussegd' ussegd'+{-# INLINE_U combine2 #-}

@@ -1,8 +1,15 @@-{-# LANGUAGE ScopedTypeVariables, BangPatterns, CPP #-}-+{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses, BangPatterns, CPP #-}+{-# OPTIONS  -w #-}     -- TODO: enable warnings #include "fusion-phases.h" --- | Wrappers for primitives defined in @Data.Vector@+-- | Wrappers for primitives defined in @Data.Vector@.+--+--   * This is an internal API and shouldn't need to be used directly.+--     Client programs should use "Data.Array.Parallel.Unlifted".+--++--  This module doesn't have docs because the bindings are mostly just +--  forwards for the Data.Vector functions. See there for details. module Data.Array.Parallel.Unlifted.Sequential.Vector (    -- * Array classes@@ -17,18 +24,22 @@   -- * Basic operations   length, null, empty, singleton, cons, units,   replicate,-  -- replicateEachU,-  (!), (++),+  (++), index,   interleave, indexed, repeat, repeatS,    -- * Subarrays-  slice, extract,+  slice,   unsafeSlice,+  extract, unsafeExtract,   tail,   take, drop, splitAt,    -- * Permutations-  permute, bpermute, mbpermute, bpermuteDft, reverse, update,-+  permute,+  bpermute,+  mbpermute,+  bpermuteDft,+  reverse,+  update,    -- * Higher-order operations   map, zipWith, zipWith3,@@ -47,17 +58,22 @@   and, or, any, all,    -- * Arithmetic operations-  sum, product,-  maximum, minimum,-  maximumBy, minimumBy,-  maxIndex, minIndex,+  sum,        product,+  maximum,    minimum,+  maximumBy,  minimumBy,+  maxIndex,   minIndex,   maxIndexBy, minIndexBy,    -- * Arrays of pairs-  zip, unzip, fsts, snds,+  zip,  unzip, fsts, snds,+  zip3, unzip3,    -- * Enumerations-  enumFromTo, enumFromThenTo, enumFromStepLen, enumFromToEach, enumFromStepLenEach,+  enumFromTo,+  enumFromThenTo,+  enumFromStepLen,+  enumFromToEach,+  enumFromStepLenEach,    -- * Searching   find, findIndex,@@ -77,74 +93,81 @@    -- * I\/O   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 ) -) where+import Data.Vector.Unboxed +        hiding ( slice, zip, unzip, zip3, unzip3, foldl, foldl1, scanl, scanl1,+                 unsafeSlice ) -import Data.Array.Parallel.Stream-import Data.Array.Parallel.Base ( Tag, checkEq, ST )+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 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+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 {-# INLINE new #-}-new n p = V.create (do-                      v <- M.new n-                      p v-                      return v)   newM :: Unbox a => Int -> ST s (MVector s a)-{-# INLINE newM #-} newM = M.new+{-# INLINE newM #-}  --- | Yield an array of units +-- Yield an array of units  units :: Int -> Vector ()-{-# INLINE units #-} units n = replicate n ()+{-# INLINE units #-}                          --- | Interleave the elements of two arrays+-- Interleave the elements of two arrays interleave :: Unbox e => Vector e -> Vector e -> Vector e-{-# INLINE_U interleave #-} interleave xs ys = unstream (interleaveS (stream xs) (stream ys))+{-# INLINE_U interleave #-}  --- | Repeat an array @n@ times+-- Repeat an array @n@ times repeat :: Unbox e => Int -> Vector e -> Vector e-{-# INLINE_U repeat #-} repeat n xs = unstream (repeatS n xs)+{-# INLINE_U repeat #-}   repeatS :: Unbox e => Int -> Vector e -> S.Stream e@@ -159,55 +182,85 @@                | otherwise = return $ Yield (unsafeIndex xs i) (i+1,k)  -slice :: Unbox a => Vector a -> Int -> Int -> Vector a+-- Take a sub-range of a vector, avoiding copying.+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 {-# INLINE_U slice #-}-slice xs i n = V.slice i n xs  +-- Take a sub-range of a vector, avoiding copying, without bounds checks.+unsafeSlice :: Unbox a => Vector a -> Int -> Int -> Vector a+unsafeSlice xs i n = V.unsafeSlice i n xs+{-# INLINE_U unsafeSlice #-}+++index :: Unbox a => String -> Vector a -> Int -> a+index here vec ix+        = B.check here (V.length vec) ix+        $ V.unsafeIndex vec ix+{-# INLINE_U index #-}+++-- Copy out a subrange of a vector. extract :: Unbox a => Vector a -> Int -> Int -> Vector a {-# INLINE_U extract #-}-extract xs i n = force (V.slice i n xs)+extract xs i n +        = force (V.slice i n xs)  +-- Copy out a subrange of a vector, without bounds checks.+unsafeExtract :: Unbox a => Vector a -> Int -> Int -> Vector a+unsafeExtract xs i n = force (V.unsafeSlice i n xs)+{-# INLINE_U unsafeExtract #-}++ mupdate :: Unbox e => MVector s e -> Vector (Int,e) -> ST s ()+mupdate marr xs +        = MG.update marr (stream xs) {-# INLINE_U mupdate #-}-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)) {-# INLINE_U mpermute #-}-mpermute marr xs is = MG.update marr (stream (zip is xs))   permute :: Unbox e => Vector e -> Vector Int -> Vector e {-# INLINE_U permute #-}-permute xs is = create (do-                          v <- M.new (length xs)-                          mpermute v xs is-                          return v)+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-{-# INLINE_U bpermute #-} bpermute = backpermute+{-# INLINE_U bpermute #-}   mbpermute :: (Unbox e, Unbox d) => (e -> d) -> Vector e -> Vector Int -> Vector d+mbpermute f es is+        = unstream (mbpermuteS f es (stream is)) {-# INLINE_STREAM mbpermute #-}-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 {-# INLINE_STREAM bpermuteS #-}-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!)) {-# INLINE_STREAM mbpermuteS #-}-mbpermuteS f !a = S.map (f . (a!))  --- | Default back permute+-- Default back permute -- -- * The values of the index-value pairs are written into the position in the --   result array that is indicated by the corresponding index.@@ -216,125 +269,130 @@ --   determined by the initialiser function for that index position. -- bpermuteDft :: Unbox e-	    => Int			        -- ^ length of result array-	    -> (Int -> e)		        -- ^ initialiser function-	    -> Vector (Int,e)	        	-- ^ index-value pairs+	    => Int			        -- length of result array+	    -> (Int -> e)		        -- initialiser function+	    -> Vector (Int,e)	        	-- index-value pairs 	    -> Vector e+bpermuteDft n init+        = update (map init (enumFromN 0 n)) {-# INLINE_U bpermuteDft #-}-bpermuteDft n init = update (map init (enumFromN 0 n))  --- | Extract all elements from an array according to a given flag array+-- Extract all elements from an array according to a given flag array pack:: Unbox e => Vector e -> Vector Bool -> Vector e-{-# INLINE_U pack #-} pack xs = map fst . filter snd . zip xs+{-# INLINE_U pack #-}   combine :: Unbox a 	 => Vector Bool -> Vector a -> Vector a -> Vector a+combine bs+        = combine2ByTag (map (\b -> if b then 0 else 1) bs) {-# INLINE combine #-}-combine bs = combine2ByTag (map (\b -> if b then 0 else 1) bs)   combine2ByTag :: Unbox a => Vector Tag -> Vector a -> Vector a -> Vector a-{-# INLINE_U combine2ByTag #-} 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))+{-# INLINE_U combine2ByTag #-}  --- | Array reduction proceeding from the left+-- Array reduction proceeding from the left foldl :: Unbox a => (b -> a -> b) -> b -> Vector a -> b-{-# INLINE_U foldl #-} foldl = foldl'+{-# INLINE_U foldl #-}  --- | Array reduction proceeding from the left for non-empty arrays+-- Array reduction proceeding from the left for non-empty arrays foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a-{-# INLINE_U foldl1 #-} foldl1 = foldl1'+{-# INLINE_U foldl1 #-} --- | Array reduction that requires an associative combination function with its---   unit++-- Array reduction that requires an associative combination function with its+-- unit fold :: Unbox a => (a -> a -> a) -> a -> Vector a -> a-{-# INLINE_U fold #-} fold = foldl+{-# INLINE_U fold #-}  --- | Reduction of a non-empty array which requires an associative combination---   function+-- Reduction of a non-empty array which requires an associative combination+-- function fold1 :: Unbox a => (a -> a -> a) -> Vector a -> a-{-# INLINE_U fold1 #-} fold1 = foldl1+{-# INLINE_U fold1 #-}   foldl1Maybe :: Unbox a => (a -> a -> a) -> Vector a -> Maybe a-{-# INLINE_U foldl1Maybe #-} foldl1Maybe f xs = foldl' join Nothing xs   where     {-# INLINE join #-}     join Nothing  y = Just $! y     join (Just x) y = Just $! f x y+{-# INLINE_U foldl1Maybe #-}   fold1Maybe :: Unbox a => (a -> a -> a) -> Vector a -> Maybe a-{-# INLINE_U fold1Maybe #-} fold1Maybe = foldl1Maybe+{-# INLINE_U fold1Maybe #-} --- | Prefix scan proceedings from left to right++-- Prefix scan proceedings from left to right scanl :: (Unbox a, Unbox b) => (b -> a -> b) -> b -> Vector a -> Vector b-{-# INLINE_U scanl #-} scanl = prescanl'+{-# INLINE_U scanl #-}  --- | Prefix scan of a non-empty array proceeding from left to right+-- Prefix scan of a non-empty array proceeding from left to right scanl1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a-{-# INLINE_U scanl1 #-} scanl1 = scanl1'+{-# INLINE_U scanl1 #-}  --- | Prefix scan proceeding from left to right that needs an associative---   combination function with its unit+-- Prefix scan proceeding from left to right that needs an associative+-- combination function with its unit scan :: Unbox a => (a -> a -> a) -> a -> Vector a -> Vector a-{-# INLINE_U scan #-} scan = scanl+{-# INLINE_U scan #-}  --- | Prefix scan of a non-empty array proceeding from left to right that needs---   an associative combination function+-- Prefix scan of a non-empty array proceeding from left to right that needs+-- an associative combination function scan1 :: Unbox a => (a -> a -> a) -> Vector a -> Vector a-{-# INLINE_U scan1 #-} scan1 = scanl1+{-# INLINE_U scan1 #-}   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) {-# INLINE_U scanRes #-}-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-{-# INLINE_STREAM fsts #-} fsts (VBase.V_2 _ xs ys) = xs+{-# INLINE_STREAM fsts #-}   snds :: (Unbox a, Unbox b) => Vector (a,b) -> Vector b-{-# INLINE_STREAM snds #-} snds (VBase.V_2 _ xs ys) = ys+{-# INLINE_STREAM snds #-}   zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a,b)-{-# INLINE_STREAM zip #-} zip !xs !ys = V.zip xs ys+{-# INLINE_STREAM zip #-}   unzip :: (Unbox a, Unbox b) => Vector (a,b) -> (Vector a, Vector b)-{-# INLINE_STREAM unzip #-} unzip ps = V.unzip ps+{-# INLINE_STREAM unzip #-} + {-# RULES  "fsts/new/unstream [dph-prim-seq]" forall xs.@@ -349,63 +407,85 @@   #-}  +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+{-# INLINE_STREAM zip3 #-}+++unzip3  :: (Unbox a, Unbox b, Unbox c)+        => Vector (a,b,c) -> (Vector a, Vector b, Vector c)+unzip3 ps = V.unzip3 ps+{-# INLINE_STREAM unzip3 #-}++ enumFromStepLen :: Int -> Int -> Int -> Vector Int-{-# INLINE_U enumFromStepLen #-} enumFromStepLen = enumFromStepN+{-# INLINE_U enumFromStepLen #-}   enumFromToEach :: Int -> Vector (Int,Int) -> Vector Int+enumFromToEach n +        = unstream . enumFromToEachS n . stream {-# INLINE_U enumFromToEach #-}-enumFromToEach n = unstream . enumFromToEachS n . stream   enumFromStepLenEach :: Int -> Vector Int -> Vector Int -> Vector Int -> Vector Int-{-# INLINE_U enumFromStepLenEach #-} enumFromStepLenEach len starts steps lens-  = unstream $ enumFromStepLenEachS len $ stream $ V.zip3 starts steps lens+        = unstream +        $ enumFromStepLenEachS len +        $ stream +        $ V.zip3 starts steps lens+{-# INLINE_U enumFromStepLenEach #-}   random :: (Unbox a, R.Random a, R.RandomGen g) => Int -> g -> Vector a-{-# INLINE_U random #-} random n = unstream . randomS n+{-# INLINE_U random #-}   randomR :: (Unbox a, R.Random a, R.RandomGen g) => Int -> (a,a) -> g -> Vector a-{-# INLINE_U randomR #-} randomR n r = unstream . randomRS n r+{-# INLINE_U randomR #-}   randomS :: (R.RandomGen g, R.Random a) => Int -> g -> S.Stream a-{-# INLINE_STREAM randomS #-}-randomS n g = Stream step (g,n) (Exact n)+randomS n g +  = Stream step (g,n) (Exact n)   where     {-# INLINE step #-}     step (g,0) = return Done     step (g,n) = let (x,g') = R.random g                  in return $ Yield x (g',n-1)+{-# INLINE_STREAM randomS #-}   randomRS :: (R.RandomGen g, R.Random a) => Int -> (a,a) -> g -> S.Stream a-{-# INLINE_STREAM randomRS #-}-randomRS n r g = Stream step (g,n) (Exact n)+randomRS n r g +  = Stream step (g,n) (Exact n)   where     {-# INLINE step #-}     step (g,0) = return Done     step (g,n) = let (x,g') = R.randomR r g                  in return $ Yield x (g',n-1)+{-# INLINE_STREAM randomRS #-}   mdrop :: Unbox a => Int -> MVector s a -> MVector s a-{-# INLINE mdrop #-} mdrop = M.drop+{-# INLINE mdrop #-}   mslice :: Unbox a => Int -> Int -> MVector s a -> MVector s a-{-# INLINE mslice #-} mslice = M.slice+{-# INLINE mslice #-}  -hGetStorable :: forall a. Storable a => Handle -> IO (Storable.Vector a)+-- IO Functions ---------------------------------------------------------------+hGetStorable +        :: forall a. Storable a +        => Handle -> IO (Storable.Vector a) hGetStorable h =   alloca $ \iptr ->   do@@ -417,7 +497,9 @@     Storable.unsafeFreeze (MStorable.take r v)  -hPutStorable :: forall a. Storable a => Handle -> Storable.Vector a -> IO ()+hPutStorable +        :: forall a. Storable a+        => Handle -> Storable.Vector a -> IO () hPutStorable h xs =   alloca $ \iptr ->   do@@ -430,24 +512,26 @@   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 ()-{-# INLINE primPut #-} primPut h = hPutStorable h . Storable.convert+{-# INLINE primPut #-}   primGet :: (Unbox a, Storable a) => Handle -> IO (Vector a)-{-# INLINE primGet #-} primGet = fmap convert . hGetStorable+{-# INLINE primGet #-}   instance UIO Int where   {-# INLINE hPut #-}   hPut = primPut+   {-# INLINE hGet #-}   hGet = primGet @@ -455,6 +539,7 @@ instance UIO Double where   {-# INLINE hPut #-}   hPut = primPut+   {-# INLINE hGet #-}   hGet = primGet @@ -469,4 +554,106 @@   hGet h = do xs <- hGet h               ys <- hGet h               return (V.zip xs ys)+++-- Additional Unbox instances -------------------------------------------------+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+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeReplicate #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  {-# INLINE basicClear #-}+  {-# INLINE basicSet #-}+  {-# INLINE basicUnsafeCopy #-}+  {-# INLINE basicUnsafeGrow #-}+  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+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  {-# INLINE elemseq #-}+  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+{-# INLINE fromOrdering #-}+fromOrdering LT = 0+fromOrdering EQ = 1+fromOrdering GT = 2++toOrdering :: Word8 -> Ordering+{-# INLINE toOrdering #-}+toOrdering 0 = LT+toOrdering 1 = EQ+toOrdering _ = GT+++instance Unbox Integer+instance MG.MVector MVector Integer+instance G.Vector Vector Integer+ 

@@ -0,0 +1,18 @@++module Data.Array.Parallel.Unlifted.Stream+        ( -- * Segmented streams+          module Data.Array.Parallel.Unlifted.Stream.Segmented++          -- * Stream through segment descriptors+        , module Data.Array.Parallel.Unlifted.Stream.Ixs++          -- * Streams of scattered elements+        , module Data.Array.Parallel.Unlifted.Stream.Elems++          -- * Streams of scattered segments+        , module Data.Array.Parallel.Unlifted.Stream.Segments)+where+import Data.Array.Parallel.Unlifted.Stream.Segmented+import Data.Array.Parallel.Unlifted.Stream.Ixs+import Data.Array.Parallel.Unlifted.Stream.Elems+import Data.Array.Parallel.Unlifted.Stream.Segments

@@ -0,0 +1,79 @@+{-# LANGUAGE CPP, NoMonomorphismRestriction #-}+#include "fusion-phases.h"+module Data.Array.Parallel.Unlifted.Stream.Elems+        ( streamElemsFromVector+        , streamElemsFromVectors+        , streamElemsFromVectorsVSegd)+where+import Data.Array.Parallel.Unlifted.Stream.Ixs+import Data.Vector.Fusion.Stream.Monadic+import Data.Array.Parallel.Unlifted.Sequential.Vector            (Unbox, Vector)+import Data.Array.Parallel.Unlifted.Vectors                      (Unboxes, Vectors)+import Data.Array.Parallel.Unlifted.Sequential.UVSegd            (UVSegd(..))+import qualified Data.Array.Parallel.Unlifted.Sequential.Vector  as U+import qualified Data.Array.Parallel.Unlifted.Vectors            as US+import qualified Data.Array.Parallel.Unlifted.Sequential.UVSegd  as UVSegd++-- | Take a stream of indices, +--    look them up from a vector, +--    and produce a stream of elements.+streamElemsFromVector+        :: (Monad m, Unbox a)+        => Vector a -> Stream m Int -> Stream m a++streamElemsFromVector vector (Stream mkStep s0 size0)+ = vector `seq` Stream mkStep' s0 size0+ where+        {-# INLINE_INNER mkStep' #-}+        mkStep' s+         = do   step    <- mkStep s+                case step of+                 Yield ix s'+                  -> let !result = U.index "streamElemsFromVector" vector ix+                     in  return $ Yield result s'+                 +                 Skip s'        -> return $ Skip s'+                 Done           -> return Done+{-# INLINE_STREAM streamElemsFromVector #-}+++-- | Take a stream of chunk and chunk element indices, +--    look them up from some vectors, +--    and produce a stream of elements.+streamElemsFromVectors +        :: (Monad m, Unboxes a) +        => Vectors a -> Stream m (Int, Int) -> Stream m a++streamElemsFromVectors vectors (Stream mkStep s0 size0)+ = vectors `seq` Stream mkStep' s0 size0+  where+        {-# INLINE_INNER mkStep' #-}+        mkStep' s+         = do   step    <- mkStep s+                case step of+                 Yield (ix1, ix2) s' +                  -> let !result = US.unsafeIndex2 vectors ix1 ix2+                     in  return $ Yield result s'++                 Skip s'        -> return $ Skip s'+                 Done           -> return Done+{-# INLINE_STREAM streamElemsFromVectors #-}+++-- | Take a stream of virtual segment ids and element indices, +--   pass them through a `UVSegd` to get physical segment and element indices, +--   and produce a stream of elements.+streamElemsFromVectorsVSegd+        :: (Monad m, Unboxes a)+        => Vectors a -> UVSegd -> Stream m (Int, Int) -> Stream m a++streamElemsFromVectorsVSegd vectors uvsegd vsrcixs+ = let  -- Because we're just doing indexing here, we don't need the culled+        -- vsegids or ussegd, and can just use the redundant version.+        vsegids  = UVSegd.takeVSegidsRedundant uvsegd+        ussegd   = UVSegd.takeUSSegdRedundant  uvsegd+   in   streamElemsFromVectors        vectors+         $ streamSrcIxsThroughUSSegd  ussegd+         $ streamSrcIxsThroughVSegids vsegids+         $ vsrcixs+{-# INLINE_STREAM streamElemsFromVectorsVSegd #-}

@@ -0,0 +1,61 @@+{-# LANGUAGE CPP, NoMonomorphismRestriction #-}+#include "fusion-phases.h"+module Data.Array.Parallel.Unlifted.Stream.Ixs+        ( streamSrcIxsThroughVSegids+        , streamSrcIxsThroughUSSegd)+where+import Data.Vector.Fusion.Stream.Monadic+import Data.Array.Parallel.Unlifted.Sequential.USSegd            (USSegd(..))+import qualified Data.Array.Parallel.Unlifted.Sequential.USSegd  as USSegd+import qualified Data.Vector.Unboxed                             as U+++-- VSegd Streamers ------------------------------------------------------------+-- | Take a stream of virtual segment and segment element indices,+--   and convert it to a stream of physical segment and segment element indices.+streamSrcIxsThroughVSegids+        :: Monad m+        => U.Vector Int -> Stream m (Int, Int) -> Stream m (Int, Int)++streamSrcIxsThroughVSegids vsegids (Stream mkStep s0 size0)+ = vsegids `seq` Stream mkStep' s0 size0+ where+        {-# INLINE_INNER mkStep' #-}+        mkStep' s+         = do   step    <- mkStep s+                case step of+                 Yield (ix1, ix2) s'+                  -> let !pseg  = U.unsafeIndex vsegids ix1+                     in  return $ Yield (pseg, ix2) s'+                 +                 Skip s' -> return $ Skip s'+                 Done    -> return Done+{-# INLINE_STREAM streamSrcIxsThroughVSegids #-}+++-- SSegd Streamers ------------------------------------------------------------+-- | Take a stream of segment and segment element indices,+--   and convert it to a stream of chunk and chunk element indices.+streamSrcIxsThroughUSSegd +        :: Monad m+        => USSegd -> Stream m (Int, Int) -> Stream m (Int, Int)+        +streamSrcIxsThroughUSSegd ussegd (Stream mkStep s0 size0)+ = ussegd `seq` Stream mkStep' s0 size0+ where+        !sources = USSegd.takeSources ussegd+        !starts  = USSegd.takeStarts  ussegd+   +        {-# INLINE_INNER mkStep' #-}+        mkStep' s+         = do   step    <- mkStep s+                case step of+                 Yield (ix1, ix2) s'+                  -> let !src    = U.unsafeIndex sources ix1+                         !start  = U.unsafeIndex starts  ix1+                     in  return $ Yield (src, start + ix2) s'+                 +                 Skip s' -> return $ Skip s'+                 Done    -> return Done+{-# INLINE_STREAM streamSrcIxsThroughUSSegd #-}+

@@ -0,0 +1,541 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-incomplete-patterns #-}+#include "fusion-phases.h"++-- TODO: +--  The use of INLINE pragmas in some of these function isn't consistent.+--  for indexedS and combine2ByTagS, there is an INLINE_INNER on the 'next'+--  function, but replicateEachS uses a plain INLINE and fold1SS uses+--  a hard INLINE [0]. Can we make a rule that all top-level stream functions+--  in this module have INLINE_STREAM, and all 'next' functions have+--  INLINE_INNER? If not we should document the reasons for the special cases.+--+--  Fix warnings in this module.++-- | Stream functions not implemented in @Data.Vector@+module Data.Array.Parallel.Unlifted.Stream.Segmented+        ( indexedS+        , replicateEachS+        , replicateEachRS+        , interleaveS+        , combine2ByTagS+        , combineSS+        , enumFromToEachS+        , enumFromStepLenEachS+        , foldSS+        , fold1SS+        , foldValuesR+        , appendSS+        , indicesSS)+where+import Data.Array.Parallel.Base                 (Tag)+import qualified Data.Vector.Fusion.Stream      as S+import Data.Vector.Fusion.Stream.Monadic        (Stream(..), Step(..))+import Data.Vector.Fusion.Stream.Size           (Size(..))+++-- Indexed --------------------------------------------------------------------+-- | Tag each element of an stream with its index in that stream.+--+-- @+-- indexed [42,93,13]+--  = [(0,42), (1,93), (2,13)]+-- @+indexedS :: S.Stream a -> S.Stream (Int,a)+{-# INLINE_STREAM indexedS #-}+indexedS (Stream next s n) = Stream next' (0,s) n+  where+    {-# INLINE_INNER next' #-}+    next' (i,s) = do+                    r <- next s+                    case r of+                      Yield x s' -> return $ Yield (i,x) (i+1,s')+                      Skip    s' -> return $ Skip        (i,s')+                      Done       -> return Done+++-- Replicate ------------------------------------------------------------------+-- | Given a stream of pairs containing a count an an element,+--   replicate element the number of times given by the count.+--+--   The first parameter sets the size hint of the resulting stream.+-- +-- @+-- replicateEach 10 [(2,10), (5,20), (3,30)]+--   = [10,10,20,20,20,20,20,30,30,30]+-- @+replicateEachS :: Int -> S.Stream (Int,a) -> S.Stream a+{-# INLINE_STREAM replicateEachS #-}+replicateEachS n (Stream next s _) =+  Stream next' (0,Nothing,s) (Exact n)+  where+    {-# INLINE next' #-}+    next' (0, _, s) =+      do+        r <- next s+        case r of+          Done           -> return Done+          Skip s'        -> return $ Skip (0, Nothing, s')+          Yield (k,x) s' -> return $ Skip (k, Just x,s')+    next' (k,Nothing,s) = return Done   -- NEVER ENTERED (See Note)+    next' (k,Just x,s)  = return $ Yield x (k-1,Just x,s)+++-- | Repeat each element in the stream the given number of times.+--+-- @+-- replicateEach 2 [10,20,30]+--  = [10,10,20,20,30,30]+-- @+--+replicateEachRS :: Int -> S.Stream a -> S.Stream a+{-# INLINE_STREAM replicateEachRS #-}+replicateEachRS !n (Stream next s sz)+  = Stream next' (0,Nothing,s) (sz `multSize` n)+  where+    next' (0,_,s) =+      do+        r <- next s+        case r of+          Done       -> return Done+          Skip    s' -> return $ Skip (0,Nothing,s')+          Yield x s' -> return $ Skip (n,Just x,s')+    next' (i,Nothing,s) = return Done -- NEVER ENTERED (See Note)+    next' (i,Just x,s) = return $ Yield x (i-1,Just x,s)+++-- | Multiply a size hint by a scalar.+multSize :: Size -> Int -> Size+multSize (Exact n) k = Exact (n*k)+multSize (Max   n) k = Max   (n*k)+multSize Unknown   _ = Unknown+++-- Interleave -----------------------------------------------------------------+-- | Interleave the elements of two streams. We alternate between the first+--   and second streams, stopping when we can't find a matching element.+--+-- @+-- interleave [2,3,4] [10,20,30] = [2,10,3,20,4,30]+-- interleave [2,3]   [10,20,30] = [2,10,3,20]+-- interleave [2,3,4] [10,20]    = [2,10,3,20,4]+-- @+--+interleaveS :: S.Stream a -> S.Stream a -> S.Stream a+{-# INLINE_STREAM interleaveS #-}+interleaveS (Stream next1 s1 n1) (Stream next2 s2 n2)+  = Stream next (False,s1,s2) (n1+n2)+  where+    {-# INLINE next #-}+    next (False,s1,s2) =+      do+        r <- next1 s1+        case r of+          Yield x s1' -> return $ Yield x (True ,s1',s2)+          Skip    s1' -> return $ Skip    (False,s1',s2)+          Done        -> return Done++    next (True,s1,s2) =+      do+        r <- next2 s2+        case r of+          Yield x s2' -> return $ Yield x (False,s1,s2')+          Skip    s2' -> return $ Skip    (True ,s1,s2')+          Done        -> return Done -- NEVER ENTERED (See Note)+++-- Combine --------------------------------------------------------------------+-- | Combine two streams, using a tag stream to tell us which of the data+--   streams to take the next element from.+--+--   If there are insufficient elements in the data strams for the provided+--   tag stream then `error`.+--  +-- @+-- combine2ByTag [0,1,1,0,0,1] [1,2,3] [4,5,6]+--  = [1,4,5,2,3,6]+-- @+--+combine2ByTagS :: S.Stream Tag -> S.Stream a -> S.Stream a -> S.Stream a+{-# INLINE_STREAM combine2ByTagS #-}+combine2ByTagS (Stream next_tag s m) (Stream next0 s0 _)+                                     (Stream next1 s1 _)+  = Stream next (Nothing,s,s0,s1) m+  where+    {-# INLINE_INNER next #-}+    next (Nothing,s,s0,s1)+      = do+          r <- next_tag s+          case r of+            Done       -> return Done+            Skip    s' -> return $ Skip (Nothing,s',s0,s1)+            Yield t s' -> return $ Skip (Just t, s',s0,s1)++    next (Just 0,s,s0,s1)+      = do+          r <- next0 s0+          case r of+            Done        -> error "combine2ByTagS: stream 1 too short"+            Skip    s0' -> return $ Skip    (Just 0, s,s0',s1)+            Yield x s0' -> return $ Yield x (Nothing,s,s0',s1)++    next (Just t,s,s0,s1)+      = do+          r <- next1 s1+          case r of+            Done        -> error "combine2ByTagS: stream 2 too short"+            Skip    s1' -> return $ Skip    (Just t, s,s0,s1')+            Yield x s1' -> return $ Yield x (Nothing,s,s0,s1')+++-- | Segmented Stream combine. Like `combine2ByTagS`, except that the tags select+--   entire segments of each data stream, instead of selecting one element at a time.+--+-- @+-- combineSS [True, True, False, True, False, False]+--           [2,1,3] [10,20,30,40,50,60]+--           [1,2,3] [11,22,33,44,55,66]+--  = [10,20,30,11,40,50,60,22,33,44,55,66]+-- @+--+--   This says take two elements from the first stream, then another one element +--   from the first stream, then one element from the second stream, then three+--   elements from the first stream...+--+combineSS +        :: S.Stream Bool        -- ^ tag values+        -> S.Stream Int         -- ^ segment lengths for first data stream+        -> S.Stream a           -- ^ first data stream+        -> S.Stream Int         -- ^ segment lengths for second data stream+        -> S.Stream a           -- ^ second data stream+        -> S.Stream a++{-# INLINE_STREAM combineSS #-}+combineSS (Stream nextf sf _) +          (Stream nexts1 ss1 _) (Stream nextv1 vs1 nv1)+          (Stream nexts2 ss2 _) (Stream nextv2 vs2 nv2)+  = Stream next (Nothing,True,sf,ss1,vs1,ss2,vs2)+                (nv1+nv2)+  where+    {-# INLINE next #-}+    next (Nothing,f,sf,ss1,vs1,ss2,vs2) =+      do+        r <- nextf sf+        case r of+          Done        -> return Done+          Skip sf'    -> return $ Skip (Nothing,f,sf',ss1,vs1,ss2,vs2) +          Yield c sf'+            | c ->+              do+                r <- nexts1 ss1+                case r of+                  Done         -> return Done+                  Skip ss1'    -> return $ Skip (Nothing,f,sf,ss1',vs1,ss2,vs2) +                  Yield n ss1' -> return $ Skip (Just n,c,sf',ss1',vs1,ss2,vs2) ++            | otherwise ->+              do+                r <- nexts2 ss2+                case r of+                  Done         -> return Done+                  Skip ss2'    -> return $ Skip (Nothing,f,sf,ss1,vs1,ss2',vs2) +                  Yield n ss2' -> return $ Skip (Just n,c,sf',ss1,vs1,ss2',vs2)++    next (Just 0,_,sf,ss1,vs1,ss2,vs2) =+         return $ Skip (Nothing,True,sf,ss1,vs1,ss2,vs2)++    next (Just n,True,sf,ss1,vs1,ss2,vs2) =+      do+        r <- nextv1 vs1+        case r of+          Done         -> return Done+          Skip vs1'    -> return $ Skip (Just n,True,sf,ss1,vs1',ss2,vs2) +          Yield x vs1' -> return $ Yield x (Just (n-1),True,sf,ss1,vs1',ss2,vs2)++    next (Just n,False,sf,ss1,vs1,ss2,vs2) =+      do+        r <- nextv2 vs2+        case r of+          Done         -> return Done+          Skip vs2'    -> return $ Skip (Just n,False,sf,ss1,vs1,ss2,vs2') +          Yield x vs2' -> return $ Yield x (Just (n-1),False,sf,ss1,vs1,ss2,vs2')+++-- Enum -----------------------------------------------------------------------+-- | Create a stream of integer ranges. The pairs in the input stream+--   give the first and last value of each range.+--+--   The first parameter gives the size hint for the resulting stream.+-- +-- @+-- enumFromToEach 11 [(2,5), (10,16), (20,22)]+--  = [2,3,4,5,10,11,12,13,14,15,16,20,21,22]+-- @+--+enumFromToEachS :: Int -> S.Stream (Int,Int) -> S.Stream Int+{-# INLINE_STREAM enumFromToEachS #-}+enumFromToEachS n (Stream next s _) +  = Stream next' (Nothing,s) (Exact n)+  where+    {-# INLINE_INNER next' #-}+    next' (Nothing,s)+      = do+          r <- next s+          case r of+            Yield (k,m) s' -> return $ Skip (Just (k,m),s')+            Skip        s' -> return $ Skip (Nothing,   s')+            Done           -> return Done++    next' (Just (k,m),s)+      | k > m     = return $ Skip    (Nothing,     s)+      | otherwise = return $ Yield k (Just (k+1,m),s)+++-- | Create a stream of integer ranges. The triples in the input stream+--   give the first value, increment, length of each range.+--+--   The first parameter gives the size hint for the resulting stream.+--+-- @+-- enumFromStepLenEach [(1,1,5), (10,2,4), (20,3,5)]+--  = [1,2,3,4,5,10,12,14,16,20,23,26,29,32]+-- @+--               +enumFromStepLenEachS :: Int -> S.Stream (Int,Int,Int) -> S.Stream Int +{-# INLINE_STREAM enumFromStepLenEachS #-}+enumFromStepLenEachS len (Stream next s _)+  = Stream next' (Nothing,s) (Exact len)+  where+    {-# INLINE_INNER next' #-}+    next' (Nothing,s) +      = do+          r <- next s+          case r of+            Yield (from,step,len) s' -> return $ Skip (Just (from,step,len),s')+            Skip                  s' -> return $ Skip (Nothing,s')+            Done                     -> return Done++    next' (Just (from,step,0),s) = return $ Skip (Nothing,s)+    next' (Just (from,step,n),s)+      = return $ Yield from (Just (from+step,step,n-1),s)+++-- Fold -----------------------------------------------------------------------+-- | Segmented Stream fold. Take segments from the given stream and fold each+--   using the supplied function and initial element. +--+-- @+-- foldSS (+) 0 [2, 3, 2] [10, 20, 30, 40, 50, 60, 70]+--  = [30,120,130]+-- @+--+foldSS  :: (a -> b -> a)        -- ^ function to perform the fold+        -> a                    -- ^ initial element of each fold+        -> S.Stream Int         -- ^ stream of segment lengths+        -> S.Stream b           -- ^ stream of input data+        -> S.Stream a           -- ^ stream of fold results+        +{-# INLINE_STREAM foldSS #-}+foldSS f z (Stream nexts ss sz) (Stream nextv vs _) =+  Stream next (Nothing,z,ss,vs) sz+  where+    {-# INLINE next #-}+    next (Nothing,x,ss,vs) =+      do+        r <- nexts ss+        case r of+          Done        -> return Done+          Skip    ss' -> return $ Skip (Nothing,x, ss', vs)+          Yield n ss' -> return $ Skip (Just n, z, ss', vs)++    next (Just 0,x,ss,vs) =+      return $ Yield x (Nothing,z,ss,vs)+    next (Just n,x,ss,vs) =+      do+        r <- nextv vs+        case r of+          Done        -> return Done -- NEVER ENTERED (See Note)+          Skip    vs' -> return $ Skip (Just n,x,ss,vs')+          Yield y vs' -> let r = f x y+                         in r `seq` return (Skip (Just (n-1), r, ss, vs'))+++-- | Like `foldSS`, but use the first member of each chunk as the initial+--   element for the fold.+fold1SS :: (a -> a -> a) -> S.Stream Int -> S.Stream a -> S.Stream a+{-# INLINE_STREAM fold1SS #-}+fold1SS f (Stream nexts ss sz) (Stream nextv vs _) =+  Stream next (Nothing,Nothing,ss,vs) sz+  where+    {-# INLINE [0] next #-}+    next (Nothing,Nothing,ss,vs) =+      do+        r <- nexts ss+        case r of+          Done        -> return Done+          Skip    ss' -> return $ Skip (Nothing,Nothing,ss',vs)+          Yield n ss' -> return $ Skip (Just n ,Nothing,ss',vs)++    next (Just !n,Nothing,ss,vs) =+      do+        r <- nextv vs+        case r of+          Done        -> return Done -- NEVER ENTERED (See Note)+          Skip    vs' -> return $ Skip (Just n,    Nothing,ss,vs')+          Yield x vs' -> return $ Skip (Just (n-1),Just x, ss,vs')++    next (Just 0,Just x,ss,vs) =+      return $ Yield x (Nothing,Nothing,ss,vs)++    next (Just n,Just x,ss,vs) =+      do+        r <- nextv vs+        case r of+          Done        -> return Done  -- NEVER ENTERED (See Note)+          Skip    vs' -> return $ Skip (Just n    ,Just x      ,ss,vs')+          Yield y vs' -> let r = f x y+                         in r `seq` return (Skip (Just (n-1),Just r,ss,vs'))+++-- | Segmented Stream fold, with a fixed segment length.+-- +--   Like `foldSS` but use a fixed length for each segment.+--+foldValuesR +        :: (a -> b -> a)        -- ^ function to perform the fold+        -> a                    -- ^ initial element for fold+        -> Int                  -- ^ length of each segment+        -> S.Stream b           -- ^ data stream+        -> S.Stream a++{-# INLINE_STREAM foldValuesR #-}+foldValuesR f z segSize (Stream nextv vs nv) =+  Stream next (segSize,z,vs) (nv `divSize` segSize)+  where+    {-# INLINE next #-}  +    next (0,x,vs) = return $ Yield x (segSize,z,vs)++    next (n,x,vs) =+      do+        r <- nextv vs+        case r of+          Done        -> return Done+          Skip    vs' -> return $ Skip (n,x,vs')+          Yield y vs' -> let r = f x y+                         in r `seq` return (Skip ((n-1),r,vs'))+++-- | Divide a size hint by a scalar.+divSize :: Size -> Int -> Size+divSize (Exact n) k = Exact (n `div` k)+divSize (Max   n) k = Max   (n `div` k)+divSize Unknown   _ = Unknown+++-- Append ---------------------------------------------------------------------+-- | Segmented Strem append. Append corresponding segments from each stream.+--+-- @+-- appendSS [2, 1, 3] [10, 20, 30, 40, 50, 60]+--          [1, 3, 2] [11, 22, 33, 44, 55, 66]+--  = [10,20,11,30,22,33,44,40,50,60,55,66]+-- @+--+appendSS+        :: S.Stream Int         -- ^ segment lengths for first data stream+        -> S.Stream a           -- ^ first data stream+        -> S.Stream Int         -- ^ segment lengths for second data stream+        -> S.Stream a           -- ^ second data stream+        -> S.Stream a++{-# INLINE_STREAM appendSS #-}+appendSS (Stream nexts1 ss1 ns1) (Stream nextv1 sv1 nv1)+         (Stream nexts2 ss2 ns2) (Stream nextv2 sv2 nv2)+  = Stream next (True,Nothing,ss1,sv1,ss2,sv2) (nv1 + nv2)+  where+    {-# INLINE next #-}+    next (True,Nothing,ss1,sv1,ss2,sv2) =+      do+        r <- nexts1 ss1+        case r of+          Done         -> return $ Done+          Skip    ss1' -> return $ Skip (True,Nothing,ss1',sv1,ss2,sv2)+          Yield n ss1' -> return $ Skip (True,Just n ,ss1',sv1,ss2,sv2)++    next (True,Just 0,ss1,sv1,ss2,sv2)+      = return $ Skip (False,Nothing,ss1,sv1,ss2,sv2)++    next (True,Just n,ss1,sv1,ss2,sv2) =+      do+        r <- nextv1 sv1+        case r of+          Done         -> return Done  -- NEVER ENTERED (See Note)+          Skip    sv1' -> return $ Skip (True,Just n,ss1,sv1',ss2,sv2)+          Yield x sv1' -> return $ Yield x (True,Just (n-1),ss1,sv1',ss2,sv2)++    next (False,Nothing,ss1,sv1,ss2,sv2) =+      do+        r <- nexts2 ss2+        case r of+          Done         -> return Done  -- NEVER ENTERED (See Note)+          Skip    ss2' -> return $ Skip (False,Nothing,ss1,sv1,ss2',sv2)+          Yield n ss2' -> return $ Skip (False,Just n,ss1,sv1,ss2',sv2)++    next (False,Just 0,ss1,sv1,ss2,sv2)+      = return $ Skip (True,Nothing,ss1,sv1,ss2,sv2)++    next (False,Just n,ss1,sv1,ss2,sv2) =+      do+        r <- nextv2 sv2+        case r of+          Done         -> return Done  -- NEVER ENTERED (See Note)+          Skip    sv2' -> return $ Skip (False,Just n,ss1,sv1,ss2,sv2')+          Yield x sv2' -> return $ Yield x (False,Just (n-1),ss1,sv1,ss2,sv2')+++-- Indices --------------------------------------------------------------------+-- | Segmented Stream indices.+-- +-- @+-- indicesSS 15 4 [3, 5, 7]+--  = [4,5,6,0,1,2,3,4,0,1,2,3,4,5,6]+-- @+--+-- Note that we can set the starting value of the first segment independently+-- via the second argument of indicesSS. We use this when distributing arrays+-- across worker threads, as a thread's chunk may not start exactly at a +-- segment boundary, so the index of a thread's first data element may not be+-- zero.+--+indicesSS +        :: Int+        -> Int+        -> S.Stream Int+        -> S.Stream Int++{-# INLINE_STREAM indicesSS #-}+indicesSS n i (Stream next s _) =+  Stream next' (i,Nothing,s) (Exact n)+  where+    {-# INLINE next' #-}+    next' (i,Nothing,s) =+      do+        r <- next s+        case r of+          Done       -> return Done+          Skip    s' -> return $ Skip (i,Nothing,s')+          Yield k s' -> return $ Skip (i,Just k,s')++    next' (i,Just k,s)+      | k > 0     = return $ Yield i (i+1,Just (k-1),s)+      | otherwise = return $ Skip    (0  ,Nothing   ,s)++++-- Note: [NEVER ENTERED]+-- ~~~~~~~~~~~~~~~~~~~~~+--  Cases marked NEVER ENTERED should be unreachable, assuming there are no +--  bugs elsewhere in the library. We used to throw an error when these+--  branches were entered, but this was confusing the simplifier. It would be +--  better if we could put the errors back, but we'll need to check that +--  performance does not regress when we do so.

@@ -0,0 +1,222 @@+{-# LANGUAGE CPP, NoMonomorphismRestriction #-}+#include "fusion-phases.h"+module Data.Array.Parallel.Unlifted.Stream.Segments+        ( streamSegsFromNestedUSSegd+        , streamSegsFromVectorsUSSegd+        , streamSegsFromVectorsUVSegd)+where+import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Stream.Monadic+import Data.Array.Parallel.Unlifted.Sequential.Vector           (Unbox,   Vector, index)+import Data.Array.Parallel.Unlifted.Vectors                     (Unboxes, Vectors)+import Data.Array.Parallel.Unlifted.Sequential.USSegd           (USSegd(..))+import Data.Array.Parallel.Unlifted.Sequential.UVSegd           (UVSegd(..))+import qualified Data.Array.Parallel.Unlifted.Vectors           as US+import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd+import qualified Data.Array.Parallel.Unlifted.Sequential.USSegd as USSegd+import qualified Data.Array.Parallel.Unlifted.Sequential.UVSegd as UVSegd+import qualified Data.Vector.Unboxed                            as U+import qualified Data.Vector                                    as V+import qualified Data.Primitive.ByteArray                       as P+import System.IO.Unsafe+++-- Nested -----------------------------------------------------------------------------------------+-- | Stream some physical segments from many data arrays.+--- +--   * TODO: make this more efficient, and fix fusion.+--           We should be able to eliminate a lot of the indexing happening in the +--           inner loop by being cleverer about the loop state.+--+--   * TODO: If this is contiguous then we can stream the lot without worrying +--           about jumping between segments. EXCEPT that this information must be+--           statically visible else streamSegs won't fuse, so we can't have an +--           ifThenElse checking the manifest flag.+streamSegsFromNestedUSSegd+        :: (Unbox a, Monad m)+        => V.Vector (Vector a)  -- ^ Source arrays.+        -> USSegd               -- ^ Segment descriptor defining segments base on source vectors.+        -> Stream m a++streamSegsFromNestedUSSegd+        pdatas+        ussegd@(USSegd _ starts sources usegd)+ = let  +        here            = "streamSegsFromNestedUSSegd"++        -- length of each segment+        pseglens        = USegd.takeLengths usegd+ +        -- We've finished streaming this pseg+        {-# INLINE_INNER fn #-}+        fn (pseg, ix)+         -- All psegs are done.+         | pseg >= USSegd.length ussegd+         = return $ Done+         +         -- Current pseg is done+         | ix   >= pseglens `U.unsafeIndex` pseg +         = return $ Skip (pseg + 1, 0)++         -- Stream an element from this pseg+         | otherwise+         = let  !srcid   = index here sources pseg+                !pdata   = pdatas  `V.unsafeIndex` srcid+                !start   = index here starts pseg+                !result  = index here pdata  (start + ix)+           in   return $ Yield result (pseg, ix + 1)++   in   Stream fn (0, 0) Unknown+{-# INLINE_STREAM streamSegsFromNestedUSSegd #-}+++-- Vectors ----------------------------------------------------------------------------------------+-- | Stream segments from a `Vectors`.+-- +--   * There must be at least one segment in the `USSegd`, but this is not checked.+-- +--   * No bounds checking is done for the `USSegd`.+--+streamSegsFromVectorsUSSegd+        :: (Unboxes a, Monad m)+        => Vectors a            -- ^ Vectors holding source data.+        -> USSegd               -- ^ Scattered segment descriptor+        -> Stream m a++streamSegsFromVectorsUSSegd+        vectors+        ussegd@(USSegd _ segStarts segSources usegd) + = segStarts `seq` segSources `seq` usegd `seq` vectors `seq`+   let  here            = "stremSegsFromVectorsUSSegd"++        -- Length of each segment+        !segLens        = USegd.takeLengths usegd++        -- Total number of segments.+        !segsTotal      = USSegd.length ussegd+ +        -- Total number of elements to stream.+        !elements       = USegd.takeElements usegd++        -- seg, ix of that seg in usegd, length of seg, elem in seg+        {-# INLINE_INNER fnSeg #-}+        fnSeg (ixSeg, baSeg, ixEnd, ixElem)+         = ixSeg `seq` baSeg `seq`+           if ixElem >= ixEnd                   -- Was that the last elem in the current seg?+            then if ixSeg + 1 >= segsTotal      -- Was that last seg?++                       -- That was the last seg, we're done.+                  then return $ Done+                  +                       -- Move to the next seg.+                  else let ixSeg'       = ixSeg + 1+                           sourceSeg    = index here segSources ixSeg'+                           startSeg     = index here segStarts  ixSeg'+                           lenSeg       = index here segLens    ixSeg'+                           (arr, startArr, _) +                                        = US.unsafeIndexUnpack vectors sourceSeg+                       in  return $ Skip+                                  ( ixSeg'+                                  , arr+                                  , startArr + startSeg + lenSeg+                                  , startArr + startSeg)++                 -- Stream the next element from the segment.+            else let !result  = P.indexByteArray baSeg ixElem+                 in  return   $ Yield result (ixSeg, baSeg, ixEnd, ixElem + 1)+                                 +        -- Starting state of the stream.+        -- CAREFUL:+        --  The ussegd might not contain any segments, so we can't initialise the state+        --  just by taking the first segment length etc from the ussegd.+        --  On the other hand, we don't want to use an extra case expression to test for+        --  this sitution, as that could break fusion.+        --  Instead, start with a dummy state which forces the loop to grab the first +        --  segment, if there are any.+        !dummy  = unsafePerformIO +                $ P.newByteArray 0 >>= P.unsafeFreezeByteArray++        !initState+         =      ( -1    -- force fnSeg loop to load first seg+                , dummy -- dummy array data to start with+                , 0     -- force fnSeg loop to load first seg+                , 0)           ++        -- It's important that we set the result stream size, so Data.Vector+        -- doesn't need to add code to grow the result when it overflows.+   in   Stream fnSeg initState (Exact elements)+{-# INLINE_STREAM streamSegsFromVectorsUSSegd #-}++++-- Vectors ----------------------------------------------------------------------------------------+-- | Stream segments from a `Vectors`.+-- +--   * There must be at least one segment in the `USSegd`, but this is not checked.+-- +--   * No bounds checking is done for the `USSegd`.+--+streamSegsFromVectorsUVSegd+        :: (Unboxes a, Monad m)+        => Vectors a            -- ^ Vectors holding source data.+        -> UVSegd               -- ^ Scattered segment descriptor+        -> Stream m a++streamSegsFromVectorsUVSegd+        vectors+        uvsegd@(UVSegd _ _ vsegids _ (USSegd _ segStarts segSources usegd) )+ = segStarts `seq` segSources `seq` uvsegd `seq` vectors `seq`+   let  here            = "stremSegsFromVectorsUVSegd"++        !elemsTotal     = U.sum $ UVSegd.takeLengths uvsegd++        -- Total number of segments.+        !segsTotal      = UVSegd.length uvsegd+ +        -- Length of each physical segment.+        !segLens        = USegd.takeLengths usegd+        +        -- seg, ix of that seg in usegd, length of seg, elem in seg+        {-# INLINE_INNER fnSeg #-}+        fnSeg (ixSeg, baSeg, ixEnd, ixElem)+         = ixSeg `seq` baSeg `seq`+           if ixElem >= ixEnd                   -- Was that the last elem in the current seg?+            then if ixSeg + 1 >= segsTotal      -- Was that last seg?++                       -- That was the last seg, we're done.+                  then return $ Done+                  +                       -- Move to the next seg.+                  else let ixSeg'       = ixSeg + 1+                           ixPSeg       = index here vsegids    ixSeg'+                           sourceSeg    = index here segSources ixPSeg+                           startSeg     = index here segStarts  ixPSeg+                           lenSeg       = index here segLens    ixPSeg+                           (arr, startArr, _) +                                        = US.unsafeIndexUnpack vectors sourceSeg+                       in  return $ Skip+                                  ( ixSeg'+                                  , arr+                                  , startArr + startSeg + lenSeg+                                  , startArr + startSeg)++                 -- Stream the next element from the segment.+            else let !result  = P.indexByteArray baSeg ixElem+                 in  return   $ Yield result (ixSeg, baSeg, ixEnd, ixElem + 1)+                                 +        -- Starting state of the stream.+        !dummy  = unsafePerformIO +                $ P.newByteArray 0 >>= P.unsafeFreezeByteArray++        !initState+         =      ( -1    -- force fnSeg loop to load first seg+                , dummy -- dummy array data to start with+                , 0     -- force fnSeg loop to load first seg+                , 0)           ++        -- It's important that we set the result stream size, so Data.Vector+        -- doesn't need to add code to grow the result when it overflows.+   in   Stream fnSeg initState (Exact elemsTotal)+{-# INLINE_STREAM streamSegsFromVectorsUVSegd #-}++

@@ -0,0 +1,211 @@+{-# LANGUAGE BangPatterns, FlexibleInstances, UndecidableInstances, CPP #-}+#include "fusion-phases.h"++-- | Irregular two dimensional arrays.+---+--   * TODO: The inner arrays should be unboxed so we don't get an unboxing overhead+--           for every call to unsafeIndex2. This might need an extension to the GHC+--           runtime if we alwo want to convert a U.Vector directly to this form.+--+--   * TODO: We currently only allow primitive types to be in a Vectors, but +--           in future we'll want `Vectors` of tuples etc.+--+module Data.Array.Parallel.Unlifted.Vectors +        ( Vectors(..)+        , Unboxes+        , empty+        , singleton+        , length+        , unsafeIndex+        , unsafeIndex2+        , unsafeIndexUnpack+        , append+        , fromVector+        , toVector)+where+import qualified Data.Array.Parallel.Unlifted.ArrayArray as AA+import qualified Data.Primitive.ByteArray                as P+import qualified Data.Primitive.Types                    as P+import qualified Data.Primitive                          as P+import qualified Data.Vector.Generic                     as G+import qualified Data.Vector.Primitive                   as R+import qualified Data.Vector.Unboxed                     as U+import qualified Data.Vector                             as V+import Data.Vector.Unboxed                               (Unbox)+import Prelude  hiding (length)+import Data.Word+import Control.Monad.ST++-- | Class of element types that can be used in a `Vectors`+class R.Prim a => Unboxes a+instance Unboxes Int+instance Unboxes Word8+instance Unboxes Float+instance Unboxes Double+++-- | A 2-dimensional array,+--   where the inner arrays can all have different lengths.+data Vectors a+        = Vectors+                {-# UNPACK #-} !Int             -- number of inner vectors+                {-# UNPACK #-} !P.ByteArray     -- starting index of each vector in its chunk+                {-# UNPACK #-} !P.ByteArray     -- lengths of each inner vector+                {-# UNPACK #-} !(AA.ArrayArray P.ByteArray)   -- chunks+++instance (Unboxes a, Unbox a, Show a) => Show (Vectors a) where+        show = show . toVector+        {-# NOINLINE show #-}+++-- | Construct an empty `Vectors` with no arrays of no elements.+empty :: Vectors a+empty   + = runST+ $ do   mba     <- P.newByteArray 0+        ba      <- P.unsafeFreezeByteArray mba++        maa     <- AA.newArrayArray 0+        AA.writeArrayArray maa 0 ba+        aa      <- AA.unsafeFreezeArrayArray maa++        return  $ Vectors 0 ba ba aa+{-# INLINE_U empty #-}+++-- | Construct a `Vectors` containing data from a single unboxed array.+singleton :: (Unboxes a, Unbox a) => U.Vector a -> Vectors a+singleton vec + = runST+ $ do   R.MVector start len mbaData <- R.unsafeThaw $ G.convert vec+        baData          <- P.unsafeFreezeByteArray mbaData+        +        mbaStarts       <- P.newByteArray (P.sizeOf (undefined :: Int))+        P.writeByteArray mbaStarts 0 start+        baStarts        <- P.unsafeFreezeByteArray mbaStarts+        +        mbaLengths      <- P.newByteArray (P.sizeOf (undefined :: Int))+        P.writeByteArray mbaLengths 0 len+        baLengths       <- P.unsafeFreezeByteArray mbaLengths+        +        maaChunks       <- AA.newArrayArray 1+        AA.writeArrayArray maaChunks 0 baData+        aaChunks        <- AA.unsafeFreezeArrayArray maaChunks+        +        return  $ Vectors 1 baStarts baLengths aaChunks+{-# INLINE_U singleton #-}+++-- | Yield the number of vectors in a `Vectors`.+length :: Unboxes a => Vectors a -> Int+length (Vectors len _ _ _)      = len+{-# INLINE_U length #-}+++-- | Take one of the outer vectors from a `Vectors`.+unsafeIndex :: (Unboxes a, Unbox a) => Vectors a -> Int -> U.Vector a+unsafeIndex (Vectors _ starts lens arrs) ix+ = G.convert+ $ runST+ $ do   let start       = P.indexByteArray starts ix+        let len         = P.indexByteArray lens   ix+        let arr         = AA.indexArrayArray arrs ix+        marr            <- P.unsafeThawByteArray arr+        let mvec        = R.MVector start len marr+        R.unsafeFreeze mvec+{-# INLINE_U unsafeIndex #-}+++-- | Retrieve a single element from a `Vectors`, +--   given the outer and inner indices.+unsafeIndex2 :: Unboxes a => Vectors a -> Int -> Int -> a+unsafeIndex2 (Vectors _ starts _ arrs) ix1 ix2+ = (arrs `AA.indexArrayArray` ix1) `P.indexByteArray` ((starts `P.indexByteArray` ix1) + ix2)+{-# INLINE_U unsafeIndex2 #-}+++-- | Retrieve an inner array from a `Vectors`, returning the array data, +--   starting index in the data, and vector length.+unsafeIndexUnpack :: Unboxes a => Vectors a -> Int -> (P.ByteArray, Int, Int)+unsafeIndexUnpack (Vectors _ starts lens arrs) ix+ =      ( arrs   `AA.indexArrayArray` ix+        , starts `P.indexByteArray` ix+        , lens   `P.indexByteArray` ix)+{-# INLINE_U unsafeIndexUnpack #-}+++-- | Appending two `Vectors` uses work proportional to+--   the length of the outer arrays.+append :: (Unboxes a, Unbox a) => Vectors a -> Vectors a -> Vectors a+append  (Vectors len1 starts1 lens1 chunks1)+        (Vectors len2 starts2 lens2 chunks2)+ = runST+ $ do   let len' = len1 + len2++        -- append starts into result+        let lenStarts1  = P.sizeofByteArray starts1+        let lenStarts2  = P.sizeofByteArray starts2+        maStarts        <- P.newByteArray (lenStarts1 + lenStarts2)+        P.copyByteArray maStarts 0          starts1 0 lenStarts1+        P.copyByteArray maStarts lenStarts1 starts2 0 lenStarts2+        starts'         <- P.unsafeFreezeByteArray maStarts+        +        -- append lens into result+        let lenLens1    = P.sizeofByteArray lens1+        let lenLens2    = P.sizeofByteArray lens2+        maLens          <- P.newByteArray (lenLens1 + lenLens2)+        P.copyByteArray maLens   0          lens1   0 lenLens1+        P.copyByteArray maLens   lenStarts1 lens2   0 lenLens2+        lens'           <- P.unsafeFreezeByteArray maLens+        +        -- append arrs into result+        maChunks        <- AA.newArrayArray len'+        AA.copyArrayArray maChunks 0          chunks1   0 len1+        AA.copyArrayArray maChunks len1       chunks2   0 len2+        chunks'         <- AA.unsafeFreezeArrayArray maChunks+        +        let result      = Vectors len' starts' lens' chunks'+        return  $ result+{-# INLINE_U append #-}+++-- | Convert a boxed vector of unboxed vectors to a `Vectors`.+fromVector :: (Unboxes a, Unbox a) => V.Vector (U.Vector a) -> Vectors a+fromVector vecs+ = runST+ $ do   let len     = V.length vecs+        let (_, vstarts, vlens) = V.unzip3 $ V.map unpackUVector vecs+        let (baStarts, _, _)    = unpackUVector $ V.convert vstarts+        let (baLens,   _, _)    = unpackUVector $ V.convert vlens+        mchunks                 <- AA.newArrayArray len+        V.zipWithM_ +                (\i vec+                   -> let (ba, _, _)  = unpackUVector vec+                      in  AA.writeArrayArray mchunks i ba)+                (V.enumFromN 0 len)+                vecs++        chunks   <- AA.unsafeFreezeArrayArray mchunks        +        return $ Vectors len baStarts baLens chunks+{-# INLINE_U fromVector #-}+++-- | Convert a `Vectors` to a boxed vector of unboxed vectors.+toVector :: (Unboxes a, Unbox a) => Vectors a -> V.Vector (U.Vector a)+toVector vectors+        = V.map (unsafeIndex vectors)+        $ V.enumFromN 0 (length vectors)+{-# INLINE_U toVector #-}+++-- | Unpack an unboxed vector into array data, starting index, and vector length.+unpackUVector :: (Unbox a, P.Prim a) => U.Vector a -> (P.ByteArray, Int, Int)+unpackUVector vec+ = runST+ $ do   let pvec        = V.convert vec+        R.MVector start len mba <- R.unsafeThaw pvec+        ba              <- P.unsafeFreezeByteArray mba+        return  (ba, start, len)+{-# INLINE_U unpackUVector #-}+

@@ -1,38 +1,57 @@ Name:           dph-prim-seq-Version:        0.5.1.1+Version:        0.6.0.1 License:        BSD3 License-File:   LICENSE Author:         The DPH Team Maintainer:     Ben Lippmeier <benl@cse.unsw.edu.au> Homepage:       http://www.haskell.org/haskellwiki/GHC/Data_Parallel_Haskell Category:       Data Structures-Synopsis:       Sequential Primitives for Data-Parallel Haskell.+Synopsis:       Data Parallel Haskell segmented arrays. (sequential implementation)+Description:    Sequential array data type and stream fuctions, along with a+                sequential reference implementation of the segmented array+                API defined in @dph-prim-interface@.  Cabal-Version:  >= 1.6 Build-Type:     Simple  Library   Exposed-Modules:-        Data.Array.Parallel.Unlifted.Sequential.Segmented-        Data.Array.Parallel.Unlifted.Sequential.Segmented.USegd-        Data.Array.Parallel.Unlifted.Sequential.Vector         Data.Array.Parallel.Unlifted.Sequential.USel+        Data.Array.Parallel.Unlifted.Sequential.USegd+        Data.Array.Parallel.Unlifted.Sequential.USSegd+        Data.Array.Parallel.Unlifted.Sequential.UVSegd+        Data.Array.Parallel.Unlifted.Sequential.Vector+        Data.Array.Parallel.Unlifted.Sequential+        Data.Array.Parallel.Unlifted.Stream+        Data.Array.Parallel.Unlifted.Vectors+        Data.Array.Parallel.Unlifted.ArrayArray         Data.Array.Parallel.Unlifted+           Other-Modules:-        Data.Array.Parallel.Unlifted.Sequential.Segmented.Basics-        Data.Array.Parallel.Unlifted.Sequential.Segmented.Combinators-        Data.Array.Parallel.Unlifted.Sequential.Segmented.Sums-        Data.Array.Parallel.Unlifted.Sequential.Segmented.Text+        Data.Array.Parallel.Unlifted.Sequential.Basics+        Data.Array.Parallel.Unlifted.Sequential.Combinators+        Data.Array.Parallel.Unlifted.Sequential.Sums+        Data.Array.Parallel.Unlifted.Sequential.Extracts+        Data.Array.Parallel.Unlifted.Stream.Segmented+        Data.Array.Parallel.Unlifted.Stream.Ixs+        Data.Array.Parallel.Unlifted.Stream.Elems+        Data.Array.Parallel.Unlifted.Stream.Segments+      Exposed: False    Extensions: TypeFamilies, GADTs, RankNTypes,-              BangPatterns, MagicHash, UnboxedTuples, TypeOperators-  GHC-Options: -Odph -funbox-strict-fields -fcpr-off+              BangPatterns, MagicHash, UnboxedTuples, TypeOperators,+              NoMonomorphismRestriction+  GHC-Options:+        -Odph -Wall+        -funbox-strict-fields -fcpr-off    Build-Depends:  -        base     == 4.4.*,-        random   == 1.0.*,-        vector   == 0.7.*,-        dph-base == 0.5.*,-        dph-prim-interface == 0.5.*+        base      == 4.5.*,+        random    == 1.0.*,+        vector    == 0.9.*,+        primitive == 0.4.*,+        ghc-prim  == 0.2.*,+        dph-base  == 0.6.*,+        dph-prim-interface == 0.6.*