dph-prim-par: add flag saying whether VSegd is manifest to short cut demotion to...
authorBen Lippmeier <benl@ouroborus.net>
Fri, 7 Oct 2011 08:11:55 +0000 (19:11 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Tue, 11 Oct 2011 04:11:43 +0000 (15:11 +1100)
dph-common-vseg/Data/Array/Parallel/Lifted/Combinators.hs
dph-common-vseg/Data/Array/Parallel/PArray.hs
dph-common-vseg/Data/Array/Parallel/PArray/PData/Base.hs
dph-common-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPVSegd.hs

index 6ca3a63..54b483b 100644 (file)
@@ -4,6 +4,7 @@
         FlexibleInstances, FlexibleContexts,
         RankNTypes, ExistentialQuantification,
         StandaloneDeriving, TypeOperators #-}
+{-# OPTIONS -fno-spec-constr #-}
 #include "fusion-phases.h"
 
 -- | Define closures for each of the combinators the vectoriser uses.
index 8702324..338c6ae 100644 (file)
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS -fno-spec-constr #-}
 #include "fusion-phases.h"
 
 -- | Functions that work directly on PArrays.
@@ -227,17 +228,12 @@ fromUArray2PA arr
 -- | O(1). Create a nested array from a segment descriptor and some flat data.
 --   The segment descriptor must represent as many elements as present
 --   in the flat data array, else `error`
-{-# INLINE_PA nestUSegdPA #-}
+{-# NOINLINE nestUSegdPA #-}
 nestUSegdPA :: U.Segd -> PArray a -> PArray (PArray a)
-nestUSegdPA segd (PArray n darr)
+nestUSegdPA segd (PArray n pdata)
         | U.elementsSegd segd     == n
         = PArray (U.lengthSegd segd)
-       $ mkPNested     
-               (U.enumFromTo 0 (U.lengthSegd segd - 1))
-               (U.lengthsSegd segd)
-               (U.indicesSegd segd)
-               (U.replicate (U.lengthSegd segd) 0)
-               (V.singleton darr)
+       $ PNested (U.promoteSegdToVSegd segd) (V.singleton pdata)       
 
         | otherwise
         = error $ unlines
index c83e341..7ddba2c 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE 
         CPP,
+        BangPatterns,
         TypeFamilies, MultiParamTypeClasses,
         FlexibleContexts, ExplicitForAll,
         StandaloneDeriving,
@@ -20,6 +21,7 @@ module Data.Array.Parallel.PArray.PData.Base
 where
 import qualified Data.Array.Parallel.Unlifted   as U
 import qualified Data.Vector                    as V
+import qualified Data.Vector.Unboxed            as VU
 import Data.Vector                              (Vector)
 import Data.Array.Parallel.Base                 (Tag)
 import Data.Array.Parallel.Pretty
@@ -185,11 +187,15 @@ uextracts arrs srcids ixBase lens
         -- starting indices for each of the segments in the result
         startixs' = U.replicate_s segd startixs
 
-        result    = U.zipWith3
-                        (\ixDst ixSegDst (ixSegSrcBase, srcid)
-                                -> (arrs V.!  srcid) U.!: (ixDst - ixSegDst + ixSegSrcBase))
+        {-# INLINE get #-}
+        get ixDst ixSegDst (ixSegSrcBase, srcid)
+         = let  !arr    = arrs `V.unsafeIndex` srcid
+                !ix     = ixDst - ixSegDst + ixSegSrcBase
+           in   arr `VU.unsafeIndex` ix
+         
+        result    = U.zipWith3 get
                         (U.enumFromTo 0 (dstLen - 1))
                         startixs'
                         (U.zip baseixs srcids')
-   in result
 
+   in result
index be62140..57819e2 100644 (file)
@@ -9,6 +9,8 @@
         UndecidableInstances,
         ParallelListComp #-}
 
+{-# OPTIONS -fno-spec-constr #-}
+
 #include "fusion-phases.h"
 
 module Data.Array.Parallel.PArray.PData.Nested 
@@ -35,8 +37,9 @@ import Data.Array.Parallel.PArray.PData.Base
 import Data.Array.Parallel.Base
 
 import qualified Data.IntSet                    as IS
-import qualified Data.Vector                    as V
 import qualified Data.Array.Parallel.Unlifted   as U
+import qualified Data.Vector                    as V
+import qualified Data.Vector.Unboxed            as VU
 import Text.PrettyPrint
 
 
@@ -348,34 +351,37 @@ instance PR a => PR (PArray a) where
   --  We encode these offsets in the psrcoffset vector:
   --       psrcoffset :  [0, 2]
   --
-  {-# NOINLINE extractsPR #-}
+  {-# INLINE extractsPR #-}
   extractsPR arrs segsrcs segstarts seglens 
-   = let segMax         = U.sum seglens - 1
-         vsegids'       = U.enumFromTo 0 segMax
-
-         vsegids_src    = uextracts (V.map pnested_vsegids  arrs) segsrcs segstarts seglens
-         srcids'        = U.replicate_s (U.lengthsToSegd seglens) segsrcs
-
-         -- TODO: use getSegOfUVSegd like in indexlPR
-         pseglens'      = U.zipWith (\srcid vsegid -> pnested_pseglens   (arrs V.! srcid) U.!: vsegid)
-                                    srcids' vsegids_src
-
-         psegstarts'    = U.zipWith (\srcid vsegid -> pnested_psegstarts (arrs V.! srcid) U.!: vsegid)
-                                    srcids' vsegids_src
+   = let vsegids_src      = uextracts (V.map pnested_vsegids  arrs) segsrcs segstarts seglens
+         srcids'          = U.replicate_s (U.lengthsToSegd seglens) segsrcs
 
          -- See Note: psrcoffset
-         psrcoffset     = V.prescanl (+) 0 $ V.map (V.length . pnested_psegdata) arrs
-
-         psegsrcs'      = U.zipWith 
-                                (\srcid vsegid 
-                                        -> (pnested_psegsrcids   (arrs V.! srcid) U.!: vsegid)
-                                        +  psrcoffset V.! srcid)
-                                srcids' vsegids_src
+         psrcoffset       = V.prescanl (+) 0 $ V.map (V.length . pnested_psegdata) arrs
+
+         !arrs_pseglens   = V.map pnested_pseglens   arrs
+         !arrs_psegstarts = V.map pnested_psegstarts arrs
+         !arrs_psegsrcids = V.map pnested_psegsrcids arrs
+
+         {-# INLINE get #-}
+         get srcid vsegid
+          = let !pseglen        = (arrs_pseglens   `V.unsafeIndex` srcid) `VU.unsafeIndex` vsegid
+                !psegstart      = (arrs_psegstarts `V.unsafeIndex` srcid) `VU.unsafeIndex` vsegid
+                !psegsrcid      = (arrs_psegsrcids `V.unsafeIndex` srcid) `VU.unsafeIndex` vsegid  
+                                + psrcoffset `V.unsafeIndex` srcid
+            in  (pseglen, psegstart, psegsrcid)
+            
+         (pseglens', psegstarts', psegsrcs')
+                = U.unzip3 $ U.zipWith get srcids' vsegids_src
 
          -- All flat data arrays in the sources go into the result.
          psegdata'      = V.concat $ V.toList $ V.map pnested_psegdata arrs
    
-     in  mkPNested vsegids' pseglens' psegstarts' psegsrcs' psegdata'
+         vsegd'         = U.promoteSSegdToVSegd
+                        $ U.mkSSegd psegstarts' psegsrcs'
+                        $ U.lengthsToSegd pseglens'
+   
+     in  PNested vsegd' psegdata'
 
 
   -- Append nested arrays by appending the segment descriptors,
@@ -486,7 +492,7 @@ instance PR a => PR (PArray a) where
 --    and not copy each segment individually.
 -- 
 concatPR :: PR a => PData (PArray a) -> PData a
-{-# INLINE_PDATA concatPR #-}
+{-# INLINE concatPR #-}
 concatPR (PNested uvsegd psegdata)
  = let  -- Flatten out the virtualization of the uvsegd so that we have
         -- a description of each segment individually.
@@ -508,7 +514,7 @@ concatPR (PNested uvsegd psegdata)
 --   segmentation of the template array.
 --
 unconcatPR :: PR a => PData (PArray a) -> PData b -> PData (PArray b)
-{-# INLINE_PDATA unconcatPR #-}
+{-# INLINE unconcatPR #-}
 unconcatPR (PNested vsegd pdatas) arr
  = let  
         -- Get the lengths of all the vsegs individually.
@@ -525,7 +531,7 @@ unconcatPR (PNested vsegd pdatas) arr
 -- | Lifted concat.
 --   Both arrays must contain the same number of elements.
 concatlPR :: PR a => PData (PArray (PArray a)) -> PData (PArray a)
-{-# NOINLINE concatlPR #-}
+{-# INLINE concatlPR #-}
 concatlPR arr
  = let  (segd1, darr1)  = unsafeFlattenPR arr
         (segd2, darr2)  = unsafeFlattenPR darr1
index 843c3be..b1d05aa 100644 (file)
@@ -58,14 +58,27 @@ import qualified Data.Array.Parallel.Unlifted.Parallel.UPSSegd  as UPSSegd
 --
 data UPVSegd 
         = UPVSegd 
-        { upvsegd_vsegids       :: !(Vector Int)
+        { _upvsegd_vsegsManifest :: !Bool
+          -- ^ When the vsegids field holds a lazy (V.enumFromTo 0 (len - 1))
+          --   then this field is True. This lets us perform some operations like
+          --   demoteToUPSSegd without actually creating it.
+        
+        , upvsegd_vsegids       :: Vector Int
+          -- ^ Virtual segment identifiers that indicate what physical segment
+          --   to use for each virtual segment. 
+          --
+          --   IMPORTANT:
+          ---   This field must 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.
+          
         , upvsegd_upssegd       :: !UPSSegd }
         deriving (Show)
 
 
 -- | Pretty print the physical representation of a `UVSegd`
 instance PprPhysical UPVSegd where
- pprp (UPVSegd vsegids upssegd)
+ pprp (UPVSegd vsegids upssegd)
   = vcat
   [ text "UPVSegd" $$ (nest 7 $ text "vsegids: " <+> (text $ show $ V.toList vsegids))
   , pprp upssegd ]
@@ -76,8 +89,7 @@ instance PprPhysical UPVSegd where
 --   * TODO: this doesn't do any checks yet.
 --\b
 valid :: UPVSegd -> Bool
-valid (UPVSegd _ _)
-        = True
+valid UPVSegd{} = True
 {-# NOINLINE valid #-}
 --  NOINLINE because it's only used during debugging anyway.
 
@@ -89,7 +101,7 @@ mkUPVSegd
         -> UPSSegd      -- ^ Scattered segment descriptor defining the physical segments.
         -> UPVSegd
 
-mkUPVSegd = UPVSegd
+mkUPVSegd = UPVSegd False
 {-# INLINE_UP mkUPVSegd #-}
 
 
@@ -101,7 +113,7 @@ mkUPVSegd = UPVSegd
 --
 fromUPSSegd :: UPSSegd -> UPVSegd
 fromUPSSegd upssegd
-        = UPVSegd 
+    = UPVSegd   True
                 (V.enumFromTo 0 (UPSSegd.length upssegd - 1))
                 upssegd
 {-# INLINE_UP fromUPSSegd #-}
@@ -119,7 +131,7 @@ fromUPSegd      = fromUPSSegd . UPSSegd.fromUPSegd
 
 -- | O(1). Yield an empty segment descriptor, with no elements or segments.
 empty :: UPVSegd
-empty           = UPVSegd V.empty UPSSegd.empty
+empty           = UPVSegd True V.empty UPSSegd.empty
 {-# INLINE_UP empty #-}
 
 
@@ -127,7 +139,7 @@ empty           = UPVSegd V.empty UPSSegd.empty
 --   The single segment covers the given number of elements in a flat array
 --   with sourceid 0.
 singleton :: Int -> UPVSegd
-singleton n     = UPVSegd (V.singleton 0) (UPSSegd.singleton n)
+singleton n     = UPVSegd True (V.singleton 0) (UPSSegd.singleton n)
 {-# INLINE_UP singleton #-}
 
 
@@ -154,9 +166,10 @@ takeUPSSegd     = upvsegd_upssegd
 
 -- | O(segs). Yield the lengths of the segments described by a `UPVSegd`.
 takeLengths :: UPVSegd -> Vector Int
-takeLengths (UPVSegd vsegids upssegd)
-        = V.map (UPSSegd.takeLengths upssegd V.!) vsegids
-{-# INLINE_UP takeLengths #-}
+takeLengths (UPVSegd manifest vsegids upssegd)
+ | manifest     = UPSSegd.takeLengths upssegd
+ | otherwise    = V.map (UPSSegd.takeLengths upssegd V.!) vsegids
+{-# NOINLINE takeLengths #-}
 
 
 -- | O(1). Get the length, starting index, and source id of a segment.
@@ -167,7 +180,7 @@ takeLengths (UPVSegd vsegids upssegd)
 --        to a UVSegd index it could overflow.
 --
 getSeg :: UPVSegd -> Int -> (Int, Int, Int)
-getSeg (UPVSegd vsegids upssegd) ix
+getSeg (UPVSegd vsegids upssegd) ix
  = let  (len, _index, start, source) = UPSSegd.getSeg upssegd (vsegids V.! ix)
    in   (len, start, source)
 {-# INLINE_UP getSeg #-}
@@ -184,7 +197,10 @@ getSeg (UPVSegd vsegids upssegd) ix
 --     segmentation from a nested array.
 -- 
 demoteToUPSSegd :: UPVSegd -> UPSSegd
-demoteToUPSSegd (UPVSegd vsegids upssegd)
+demoteToUPSSegd (UPVSegd True _vsegids upssegd)
+ = upssegd
+
+demoteToUPSSegd (UPVSegd False vsegids upssegd)
  = let  starts'         = bpermuteUP (UPSSegd.takeStarts  upssegd) vsegids
         sources'        = bpermuteUP (UPSSegd.takeSources upssegd) vsegids
         lengths'        = bpermuteUP (UPSSegd.takeLengths upssegd) vsegids
@@ -209,7 +225,7 @@ demoteToUPSSegd (UPVSegd vsegids upssegd)
 --   because the program would OOM anyway.
 --
 unsafeDemoteToUPSegd :: UPVSegd -> UPSegd
-unsafeDemoteToUPSegd (UPVSegd vsegids upssegd)
+unsafeDemoteToUPSegd (UPVSegd vsegids upssegd)
         = UPSegd.fromLengths
         $ bpermuteUP (UPSSegd.takeLengths upssegd) vsegids
 {-# NOINLINE unsafeDemoteToUPSegd #-}
@@ -225,12 +241,12 @@ unsafeDemoteToUPSegd (UPVSegd vsegids upssegd)
 --     the UPSSegd.
 -- 
 updateVSegs :: (Vector Int -> Vector Int) -> UPVSegd -> UPVSegd
-updateVSegs f (UPVSegd vsegids upssegd)
+updateVSegs f (UPVSegd vsegids upssegd)
  = let  (vsegids', ussegd') 
                 = USSegd.cullOnVSegids (f vsegids) 
                 $ UPSSegd.takeUSSegd upssegd
 
-   in   UPVSegd vsegids' (UPSSegd.fromUSSegd ussegd')
+   in   UPVSegd False vsegids' (UPSSegd.fromUSSegd ussegd')
 {-# INLINE_UP updateVSegs #-}
 
 
@@ -245,8 +261,8 @@ appendWith
         -> UPVSegd
 
 appendWith
-        (UPVSegd vsegids1 upssegd1) pdatas1
-        (UPVSegd vsegids2 upssegd2) pdatas2
+        (UPVSegd vsegids1 upssegd1) pdatas1
+        (UPVSegd vsegids2 upssegd2) pdatas2
 
  = let  -- vsegids releative to appended psegs
         vsegids1' = vsegids1
@@ -260,8 +276,8 @@ appendWith
                                 upssegd1 pdatas1
                                 upssegd2 pdatas2
                                  
-   in   UPVSegd vsegids' upssegd'
-{-# INLINE_UP appendWith #-}
+   in   UPVSegd False vsegids' upssegd'
+{-# NOINLINE appendWith #-}
 
 
 -- Combine --------------------------------------------------------------------
@@ -277,8 +293,8 @@ combine2
         
 combine2
         upsel2
-        (UPVSegd vsegids1 upssegd1) pdatas1
-        (UPVSegd vsegids2 upssegd2) pdatas2
+        (UPVSegd vsegids1 upssegd1) pdatas1
+        (UPVSegd vsegids2 upssegd2) pdatas2
 
  = let  -- vsegids relative to combined psegs
         vsegids1' = vsegids1
@@ -293,6 +309,6 @@ combine2
                                 upssegd1 pdatas1
                                 upssegd2 pdatas2
                                   
-   in   UPVSegd vsegids' upssegd'
-{-# INLINE_UP combine2 #-}
+   in   UPVSegd False vsegids' upssegd'
+{-# NOINLINE combine2 #-}