When dph-base/Data.Array.Parallel.Base.Config.tracePrimEnabled is True, DPH programs...
authorBen Lippmeier <benl@ouroborus.net>
Fri, 15 Apr 2011 05:15:49 +0000 (15:15 +1000)
committerBen Lippmeier <benl@ouroborus.net>
Fri, 15 Apr 2011 05:15:49 +0000 (15:15 +1000)
dph-base/Data/Array/Parallel/Base.hs
dph-base/Data/Array/Parallel/Base/Config.hs
dph-base/Data/Array/Parallel/Base/TracePrim.hs [new file with mode: 0644]
dph-prim-par/Data/Array/Parallel/Unlifted.hs

index d1cdf44..7cfe7a3 100644 (file)
@@ -17,7 +17,7 @@ module Data.Array.Parallel.Base (
   module Data.Array.Parallel.Base.Util,
   module Data.Array.Parallel.Base.Text,
   module Data.Array.Parallel.Base.DTrace,
-
+  module Data.Array.Parallel.Base.TracePrim,
   ST(..), runST
 ) where
 
@@ -25,6 +25,7 @@ import Data.Array.Parallel.Base.Debug
 import Data.Array.Parallel.Base.Util
 import Data.Array.Parallel.Base.Text
 import Data.Array.Parallel.Base.DTrace
+import Data.Array.Parallel.Base.TracePrim
 
 import GHC.ST (ST(..), runST)
 
index fe7cf83..18fc59b 100644 (file)
@@ -2,8 +2,14 @@
 module Data.Array.Parallel.Base.Config (
     debug
   , debugCritical
+  , tracePrimEnabled
 ) where
 
-debug = False
-debugCritical = False
+debug                   = False
+debugCritical           = False
+
+-- | Print tracing information for each DPH primitive to console.
+--   The tracing hooks are in dph-prim-par/D/A/P/Unlifted.hs
+tracePrimEnabled        :: Bool
+tracePrimEnabled        = False
 
diff --git a/dph-base/Data/Array/Parallel/Base/TracePrim.hs b/dph-base/Data/Array/Parallel/Base/TracePrim.hs
new file mode 100644 (file)
index 0000000..c000136
--- /dev/null
@@ -0,0 +1,85 @@
+
+-- | When dph-base/Data.Array.Parallel.Config.tracePrimEnabled is True, DPH programs will print
+--   out what array primitives they're using at runtime. See `tracePrim` for details.
+module Data.Array.Parallel.Base.TracePrim
+        ( TracePrim(..)
+        , tracePrim)
+where
+import Data.Array.Parallel.Base.Config
+import qualified Debug.Trace
+
+-- | Print tracing information to console.
+--
+--    This function is used to wrap the calls to DPH primitives defined
+--    in dph-prim-par/Data.Array.Parallel.Unlifted
+--
+--    Tracing is only enabled when dph-base/Data.Array.Parallel.Config.tracePrimEnabled is True,
+--    otherwise it's a no-op.
+--   
+tracePrim :: TracePrim -> a -> a
+tracePrim tr x
+ | tracePrimEnabled     = Debug.Trace.trace (Prelude.show tr) x
+ | otherwise            = x
+
+-- | Records information about the use of a primitive operator.
+--    These are the operator names that the vectoriser introduces.
+--    The actual implementation of each operator varies depending on what DPH backend we're using.
+--    We only trace operators that are at least O(n) in complexity. 
+data TracePrim
+        = TraceReplicate   { traceCount      :: Int}
+        | TraceRepeat      { traceCount      :: Int, traceSrcLength   :: Int }
+        | TraceIndex       { traceIndex      :: Int, traceSrcLength   :: Int }
+        | TraceExtract     { traceStart      :: Int, traceSliceLength :: Int, traceSrcLength :: Int }
+        | TraceDrop        { traceCount      :: Int, traceSrcLength   :: Int }
+        | TracePermute     { traceSrcLength  :: Int }
+        | TraceBPermuteDft { traceSrcLength  :: Int }
+        | TraceBPermute    { traceSrcLength  :: Int }
+        | TraceMBPermute   { traceSrcLength  :: Int }
+        | TraceUpdate      { traceSrcLength  :: Int, traceModLength :: Int }
+        | TraceAppend      { traceDstLength  :: Int }
+        | TraceInterleave  { traceDstLength  :: Int }
+        | TracePack        { traceSrcLength  :: Int }
+        | TraceCombine     { traceSrcLength  :: Int }
+        | TraceCombine2    { traceSrcLength  :: Int }
+        | TraceMap         { traceSrcLength  :: Int }
+        | TraceFilter      { traceSrcLength  :: Int }
+        | TraceZipWith     { traceSrc1Length :: Int, traceSrc2Length :: Int }
+        | TraceFold        { traceSrcLength  :: Int }
+        | TraceFold1       { traceSrcLength  :: Int }
+        | TraceAnd         { traceSrcLength  :: Int }
+        | TraceSum         { traceSrcLength  :: Int }
+        | TraceScan        { traceSrcLength  :: Int }
+        | TraceIndexed     { traceSrcLength  :: Int }
+
+        -- Enumerations.
+        | TraceEnumFromTo          { traceDstLength :: Int }
+        | TraceEnumFromThenTo      { traceDstLength :: Int }
+        | TraceEnumFromStepLen     { traceDstLength :: Int }
+        | TraceEnumFromStepLenEach { traceDstLength :: Int }
+
+        -- Selectors.
+        | TraceMkSel2              { traceSrcLength   :: Int }
+        | TraceTagsSel2            { traceDstLength   :: Int }
+        | TraceIndicesSel2         { traceDstLength   :: Int }
+        | TraceElementsSel2_0      { traceSrcLength   :: Int }
+        | TraceElementsSel2_1      { traceSrcLength   :: Int }
+
+        | TraceMkSelRep2           { traceSrcLength   :: Int }
+        | TraceIndicesSelRep2      { traceSrcLength   :: Int }
+        | TraceElementsSelRep2_0   { traceSrcLength   :: Int }
+        | TraceElementsSelRep2_1   { traceSrcLength   :: Int }
+        
+        -- Operations on segmented arrays.
+        | TraceReplicate_s         { traceSrcLength   :: Int }
+        | TraceReplicate_rs        { traceCount       :: Int, traceSrcLength   :: Int }
+        | TraceAppend_s            { traceDstLength   :: Int }
+        | TraceFold_s              { traceSrcLength   :: Int }
+        | TraceFold1_s             { traceSrcLength   :: Int }
+        | TraceFold_r              { traceSrcLength   :: Int }
+        | TraceSum_r               { traceSrcLength   :: Int }
+        | TraceIndices_s           { traceDstLength   :: Int }
+        deriving Prelude.Show
+
+
+
index 13fc2f8..239ee64 100644 (file)
 #include "DPH_Header.h"
 
 import Data.Array.Parallel.Unlifted.Parallel
+import Data.Array.Parallel.Base.TracePrim
 import Data.Array.Parallel.Unlifted.Distributed ( DT )
 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector         as Seq
 import qualified Data.Array.Parallel.Unlifted.Sequential.Segmented      as Seq
 import Data.Array.Parallel.Unlifted.Sequential.Vector (Unbox,Vector)
+import Prelude (($!))
 
 #include "DPH_Interface.h"
 
 class (Unbox a, DT a) => Elt a
 
-type Array              = Vector
-type Segd               = UPSegd
-type Sel2               = UPSel2
-type SelRep2            = UPSelRep2
+type Array      = Vector
+type Segd       = UPSegd
+type Sel2       = UPSel2
+type SelRep2    = UPSelRep2
+
+
+-- Constant time operations ---------------------------------------------------
+--   We don't bother tracing these.
 
 length                  = Seq.length
 empty                   = Seq.empty
-replicate               = replicateUP
-repeat n _              = repeatUP n
-(!:)                    = (Seq.!)
-extract                 = Seq.extract
-drop                    = dropUP
-permute                 = Seq.permute
-bpermuteDft             = Seq.bpermuteDft
-bpermute                = bpermuteUP
-mbpermute               = Seq.mbpermute
-update                  = updateUP
-(+:+)                   = (Seq.++)
-interleave              = interleaveUP
-pack                    = packUP
-combine                 = combineUP
-combine2                = combine2UP
-map                     = mapUP
-filter                  = filterUP
 zip                     = Seq.zip
 unzip                   = Seq.unzip
--- zip3                 = V.zip3
--- unzip3               = V.unzip3
 fsts                    = Seq.fsts
 snds                    = Seq.snds
-zipWith                 = zipWithUP
-fold                    = foldUP
-fold1                   = Seq.fold1
-and                     = andUP
-sum                     = sumUP
-scan                    = scanUP
-indexed                 = indexedUP
-enumFromTo              = enumFromToUP
-enumFromThenTo          = enumFromThenToUP
-enumFromStepLen         = enumFromStepLenUP
-enumFromStepLenEach     = enumFromStepLenEachUP
-
-mkSel2                  = mkUPSel2
-tagsSel2                = tagsUPSel2
-indicesSel2             = indicesUPSel2
+(!:)                    = (Seq.!)
+
 elementsSel2_0          = elementsUPSel2_0
 elementsSel2_1          = elementsUPSel2_1
 repSel2                 = repUPSel2
@@ -78,25 +52,213 @@ indicesSelRep2          = indicesUPSelRep2
 elementsSelRep2_0       = elementsUPSelRep2_0
 elementsSelRep2_1       = elementsUPSelRep2_1
 
-replicate_s             = replicateSUP
-replicate_rs            = replicateRSUP
-append_s                = appendSUP
-fold_s                  = foldSUP
-fold1_s                 = fold1SUP
-fold_r                  = Seq.foldlRU
-sum_r                   = sumRUP
-
-indices_s segd          = indicesSUP segd
-
+mkSegd                  = mkUPSegd
 lengthSegd              = lengthUPSegd
 lengthsSegd             = lengthsUPSegd
 indicesSegd             = indicesUPSegd
 elementsSegd            = elementsUPSegd
-mkSegd                  = mkUPSegd
+
+
+-------------------------------------------------------------------------------
+-- These take least O(n) time in the length of the vector.
+--   NOTE: That actual tracing is only enabled when 
+--         dph-base/D/A/P/Config.tracePrimEnabled is set to True,
+--         otherwise tracePrim is a no-op.
+
+replicate n val 
+        =  tracePrim (TraceReplicate n)
+        $! replicateUP n val
+
+
+repeat n _ arr
+        =  tracePrim (TraceRepeat n (Seq.length arr))
+        $! repeatUP n arr
+
+
+extract arr i n
+        =  tracePrim (TraceExtract (Seq.length arr) i n)
+        $! Seq.extract arr i n
+
+
+drop n arr
+        =  tracePrim (TraceDrop n (Seq.length arr))
+        $! dropUP n arr
+
+
+permute arrSrc arrIxs
+        =  tracePrim (TracePermute (Seq.length arrSrc))
+        $! Seq.permute arrSrc arrIxs
+
+
+bpermuteDft len f arrIxs
+        =  tracePrim (TraceBPermuteDft len)
+        $! Seq.bpermuteDft len f arrIxs
+
+
+bpermute arrSrc arrIxs
+        =  tracePrim (TraceBPermute (Seq.length arrSrc))
+        $! bpermuteUP arrSrc arrIxs
+
+
+mbpermute f arrSrc streamIxs
+        =  tracePrim (TraceMBPermute (Seq.length arrSrc))
+        $! Seq.mbpermute f arrSrc streamIxs
+
+
+update arrSrc arrNew
+        =  tracePrim (TraceUpdate (Seq.length arrSrc) (Seq.length arrNew))
+        $! updateUP arrSrc arrNew
+
+
+(+:+) arr1 arr2
+        =  tracePrim (TraceAppend (Seq.length arr1 + Seq.length arr2))
+        $! (Seq.++) arr1 arr2
+
+
+interleave arr1 arr2
+        =  tracePrim (TraceInterleave (Seq.length arr1 + Seq.length arr2))
+        $! interleaveUP arr1 arr2
+
+
+pack arrSrc arrFlag
+        =  tracePrim (TracePack (Seq.length arrSrc))
+        $! packUP arrSrc arrFlag
+
+
+combine arrSel arr1 arr2
+        =  tracePrim (TraceCombine (Seq.length arrSel))
+        $! combineUP arrSel arr1 arr2
+
+
+combine2 arrTag sel arr1 arr2
+        =  tracePrim (TraceCombine2 (Seq.length arrTag))
+        $! combine2UP arrTag sel arr1 arr2
+
+
+map f arr
+        =  tracePrim (TraceMap (Seq.length arr))
+        $! mapUP f arr
+
+
+filter f arr
+        =  tracePrim (TraceFilter (Seq.length arr))
+        $! filterUP f arr
+
+
+zipWith f arr1 arr2
+        =  tracePrim (TraceZipWith (Seq.length arr1) (Seq.length arr2))
+        $! zipWithUP f arr1 arr2
+
+
+fold f x arr
+        =  tracePrim (TraceFold (Seq.length arr))
+        $! foldUP f x arr
+
+        
+fold1 f arr
+        =  tracePrim (TraceFold1 (Seq.length arr))
+        $! Seq.fold1 f arr
+
+
+and arr =  tracePrim (TraceAnd (Seq.length arr))
+        $! andUP arr
+
+
+sum arr =  tracePrim (TraceSum (Seq.length arr))
+        $! sumUP arr
+
+                        
+scan f x arr
+        =  tracePrim (TraceScan (Seq.length arr))
+        $! scanUP f x arr
+
+        
+indexed arr
+        =  tracePrim (TraceIndexed (Seq.length arr))
+        $! indexedUP arr
+
+
+enumFromTo from to
+ = let  arr     = enumFromToUP from to
+   in   tracePrim (TraceEnumFromTo (Seq.length arr)) arr
+
+        
+enumFromThenTo from thn to
+ = let  arr     = enumFromThenToUP from thn to
+   in   tracePrim (TraceEnumFromThenTo (Seq.length arr)) arr
+
+   
+enumFromStepLen from step len
+ = let  arr     = enumFromStepLenUP from step len
+   in   tracePrim (TraceEnumFromStepLen (Seq.length arr)) arr
+
+
+enumFromStepLenEach n starts steps lens
+ = let  arr     = enumFromStepLenEachUP n starts steps lens
+   in   tracePrim (TraceEnumFromStepLenEach (Seq.length arr)) arr
+
+
+mkSel2 tag is n0 n1 rep
+        =  tracePrim (TraceMkSel2 (Seq.length is))
+        $! mkUPSel2 tag is n0 n1 rep
+
+
+tagsSel2 sel
+ = let  tags    = tagsUPSel2 sel
+   in   tracePrim (TraceTagsSel2 (Seq.length tags)) tags
+
+
+indicesSel2 sel      
+ = let  arr     = indicesUPSel2 sel
+   in   tracePrim (TraceIndicesSel2 (Seq.length arr)) arr
+
+
+replicate_s segd arr
+        =  tracePrim (TraceReplicate_s (Seq.length arr))
+        $! replicateSUP segd arr
+
+
+replicate_rs n arr
+        =  tracePrim (TraceReplicate_rs n (Seq.length arr))
+        $! replicateRSUP n arr
+
+
+append_s segd xd xs yd ys
+ = let  arr     = appendSUP segd xd xs yd ys
+   in   tracePrim (TraceAppend_s (Seq.length arr)) arr
+
+        
+fold_s f x segd arr
+        =  tracePrim (TraceFold_s (Seq.length arr))
+        $! foldSUP f x segd arr
+
+        
+fold1_s f segd arr
+        =  tracePrim (TraceFold1_s (Seq.length arr))
+        $! fold1SUP f segd arr
+
+
+fold_r f z segSize arr
+        =  tracePrim (TraceFold_r (Seq.length arr))
+        $! Seq.foldlRU f z segSize arr
+
+
+sum_r x arr
+        =  tracePrim (TraceSum_r (Seq.length arr))
+        $! sumRUP x arr
+
+
+indices_s segd
+ = let  arr     = indicesSUP segd
+   in   tracePrim (TraceIndices_s (Seq.length arr)) arr
+
+
+-- Random arrays ------------------------------------------
 randoms                 = Seq.random
 randomRs                = Seq.randomR
 
 
+-- IO -----------------------------------------------------
 class Seq.UIO a => IOElt a
 hPut                    = Seq.hPut
 hGet                    = Seq.hGet