dph-prim-seq 0.6.1.1 → 0.7.0.1

raw patch · 9 files changed

+219/−52 lines, 9 filesdep ~basedep ~dph-basedep ~dph-prim-interfacePVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• Data/Array/Parallel/Unlifted.hs +7/−1
• Data/Array/Parallel/Unlifted/Sequential/Extracts.hs +15/−1
• Data/Array/Parallel/Unlifted/Sequential/USSegd.hs +22/−15
• Data/Array/Parallel/Unlifted/Sequential/USegd.hs +5/−3
• Data/Array/Parallel/Unlifted/Sequential/UVSegd.hs +27/−10
• Data/Array/Parallel/Unlifted/Sequential/Vector.hs +9/−5
• Data/Array/Parallel/Unlifted/Stream/Segments.hs +104/−10
• Data/Array/Parallel/Unlifted/Vectors.hs +23/−0
• dph-prim-seq.cabal +7/−7

@@ -34,7 +34,13 @@ -- Constructors --------------------------------------------------------------- empty                           = U.empty (+:+)                           = (U.++)-append_s _                      = appendSU+append_s _ xd xs yd ys          = appendSU xd xs yd ys+append_vs _ xd xs yd ys         = appendSU xd' xs' yd' ys'+ where  xd' = unsafeDemoteToSegdOfVSegd xd+        yd' = unsafeDemoteToSegdOfVSegd yd+        xs' = extractsFromVectorsUVSegd xd xs+        ys' = extractsFromVectorsUVSegd yd ys+ replicate                       = U.replicate replicate_s                     = replicateSU replicate_rs                    = replicateRSU

@@ -10,7 +10,8 @@           -- * Scattered extracts         , extractsFromNestedUSSegd         , extractsFromVectorsUSSegd-        , extractsFromVectorsUVSegd)+        , extractsFromVectorsUVSegd+        , extractsFromVectorsUSSegdSegmap) where import Data.Array.Parallel.Unlifted.Stream                      as US import Data.Array.Parallel.Unlifted.Vectors                     as US@@ -76,3 +77,16 @@ extractsFromVectorsUVSegd uvsegd vectors         = U.unstream  $ US.streamSegsFromVectorsUVSegd vectors uvsegd {-# INLINE_U extractsFromVectorsUVSegd #-}+++-- | Copy segments defined by a segmap and `USSegd` into a new array.+extractsFromVectorsUSSegdSegmap+        :: (Unbox a, US.Unboxes a)+        => USSegd+        -> Vector  Int+        -> Vectors a+        -> Vector  a++extractsFromVectorsUSSegdSegmap ussegd segmap vectors+        = U.unstream $ US.streamSegsFromVectorsUSSegdSegmap vectors ussegd segmap+

@@ -36,6 +36,7 @@ import Prelude                                                  hiding (length) import qualified Data.Array.Parallel.Unlifted.Sequential.USegd  as USegd import qualified Data.Array.Parallel.Unlifted.Sequential.Vector as U+import Debug.Trace  here :: String -> String  here s = "Data.Array.Parallel.Unlifted.Sequential.USSegd." ++ s@@ -215,10 +216,13 @@ 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)+ = traceEvent +        (  "dph-prim-seq: USSegd.appendWith."+        ++ " length(result) = " ++ show (U.length starts1 + U.length starts2))+ $ 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. @@ -230,7 +234,10 @@ 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.+   traceEvent +        (  "dph-prim-seq: USSegd.cullOnVSegids."+        ++ " length(segmap) = " ++ show (U.length vsegids))+ $ 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@@ -239,7 +246,7 @@         --   => psegids_used:   [1 1 0 1 0 1 1]         --           --  Note that psegids '2' and '4' are not in vsegids_packed.-        psegids_used+        !psegids_used          = U.bpermuteDft (USegd.length usegd)                          (const False)                          (U.zip vsegids (U.replicate (U.length vsegids) True))@@ -247,7 +254,7 @@         -- 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+        !psegids_packed          = U.pack (U.enumFromTo 0 (U.length psegids_used)) psegids_used          -- Produce an array that maps psegids in the source array onto@@ -260,7 +267,7 @@         --  eg  psegids_packed: [0 1 3 5 6]         --                      [0 1 2 3 4]         --      psegids_map:    [0 1 -1 2 -1 3 4]-        psegids_map+        !psegids_map          = U.bpermuteDft (USegd.length usegd)                          (const (-1))                          (U.zip psegids_packed (U.enumFromTo 0 (U.length psegids_packed - 1)))@@ -273,18 +280,18 @@         --          --      vsegids':       [0 1 1 2 3 3 4 4]         ---        vsegids'  = U.map (U.index (here "cullOnVSegids") psegids_map) vsegids+        !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+        !starts'   = U.pack starts  psegids_used+        !sources'  = U.pack sources psegids_used -        lengths'  = U.pack (USegd.takeLengths usegd) psegids_used-        usegd'    = USegd.fromLengths lengths'+        !lengths'  = U.pack (USegd.takeLengths usegd) psegids_used+        !usegd'    = USegd.fromLengths lengths'         -        ussegd'   = USSegd False starts' sources' usegd'+        !ussegd'   = USSegd False starts' sources' usegd' -     in  (vsegids', ussegd')+     in (vsegids', ussegd')  {-# NOINLINE cullOnVSegids #-} --  NOINLINE because it's complicated and won't fuse with anything

@@ -27,6 +27,7 @@ import Data.Array.Parallel.Unlifted.Sequential.Vector           (Vector) import Data.Array.Parallel.Pretty                               hiding (empty) import Prelude                                                  hiding (length)+import Debug.Trace  here :: String -> String  here s = "Data.Array.Parallel.Unlifted.Sequential.USegd." ++ s@@ -138,11 +139,12 @@ --   two arrays. append :: USegd -> USegd -> USegd append (USegd lengths1 indices1 elems1)-            (USegd lengths2 indices2 elems2)- = USegd (lengths1 U.++ lengths2)+       (USegd lengths2 indices2 elems2)+ = traceEvent ("dph-prim-seq: USegd.append")+ $ USegd (lengths1 U.++ lengths2)          (indices1 U.++ U.map (+ elems1) indices2)          (elems1 + elems2)-{-# INLINE_U append #-}+{-# NOINLINE append #-}   -- | O(segs) Extract a slice of a segment descriptor, avoiding copying where possible.

@@ -49,6 +49,7 @@ 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+import Debug.Trace  here :: String -> String  here s = "Data.Array.Parallel.Unlifted.Sequential.UVSegd." ++ s@@ -307,9 +308,13 @@ --  unsafeDemoteToUSSegd :: UVSegd -> USSegd unsafeDemoteToUSSegd uvsegd- | uvsegd_manifest uvsegd       = uvsegd_ussegd_culled uvsegd           -- TODO: take the redundant ones- | otherwise- = let  vsegids         = uvsegd_vsegids_culled uvsegd+ = traceEvent +        (  "dph-prim-seq: UVSegd.unsafeDemoteToUSSSegd"+        ++ " length(segmap) = " ++ show (U.length $ takeVSegids uvsegd))+ $ if uvsegd_manifest uvsegd    +    then uvsegd_ussegd_culled uvsegd           -- TODO: take the redundant ones+    else 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@@ -333,7 +338,10 @@ -- unsafeDemoteToUSegd :: UVSegd -> USegd unsafeDemoteToUSegd (UVSegd _ _ vsegids _ ussegd)-        = USegd.fromLengths+ = traceEvent+        (  "dph-prim-seq: UVSegd.unsafeDemoteToUSegd"+        ++ " length(segmap) = " ++ show (U.length vsegids))+ $ USegd.fromLengths         $ U.bpermute (USSegd.takeLengths ussegd) vsegids {-# NOINLINE unsafeDemoteToUSegd #-} --  NOINLINE because it won't fuse with anything.@@ -433,7 +441,11 @@         (UVSegd _ _ vsegids1 _ ussegd1) pdatas1         (UVSegd _ _ vsegids2 _ ussegd2) pdatas2 - = let  -- vsegids releative to appended psegs+ = traceEvent +        (  "dph-prim-seq: UVSegd.appendWith"+        ++ "length(result) = " ++ (show $ U.length vsegids1 + U.length vsegids2))+ $ let  +        -- vsegids releative to appended psegs         vsegids1' = vsegids1         vsegids2' = U.map (+ USSegd.length ussegd1) vsegids2         @@ -446,7 +458,7 @@                                 ussegd2 pdatas2                                      in   UVSegd False vsegids' vsegids' ussegd' ussegd'-{-# INLINE_U appendWith #-}+{-# NOINLINE appendWith #-}   -- combine --------------------------------------------------------------------@@ -484,16 +496,20 @@ combine2         :: USel2       -- ^ Selector for the combine operation.         -> UVSegd      -- ^ Descriptor of first array.-        -> Int          -- ^ Number of flat physical arrays for first descriptor.+        -> Int         -- ^ Number of flat physical arrays for first descriptor.         -> UVSegd      -- ^ Descriptor of second array.-        -> Int          -- ^ Number of flat physical arrays for second descriptor.+        -> 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+ = traceEvent+        (  "dph-prim-seq: UVSegd.combine2"+        ++ "length(result) = " ++ show (U.length $ tagsUSel2 usel2))+ $ let  +        -- vsegids relative to combined psegs         vsegids1' = vsegids1         vsegids2' = U.map (+ (U.length vsegids1)) vsegids2 @@ -507,4 +523,5 @@                                 ussegd2 pdatas2                                       in   UVSegd False vsegids' vsegids' ussegd' ussegd'-{-# INLINE_U combine2 #-}+{-# NOINLINE combine2 #-}+

@@ -186,13 +186,14 @@ 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+        $ V.unsafeSlice i n xs {-# INLINE_U slice #-}   -- 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+unsafeSlice xs i n +        = V.unsafeSlice i n xs {-# INLINE_U unsafeSlice #-}  @@ -205,9 +206,10 @@  -- Copy out a subrange of a vector. extract :: Unbox a => Vector a -> Int -> Int -> Vector a+extract xs i n+        = B.checkSlice "extract" (V.length xs) i n+        $ force (V.unsafeSlice i n xs) {-# INLINE_U extract #-}-extract xs i n -        = force (V.slice i n xs)   -- Copy out a subrange of a vector, without bounds checks.@@ -478,7 +480,9 @@   mslice :: Unbox a => Int -> Int -> MVector s a -> MVector s a-mslice = M.slice+mslice i n xs+        = B.checkSlice "mslice" (M.length xs) i n+        $ M.unsafeSlice i n xs {-# INLINE mslice #-}  

@@ -3,19 +3,21 @@ module Data.Array.Parallel.Unlifted.Stream.Segments         ( streamSegsFromNestedUSSegd         , streamSegsFromVectorsUSSegd-        , streamSegsFromVectorsUVSegd)+        , streamSegsFromVectorsUVSegd+        , streamSegsFromVectorsUSSegdSegmap+        , streamSegsFromVectorsUSSegd_split) 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.USegd            (USegd(..)) 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.Array.Parallel.Unlifted.Sequential.Vector as U import qualified Data.Vector                                    as V import qualified Data.Primitive.ByteArray                       as P import System.IO.Unsafe@@ -55,7 +57,7 @@          = return $ Done                    -- Current pseg is done-         | ix   >= pseglens `U.unsafeIndex` pseg +         | ix   >= U.index here pseglens pseg           = return $ Skip (pseg + 1, 0)           -- Stream an element from this pseg@@ -164,14 +166,29 @@  streamSegsFromVectorsUVSegd         vectors-        uvsegd@(UVSegd _ _ vsegids _ (USSegd _ segStarts segSources usegd) )- = segStarts `seq` segSources `seq` uvsegd `seq` vectors `seq`+        (UVSegd _ _ segmap _ ussegd)+ = streamSegsFromVectorsUSSegdSegmap vectors ussegd segmap+{-# INLINE_STREAM streamSegsFromVectorsUVSegd #-}+++streamSegsFromVectorsUSSegdSegmap+        :: (Unboxes a, Monad m)+        => Vectors a            -- ^ Vectors holding source data.+        -> USSegd               -- ^ Scattered segment descriptor+        -> Vector Int           -- ^ Segmap+        -> Stream m a++streamSegsFromVectorsUSSegdSegmap+        vectors ussegd@(USSegd _ segStarts segSources usegd) segmap+ = segStarts `seq` segSources `seq` usegd `seq` segmap `seq`    let  here            = "stremSegsFromVectorsUVSegd" -        !elemsTotal     = U.sum $ UVSegd.takeLengths uvsegd+        -- Total number of elements to be streamed+        !lengths        = USSegd.takeLengths ussegd+        !elemsTotal     = U.sum $ U.map (U.index here lengths) segmap          -- Total number of segments.-        !segsTotal      = UVSegd.length uvsegd+        !segsTotal      = U.length segmap           -- Length of each physical segment.         !segLens        = USegd.takeLengths usegd@@ -188,7 +205,7 @@                                           -- Move to the next seg.                   else let ixSeg'       = ixSeg + 1-                           ixPSeg       = index here vsegids    ixSeg'+                           ixPSeg       = index here segmap     ixSeg'                            sourceSeg    = index here segSources ixPSeg                            startSeg     = index here segStarts  ixPSeg                            lenSeg       = index here segLens    ixPSeg@@ -217,6 +234,83 @@         -- 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 #-}+{-# INLINE_STREAM streamSegsFromVectorsUSSegdSegmap #-} ++++streamSegsFromVectorsUSSegd_split+        :: (Unboxes a, Monad m)+        => Vectors a            -- ^ Vectors holding source data.+        -> USSegd               -- ^ Scattered segment descriptor+        -> Vector Int           -- ^ Virtual segment ids+        -> ((USegd,Int),Int)    -- ^ Segmap+        -> Stream m a++streamSegsFromVectorsUSSegd_split+        !vectors !ussegd+        !vsegids ((!segd,!seg_off),!el_off)+ = let  here            = "streamSegsFromVectorsUSSegd_split"++        -- Total number of elements to be streamed+        !lengths        = USegd.takeLengths segd+        !elemsTotal     = U.sum lengths++        -- Total number of segments.+        !segsTotal      = U.length lengths++        !segStarts      = USSegd.takeStarts  ussegd+        !segSources     = USSegd.takeSources ussegd++        vsegid seg      = index here vsegids    (seg + seg_off)+        {-# INLINE vsegid #-}+        source pseg     = index here segSources  pseg+        {-# INLINE source #-}+        start  pseg     = index here segStarts   pseg+        {-# INLINE start #-}+        len    seg      = index here lengths     seg+        {-# INLINE len #-}++        -- seg, ix of that seg in usegd, length of seg, elem in seg+        {-# INLINE_INNER fnSeg #-}+        fnSeg (!ixSeg, !baSeg, !ixEnd, !ixElem)+         = 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       = vsegid ixSeg'+                           sourceSeg    = source ixPSeg+                           startSeg     = start  ixPSeg+                           lenSeg       = len    ixSeg'+                           el_off'      = if ixSeg' == 0 then el_off else 0+                           (arr, startArr, _) +                                        = US.unsafeIndexUnpack vectors sourceSeg+                       in  return $ Skip+                                  ( ixSeg'+                                  , arr+                                  , startArr + startSeg + el_off' + lenSeg+                                  , startArr + startSeg + el_off')++                 -- 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 streamSegsFromVectorsUSSegd_split #-} 

@@ -16,6 +16,8 @@         , empty         , singleton         , length+        , index+        , index2         , unsafeIndex         , unsafeIndex2         , unsafeIndexUnpack@@ -23,6 +25,7 @@         , fromVector         , toVector) where+import qualified Data.Array.Parallel.Base       as B import qualified Data.Array.Parallel.Unlifted.ArrayArray as AA import qualified Data.Primitive.ByteArray                as P import qualified Data.Primitive.Types                    as P@@ -116,13 +119,33 @@         R.unsafeFreeze mvec {-# INLINE_U unsafeIndex #-} +-- | Take one of the outer vectors from a `Vectors`, with bounds checking+index   :: (Unboxes a, Unbox a)+        => String -- ^ source position+        -> Vectors a -> Int -> U.Vector a+index here vec ix+        = B.check here (length vec) ix+        $ unsafeIndex  vec ix+{-# INLINE_U index #-} + -- | 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 a single element from a `Vectors`, +--   given the outer and inner indices, with bounds checking.+index2  :: Unboxes a+        => String -- ^ source position+        -> Vectors a -> Int -> Int -> a+index2 here vec@(Vectors _ _ lens _) ix1 ix2+        = B.check (here++"(index2.ix1)") (length vec) ix1+        $ B.check (here++"(index2.ix2)") (lens `P.indexByteArray` ix1) ix2+        $ unsafeIndex2 vec ix1 ix2+{-# INLINE_U index2 #-}   -- | Retrieve an inner array from a `Vectors`, returning the array data, 

@@ -1,5 +1,5 @@ Name:           dph-prim-seq-Version:        0.6.1.1+Version:        0.7.0.1 License:        BSD3 License-File:   LICENSE Author:         The DPH Team@@ -48,10 +48,10 @@         -funbox-strict-fields -fcpr-off    Build-Depends:  -        base      == 4.5.*,+        base      == 4.6.*,         random    == 1.0.*,-        vector    == 0.9.*,-        primitive == 0.4.*,-        ghc-prim  == 0.2.*,-        dph-base  == 0.6.1.*,-        dph-prim-interface == 0.6.1.*+        vector    == 0.10.*,+        primitive == 0.5.*,+        ghc-prim  == 0.3.*,+        dph-base  == 0.7.*,+        dph-prim-interface == 0.7.*