Trace all stream-based loops
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 29 Oct 2009 13:43:56 +0000 (13:43 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 29 Oct 2009 13:43:56 +0000 (13:43 +0000)
We extend the stream data type with an additional String which says how the
stream was produced:

  data Stream a = forall s. Stream ... String

Now, whenever we create or transform a stream we record the function that did
it:

  replicateS n x = Stream ... (sNoArgs "replicateS")
  mapS f (Stream ... c) = Stream ... ("mapS" `sArgs` c)

Real loops that actually consume streams pass this string to dtrace. The
somewhat funny sNoArgs/sArgs setup is because I want to use ByteStrings
instead of Strings eventually and hope that GHC will be able to just create
big string literals instead of concatenating lots of small ones.

14 files changed:
dph-base/Data/Array/Parallel/Arr/BUArr.hs
dph-base/Data/Array/Parallel/Stream/Flat.hs
dph-base/Data/Array/Parallel/Stream/Flat/Basics.hs
dph-base/Data/Array/Parallel/Stream/Flat/Combinators.hs
dph-base/Data/Array/Parallel/Stream/Flat/Enum.hs
dph-base/Data/Array/Parallel/Stream/Flat/Random.hs
dph-base/Data/Array/Parallel/Stream/Flat/Search.hs
dph-base/Data/Array/Parallel/Stream/Flat/Stream.hs
dph-base/Data/Array/Parallel/Stream/Segmented.hs
dph-base/dph-base.cabal
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Basics.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Combinators.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Permute.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Stream.hs

index d01600e..ccd8c0c 100644 (file)
@@ -396,7 +396,7 @@ instance UAE Double where
 --
 streamBU :: UAE e => BUArr e -> Stream e
 {-# INLINE [1] streamBU #-}
-streamBU arr = Stream next 0 (lengthBU arr)
+streamBU arr = Stream next 0 (lengthBU arr) (sNoArgs "streamBU")
   where
     n = lengthBU arr
     --
@@ -407,10 +407,11 @@ streamBU arr = Stream next 0 (lengthBU arr)
 --
 unstreamBU :: UAE e => Stream e -> BUArr e
 {-# INLINE [1] unstreamBU #-}
-unstreamBU (Stream next s n) =
+unstreamBU (Stream next s n c) =
   runST (do
     marr <- newMBU n
-    n'   <- fill0 marr
+    n'   <- traceLoopST ("unstreamBU" `sArgs` c)
+          $ fill0 marr
     unsafeFreezeMBU marr n'
   )
   where
@@ -525,7 +526,7 @@ extractMBU arr i n = do
 --
 copyMBU :: UAE e => MBUArr s e -> Int -> BUArr e -> ST s ()
 {-# INLINE copyMBU #-}
-copyMBU marr i arr = ins i 0
+copyMBU marr i arr = traceLoopST "copyMBU" $ ins i 0
   where
     n = lengthBU arr
     --
index d5b937d..de091d3 100644 (file)
@@ -25,7 +25,9 @@ module Data.Array.Parallel.Stream.Flat (
 
   findS, findIndexS,
 
-  randomS, randomRS
+  randomS, randomRS,
+
+  SArgs(..), sNoArgs
 ) where
 
 import Data.Array.Parallel.Stream.Flat.Stream
index 412ec18..29a5ad2 100644 (file)
@@ -33,13 +33,13 @@ import Data.Array.Parallel.Stream.Flat.Stream
 -- | Empty stream
 --
 emptyS :: Stream a
-emptyS = Stream (const Done) () 0
+emptyS = Stream (const Done) () 0 (sNoArgs "emptyS")
 
 -- | Singleton stream
 --
 singletonS :: a -> Stream a
 {-# INLINE_STREAM singletonS #-}
-singletonS x = Stream next True 1
+singletonS x = Stream next True 1 (sNoArgs "singletonS")
   where
     {-# INLINE next #-}
     next True  = Yield x False
@@ -49,7 +49,7 @@ singletonS x = Stream next True 1
 --
 consS :: a -> Stream a -> Stream a
 {-# INLINE_STREAM consS #-}
-consS x (Stream next s n) = Stream next' (JustS (Box x) :*: s) (n+1)
+consS x (Stream next s n c) = Stream next' (JustS (Box x) :*: s) (n+1) ("consS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (JustS (Box x) :*: s) = Yield x (NothingS :*: s)
@@ -62,7 +62,7 @@ consS x (Stream next s n) = Stream next' (JustS (Box x) :*: s) (n+1)
 --
 replicateS :: Int -> a -> Stream a
 {-# INLINE_STREAM replicateS #-}
-replicateS n x = Stream next 0 n
+replicateS n x = Stream next 0 n (sNoArgs "replicateS")
   where
     {-# INLINE next #-}
     next i | i == n    = Done
@@ -73,8 +73,8 @@ replicateS n x = Stream next 0 n
 --
 replicateEachS :: Int -> Stream (Int :*: a) -> Stream a
 {-# INLINE_STREAM replicateEachS #-}
-replicateEachS n (Stream next s _) =
-  Stream next' (0 :*: NothingS :*: s) n
+replicateEachS n (Stream next s _ c) =
+  Stream next' (0 :*: NothingS :*: s) n ("replicateEachS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (0 :*: _ :*: s) =
@@ -90,8 +90,8 @@ replicateEachS n (Stream next s _) =
 --
 replicateEachRS :: Int -> Stream a -> Stream a
 {-# INLINE_STREAM replicateEachRS #-}
-replicateEachRS !n (Stream next s m)
-  = Stream next' (0 :*: NothingS :*: s) (m * n)
+replicateEachRS !n (Stream next s m c)
+  = Stream next' (0 :*: NothingS :*: s) (m * n) ("replicateEachRS" `sArgs` c)
   where
     next' (0 :*: _ :*: s) =
       case next s of
@@ -105,7 +105,8 @@ replicateEachRS !n (Stream next s m)
 --
 (+++) :: Stream a -> Stream a -> Stream a
 {-# INLINE_STREAM (+++) #-}
-Stream next1 s1 n1 +++ Stream next2 s2 n2 = Stream next (LeftS s1) (n1 + n2)
+Stream next1 s1 n1 c1 +++ Stream next2 s2 n2 c2
+  = Stream next (LeftS s1) (n1 + n2) ("(+++)" `sArgs` (c1,c2))
   where
     {-# INLINE next #-}
     next (LeftS s1) =
@@ -124,7 +125,7 @@ Stream next1 s1 n1 +++ Stream next2 s2 n2 = Stream next (LeftS s1) (n1 + n2)
 --
 indexedS :: Stream a -> Stream (Int :*: a)
 {-# INLINE_STREAM indexedS #-}
-indexedS (Stream next s n) = Stream next' (0 :*: s) n
+indexedS (Stream next s n c) = Stream next' (0 :*: s) n ("indexedS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (i :*: s) = case next s of
@@ -136,7 +137,7 @@ indexedS (Stream next s n) = Stream next' (0 :*: s) n
 --
 tailS :: Stream a -> Stream a
 {-# INLINE_STREAM tailS #-}
-tailS (Stream next s n) = Stream next' (False :*: s) (n-1)
+tailS (Stream next s n c) = Stream next' (False :*: s) (n-1) ("tailS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (False :*: s) = case next s of
@@ -153,7 +154,7 @@ tailS (Stream next s n) = Stream next' (False :*: s) (n-1)
 --
 toStream :: [a] -> Stream a
 {-# INLINE_STREAM toStream #-}
-toStream xs = Stream gen (Box xs) (length xs)
+toStream xs = Stream gen (Box xs) (length xs) (sNoArgs "toStream")
   where
     {-# INLINE gen #-}
     gen (Box [])     = Done
@@ -163,7 +164,7 @@ toStream xs = Stream gen (Box xs) (length xs)
 --
 fromStream :: Stream a -> [a]
 {-# INLINE_STREAM fromStream #-}
-fromStream (Stream next s _) = gen s
+fromStream (Stream next s _ _) = gen s
   where
     gen s = case next s of
               Done       -> []
index 9182788..843763c 100644 (file)
@@ -23,16 +23,16 @@ module Data.Array.Parallel.Stream.Flat.Combinators (
 
 import Data.Array.Parallel.Base (
   (:*:)(..), MaybeS(..), Rebox(..), Box(..))
+import Data.Array.Parallel.Base.DTrace
 import Data.Array.Parallel.Stream.Flat.Stream
 
-import Debug.Trace
 
 
 -- | Mapping
 --
 mapS :: (a -> b) -> Stream a -> Stream b
 {-# INLINE_STREAM mapS #-}
-mapS f (Stream next s n) = Stream next' s n
+mapS f (Stream next s n c) = Stream next' s n ("mapS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' s = case next s of
@@ -44,7 +44,7 @@ mapS f (Stream next s n) = Stream next' s n
 --
 filterS :: (a -> Bool) -> Stream a -> Stream a
 {-# INLINE_STREAM filterS #-}
-filterS f (Stream next s n) = Stream next' s n
+filterS f (Stream next s n c) = Stream next' s n ("filterS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' s = case next s of
@@ -58,33 +58,37 @@ filterS f (Stream next s n) = Stream next' s n
 -- 
 foldS :: (b -> a -> b) -> b -> Stream a -> b
 {-# INLINE_STREAM foldS #-}
-foldS f z (Stream next s _) = fold z s
+foldS f z (Stream next s _ c) = traceLoopEntry c' $ fold z s
   where
     fold z s = case next s of
-                 Done       -> z
+                 Done       -> traceLoopExit c' z
                  Skip    s' -> s' `dseq` fold z s'
                  Yield x s' -> s' `dseq` fold (f z x) s'
 
+    c' = "foldS" `sArgs` c
+
 -- | Yield 'NothingS' if the 'Stream' is empty and fold it otherwise.
 --
 fold1MaybeS :: (a -> a -> a) -> Stream a -> MaybeS a
 {-# INLINE_STREAM fold1MaybeS #-}
-fold1MaybeS f (Stream next s _) = fold0 s
+fold1MaybeS f (Stream next s _ c) = traceLoopEntry c' $ fold0 s
   where
     fold0 s   = case next s of
-                  Done       -> NothingS
+                  Done       -> traceLoopExit c' NothingS
                   Skip    s' -> s' `dseq` fold0 s'
                   Yield x s' -> s' `dseq` fold1 x s'
     fold1 z s = case next s of
-                  Done       -> JustS z
+                  Done       -> traceLoopExit c' $ JustS z
                   Skip    s' -> s' `dseq` fold1 z s'
                   Yield x s' -> s' `dseq` fold1 (f z x) s'
 
+    c' = "fold1MaybeS" `sArgs` c
+
 -- | Scanning
 --
 scanS :: (b -> a -> b) -> b -> Stream a -> Stream b
 {-# INLINE_STREAM scanS #-}
-scanS f z (Stream next s n) = Stream next' (Box z :*: s) n
+scanS f z (Stream next s n c) = Stream next' (Box z :*: s) n ("scanS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (Box z :*: s) = case next s of
@@ -96,7 +100,7 @@ scanS f z (Stream next s n) = Stream next' (Box z :*: s) n
 --
 scan1S :: (a -> a -> a) -> Stream a -> Stream a
 {-# INLINE_STREAM scan1S #-}
-scan1S f (Stream next s n) = Stream next' (NothingS :*: s) n
+scan1S f (Stream next s n c) = Stream next' (NothingS :*: s) n ("scan1S" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (NothingS :*: s) =
@@ -115,7 +119,7 @@ scan1S f (Stream next s n) = Stream next' (NothingS :*: s) n
 
 mapAccumS :: (acc -> a -> acc :*: b) -> acc -> Stream a -> Stream b
 {-# INLINE_STREAM mapAccumS #-}
-mapAccumS f acc (Stream step s n) = Stream step' (s :*: Box acc) n
+mapAccumS f acc (Stream step s n c) = Stream step' (s :*: Box acc) n ("mapAccumS" `sArgs` c)
   where
     step' (s :*: Box acc) = case step s of
                           Done -> Done
@@ -127,8 +131,8 @@ mapAccumS f acc (Stream step s n) = Stream step' (s :*: Box acc) n
 
 combineS:: Stream Bool -> Stream a -> Stream a -> Stream a
 {-# INLINE_STREAM combineS #-}
-combineS (Stream next1 s m) (Stream nextS1 t1 n1) (Stream nextS2 t2 n2)  =
-  Stream next (s :*: t1 :*: t2) m
+combineS (Stream next1 s m c) (Stream nextS1 t1 n1 c1) (Stream nextS2 t2 n2 c2)
+  = Stream next (s :*: t1 :*: t2) m ("combineS" `sArgs` (c,c1,c2))
   where
     {-# INLINE next #-}
     next (s :*: t1 :*: t2) = 
@@ -153,8 +157,8 @@ combineS (Stream next1 s m) (Stream nextS1 t1 n1) (Stream nextS2 t2 n2)  =
 -- SpecConstr with the correct definition.
 zipWithS :: (a -> b -> c) -> Stream a -> Stream b -> Stream c
 {-# INLINE_STREAM zipWithS #-}
-zipWithS f (Stream next1 s m) (Stream next2 t n) =
-  Stream next (s :*: t) m
+zipWithS f (Stream next1 s m c1) (Stream next2 t n c2) =
+  Stream next (s :*: t) m ("zipWithS" `sArgs` (c1,c2))
   where
     {-# INLINE next #-}
     next (s :*: t) =
@@ -196,8 +200,8 @@ zipWithS f (Stream next1 s m) (Stream next2 t n) =
 
 zipWith3S :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d
 {-# INLINE_STREAM zipWith3S #-}
-zipWith3S f (Stream next1 s1 n) (Stream next2 s2 _) (Stream next3 s3 _) =
-  Stream next (s1 :*: s2 :*: s3) n
+zipWith3S f (Stream next1 s1 n c1) (Stream next2 s2 _ c2) (Stream next3 s3 _ c3)
+  = Stream next (s1 :*: s2 :*: s3) n ("zipWith3S" `sArgs` (c1,c2,c3))
   where
     {-# INLINE next #-}
     next (s1 :*: s2 :*: s3) =
index fe1b396..3f885e9 100644 (file)
@@ -40,7 +40,7 @@ import Data.Array.Parallel.Stream.Flat.Combinators (
 enumFromToS :: Int -> Int -> Stream Int
 {-# INLINE_STREAM enumFromToS #-}
 enumFromToS start end
-  = Stream step start (max 0 (end - start + 1))
+  = Stream step start (max 0 (end - start + 1)) (sNoArgs "enumFromToS")
   where
     {-# INLINE step #-}
     step s | s > end   = Done
@@ -63,7 +63,7 @@ enumFromThenToS start next end
 
 enumFromStepLenS :: Int -> Int -> Int -> Stream Int
 {-# INLINE_STREAM enumFromStepLenS #-}
-enumFromStepLenS s !d n = Stream step (s :*: n) n
+enumFromStepLenS s !d n = Stream step (s :*: n) n (sNoArgs "enumFromStepLenS")
   where
     step (s :*: 0) = Done
     step (s :*: n) = Yield s ((s+d) :*: (n-1))
@@ -74,7 +74,8 @@ enumFromStepLenS s !d n = Stream step (s :*: n) n
 --
 enumFromToEachS :: Int -> Stream (Int :*: Int) -> Stream Int
 {-# INLINE_STREAM enumFromToEachS #-}
-enumFromToEachS n (Stream next s _) = Stream next' (NothingS :*: s) n
+enumFromToEachS n (Stream next s _ c)
+  = Stream next' (NothingS :*: s) n ("enumFromToEachS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (NothingS :*: s)
@@ -91,7 +92,8 @@ enumFromToEachS n (Stream next s _) = Stream next' (NothingS :*: s) n
 --
 enumFromStepLenEachS :: Int -> Stream (Int :*: Int :*: Int) -> Stream Int 
 {-# INLINE_STREAM enumFromStepLenEachS #-}
-enumFromStepLenEachS len (Stream next s n) = Stream next' (NothingS :*: s) len
+enumFromStepLenEachS len (Stream next s n c)
+  = Stream next' (NothingS :*: s) len ("enumFromStepLenEachS" `sArgs` c)
   where
     {-# INLINE next' #-}
     next' (NothingS :*: s) 
index dee4349..daabba6 100644 (file)
@@ -27,7 +27,7 @@ import System.Random
 
 randomS :: (RandomGen g, Random a) => Int -> g -> Stream a
 {-# INLINE_STREAM randomS #-}
-randomS n g = Stream step (Lazy g :*: n) n
+randomS n g = Stream step (Lazy g :*: n) n (sNoArgs "randomS")
   where
     {-# INLINE step #-}
     step (Lazy g :*: 0) = Done
@@ -36,7 +36,7 @@ randomS n g = Stream step (Lazy g :*: n) n
 
 randomRS :: (RandomGen g, Random a) => Int -> (a,a) -> g -> Stream a
 {-# INLINE_STREAM randomRS #-}
-randomRS n r g = Stream step (Lazy g :*: n) n
+randomRS n r g = Stream step (Lazy g :*: n) n (sNoArgs "randomRS")
   where
     {-# INLINE step #-}
     step (Lazy g :*: 0) = Done
index 403e4b7..959373b 100644 (file)
@@ -21,24 +21,29 @@ module Data.Array.Parallel.Stream.Flat.Search (
 ) where
 
 import Data.Array.Parallel.Stream.Flat.Stream
+import Data.Array.Parallel.Base.DTrace
 
 findS :: (a -> Bool) -> Stream a -> Maybe a
 {-# INLINE_STREAM findS #-}
-findS p (Stream next s _) = go s
+findS p (Stream next s _ c) = traceLoopEntry c' $ go s
   where
     go s = case next s of
-             Yield x s' | p x       -> Just x
+             Yield x s' | p x       -> traceLoopExit c' $ Just x
                         | otherwise -> go s'
              Skip    s'             -> go s'
-             Done                   -> Nothing
+             Done                   -> traceLoopExit c' Nothing
+
+    c' = "findS" `sArgs` c
 
 findIndexS :: (a -> Bool) -> Stream a -> Maybe Int
 {-# INLINE_STREAM findIndexS #-}
-findIndexS p (Stream next s _) = go 0 s
+findIndexS p (Stream next s _ c) = traceLoopEntry c' $ go 0 s
   where
     go i s = case next s of
-               Yield x s' | p x       -> Just i
+               Yield x s' | p x       -> traceLoopExit c' $ Just i
                           | otherwise -> go (i+1) s'
                Skip    s'             -> go i     s'
-               Done                   -> Nothing
+               Done                   -> traceLoopExit c' Nothing
+
+    c' = "findIndexS" `sArgs` c
 
index 6fd3fe7..e96a51f 100644 (file)
@@ -1,4 +1,5 @@
-{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExistentialQuantification, FlexibleInstances,
+             TypeSynonymInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -15,7 +16,9 @@
 --
 
 module Data.Array.Parallel.Stream.Flat.Stream (
-  Step(..), Stream(..)
+  Step(..), Stream(..),
+
+  SArgs(..), sNoArgs
 ) where
 
 import Data.Array.Parallel.Base (
@@ -30,5 +33,32 @@ instance Functor (Step s) where
   fmap f (Skip s)    = Skip s
   fmap f (Yield x s) = Yield (f x) s
 
-data Stream a = forall s. Rebox s => Stream (s -> Step s a) !s Int
+data Stream a = forall s. Rebox s => Stream (s -> Step s a) !s Int String
+
+sNoArgs :: String -> String
+sNoArgs = id
+
+class SArgs a where
+  sArgs :: String -> a -> String
+
+instance SArgs () where
+  sArgs fn _ = fn
+
+instance SArgs String where
+  sArgs fn arg = fn ++ " <- " ++ arg
+
+instance SArgs (String, String) where
+  sArgs fn (arg1, arg2) = fn ++ " <- (" ++ arg1 ++ ", " ++ arg2 ++ ")"
+
+instance SArgs (String, String, String) where
+  sArgs fn (arg1, arg2, arg3)
+    = fn ++ " <- (" ++ arg1 ++ ", " ++ arg2 ++ ", " ++ arg3 ++ ")"
+
+instance SArgs (String, String, String, String) where
+  sArgs fn (arg1, arg2, arg3, arg4)
+    = fn ++ " <- (" ++ arg1 ++ ", " ++ arg2 ++ ", " ++ arg3 ++ ", " ++ arg4 ++ ")"
+
+instance SArgs (String, String, String, String, String) where
+  sArgs fn (arg1, arg2, arg3, arg4, arg5)
+    = fn ++ " <- (" ++ arg1 ++ ", " ++ arg2 ++ ", " ++ arg3 ++ ", " ++ arg4 ++ ", " ++ arg5 ++ ")"
 
index 516c22d..68fdc6b 100644 (file)
@@ -22,12 +22,12 @@ module Data.Array.Parallel.Stream.Segmented (
 import Data.Array.Parallel.Base (
   (:*:)(..), Box(..), MaybeS(..))
 import Data.Array.Parallel.Stream.Flat (
-  Step(..), Stream(..))
+  Step(..), Stream(..), SArgs(..))
 
 foldSS :: (a -> b -> a) -> a -> Stream Int -> Stream b -> Stream a
 {-# INLINE_STREAM foldSS #-}
-foldSS f z (Stream nexts ss ns) (Stream nextv vs nv) =
-  Stream next (NothingS :*: Box z :*: ss :*: vs) ns
+foldSS f z (Stream nexts ss ns c1) (Stream nextv vs nv c2) =
+  Stream next (NothingS :*: Box z :*: ss :*: vs) ns ("foldSS" `sArgs` (c1,c2))
   where
     {-# INLINE next #-}
     next (NothingS :*: Box x :*: ss :*: vs) =
@@ -49,11 +49,11 @@ foldSS f z (Stream nexts ss ns) (Stream nextv vs nv) =
 
 fold1SS :: (a -> a -> a) -> Stream Int -> Stream a -> Stream a
 {-# INLINE_STREAM fold1SS #-}
-fold1SS f (Stream nexts ss ns) (Stream nextv vs nv) =
-  Stream next (NothingS :*: NothingS :*: ss :*: vs) ns
+fold1SS f (Stream nexts ss ns c1) (Stream nextv vs nv c2) =
+  Stream next (NothingS :*: NothingS :*: ss :*: vs) ns ("fold1SS" `sArgs` (c1,c2))
   where
     {-# INLINE next #-}
-    next (NothingS :*: _ :*: ss :*: vs) =
+    next (NothingS :*: NothingS :*: ss :*: vs) =
       case nexts ss of
         Done        -> Done
         Skip    ss' -> Skip (NothingS :*: NothingS :*: ss' :*: vs)
@@ -78,11 +78,12 @@ fold1SS f (Stream nexts ss ns) (Stream nextv vs nv) =
 combineSS:: Stream Bool -> Stream Int -> Stream a
                         -> Stream Int -> Stream a -> Stream a
 {-# INLINE_STREAM combineSS #-}
-combineSS (Stream nextf sf nf) 
-          (Stream nexts1 ss1 ns1) (Stream nextv1 vs1 nv1)
-          (Stream nexts2 ss2 ns2) (Stream nextv2 vs2 nv2)
+combineSS (Stream nextf sf nf cf
+          (Stream nexts1 ss1 ns1 c1) (Stream nextv1 vs1 nv1 cv1)
+          (Stream nexts2 ss2 ns2 c2) (Stream nextv2 vs2 nv2 cv2)
   = Stream next (NothingS :*: True :*: sf :*: ss1 :*: vs1 :*: ss2 :*: vs2)
                 (nv1+nv2)
+                ("combineSS" `sArgs` (cf,c1,cv1,c2,cv2))
   where
     {-# INLINE next #-}
     next (NothingS :*: f :*: sf :*: ss1 :*: vs1 :*: ss2 :*: vs2) =
@@ -113,9 +114,10 @@ combineSS (Stream nextf sf nf)
 
 appendSS :: Stream Int -> Stream a -> Stream Int -> Stream a -> Stream a
 {-# INLINE_STREAM appendSS #-}
-appendSS (Stream nexts1 ss1 ns1) (Stream nextv1 sv1 nv1)
-         (Stream nexts2 ss2 ns2) (Stream nextv2 sv2 nv2)
+appendSS (Stream nexts1 ss1 ns1 c1) (Stream nextv1 sv1 nv1 cv1)
+         (Stream nexts2 ss2 ns2 c2) (Stream nextv2 sv2 nv2 cv2)
   = Stream next (True :*: NothingS :*: ss1 :*: sv1 :*: ss2 :*: sv2) (nv1 + nv2)
+                ("appendSS" `sArgs` (c1,cv1,c2,cv2))
   where
     {-# INLINE next #-}
     next (True :*: NothingS :*: ss1 :*: sv1 :*: ss2 :*: sv2)
@@ -159,8 +161,8 @@ appendSS (Stream nexts1 ss1 ns1) (Stream nextv1 sv1 nv1)
 
 foldValuesR :: (a -> b -> a) -> a -> Int -> Int -> Stream b -> Stream a
 {-# INLINE_STREAM foldValuesR #-}
-foldValuesR f z noOfSegs segSize (Stream nextv vs nv) =
-  Stream next (segSize :*: Box z :*: vs) noOfSegs
+foldValuesR f z noOfSegs segSize (Stream nextv vs nv c) =
+  Stream next (segSize :*: Box z :*: vs) noOfSegs ("foldValuesR" `sArgs` c)
   where
     {-# INLINE next #-}  
     next (0 :*: Box x :*: vs) =
index 63c7a80..1b27f07 100644 (file)
@@ -51,7 +51,7 @@ Library
   if flag(DTrace)
     CPP-Options: -DDPH_ENABLE_DTRACE
     Extra-Libraries: dph-trace
-    Extra-Lib-Dirs: /Users/rl/projects/ndp/dtrace
+    Extra-Lib-Dirs: /Users/rl/projects/ndp/ghc-inline/libraries/dph/dtrace
 
   Extensions: TypeFamilies, GADTs, RankNTypes,
               BangPatterns, MagicHash, UnboxedTuples, TypeOperators
index 97e8365..b2f5670 100644 (file)
@@ -32,7 +32,7 @@ import Data.Array.Parallel.Base (
 import Data.Array.Parallel.Stream (
   Step(..), Stream(..),
   consS, singletonS, replicateS, (+++), indexedS,
-  {-replicateEachS, zipS,-} toStream)
+  {-replicateEachS, zipS,-} toStream, sNoArgs)
 import Data.Array.Parallel.Unlifted.Sequential.Flat.UArr (
   UA, UArr, unitsU, lengthU, indexU, newU)
 import Data.Array.Parallel.Unlifted.Sequential.Flat.Stream (
@@ -93,7 +93,7 @@ repeatU n xs = unstreamU (repeatUS n xs)
 
 repeatUS :: UA e => Int -> UArr e -> Stream e
 {-# INLINE_STREAM repeatUS #-}
-repeatUS k !xs = Stream next (0 :*: k) (k*n)
+repeatUS k !xs = Stream next (0 :*: k) (k*n) (sNoArgs "repeatUS")
   where
     n = lengthU xs
 
index e4b8a44..dc447b2 100644 (file)
@@ -36,10 +36,12 @@ module Data.Array.Parallel.Unlifted.Sequential.Flat.Combinators (
 
 import Data.Array.Parallel.Base (
   (:*:)(..), MaybeS(..), checkNotEmpty, checkEq, sndS, Rebox(..), ST, runST)
+import Data.Array.Parallel.Base.DTrace
 import Data.Array.Parallel.Stream (
   Step(..), Stream(..),
   mapS, filterS, foldS, fold1MaybeS, scan1S, scanS, mapAccumS,
-  zipWithS, zipWith3S, combineS)
+  zipWithS, zipWith3S, combineS, combine2ByTagS,
+  sArgs, sNoArgs)
 import Data.Array.Parallel.Unlifted.Sequential.Flat.UArr (
   UA, UArr, MUArr,
   writeMU, newDynResU,
@@ -145,13 +147,14 @@ scanResU f z = unstreamScan f z . streamU
 
 unstreamScan :: UA a => (a -> a -> a) -> a -> Stream a -> UArr a :*: a
 {-# INLINE_STREAM unstreamScan #-}
-unstreamScan f z st@(Stream _ _ n)
+unstreamScan f z st@(Stream _ _ n _)
   = newDynResU n (\marr -> unstreamScanM marr f z st)
 
 unstreamScanM :: UA a => MUArr a s -> (a -> a -> a) -> a -> Stream a
                       -> ST s (Int :*: a)
 {-# INLINE_U unstreamScanM #-}
-unstreamScanM marr f z (Stream next s n) = fill s z 0
+unstreamScanM marr f z (Stream next s n c)
+  = traceLoopST ("unstreamScanM" `sArgs` c) $ fill s z 0
   where
     fill s !z !i = case next s of
                      Done       -> return (i :*: z)
index 03ed81d..58f6284 100644 (file)
@@ -27,8 +27,9 @@ module Data.Array.Parallel.Unlifted.Sequential.Flat.Permute (
 
 import Data.Array.Parallel.Base (
   ST, runST, (:*:)(..), Rebox(..))
+import Data.Array.Parallel.Base.DTrace
 import Data.Array.Parallel.Stream (
-  Step(..), Stream(..), mapS)
+  Step(..), Stream(..), mapS, sArgs)
 import Data.Array.Parallel.Unlifted.Sequential.Flat.UArr (
   UA, UArr, MUArr,
   lengthU, newU, newDynU, newMU, unsafeFreezeAllMU, writeMU,
@@ -107,7 +108,8 @@ atomicUpdateMU marr upd = updateM writeMU marr (streamU upd)
 updateM :: UA e => (MUArr e s -> Int -> e -> ST s ())
                 -> MUArr e s -> Stream (Int :*: e) -> ST s ()
 {-# INLINE_STREAM updateM #-}
-updateM write marr (Stream next s _) = upd s
+updateM write marr (Stream next s _ c)
+  = traceLoopST ("updateM" `sArgs` c) $ upd s
   where
     upd s = case next s of
               Done               -> return ()
@@ -125,7 +127,7 @@ updateU arr upd = update (streamU arr) (streamU upd)
 
 update :: UA e => Stream e -> Stream (Int :*: e) -> UArr e
 {-# INLINE_STREAM update #-}
-update s1@(Stream _ _ n) !s2 = newDynU n (\marr ->
+update s1@(Stream _ _ n _) !s2 = newDynU n (\marr ->
   do
     i <- unstreamMU marr s1
     updateM writeMU marr s2
@@ -141,10 +143,10 @@ reverseU = rev . streamU
 
 rev :: UA e => Stream e -> UArr e
 {-# INLINE_STREAM rev #-}
-rev (Stream next s n) =
+rev (Stream next s n c) =
   runST (do
     marr <- newMU n
-    i <- fill marr
+    i <- traceLoopST ("rev" `sArgs` c) $ fill marr
     a <- unsafeFreezeAllMU marr
     return $ sliceU a i (n-i)
   )
index f649dc4..f3aa52b 100644 (file)
@@ -22,9 +22,9 @@ module Data.Array.Parallel.Unlifted.Sequential.Flat.Stream (
 ) where
 
 import Data.Array.Parallel.Base (
-  (:*:)(..), fstS, sndS, ST, Rebox(..))
+  (:*:)(..), fstS, sndS, ST, Rebox(..), traceLoopST)
 import Data.Array.Parallel.Stream (
-  Step(..), Stream(..), mapS, zipS)
+  Step(..), Stream(..), mapS, zipS, sNoArgs, sArgs)
 import Data.Array.Parallel.Unlifted.Sequential.Flat.UArr (
   UArr, MUArr, UA, indexU, lengthU, zipU, fstU, sndU, newDynU, writeMU)
 
@@ -32,7 +32,7 @@ import Data.Array.Parallel.Unlifted.Sequential.Flat.UArr (
 --
 streamU :: UA a => UArr a -> Stream a
 {-# INLINE_STREAM streamU #-}
-streamU !arr = Stream next 0 n
+streamU !arr = Stream next 0 n (sNoArgs "streamU")
   where
     n = lengthU arr
     {-# INLINE next #-}
@@ -43,14 +43,15 @@ streamU !arr = Stream next 0 n
 --
 unstreamU :: UA a => Stream a -> UArr a
 {-# INLINE_STREAM unstreamU #-}
-unstreamU st@(Stream next s n) = newDynU n (\marr -> unstreamMU marr st)
+unstreamU st@(Stream next s n _) = newDynU n (\marr -> unstreamMU marr st)
 
 -- | Fill a mutable array from a stream from left to right and yield
 -- the number of elements written.
 --
 unstreamMU :: UA a => MUArr a s -> Stream a -> ST s Int
 {-# INLINE_U unstreamMU #-}
-unstreamMU marr (Stream next s n) = fill s 0
+unstreamMU marr (Stream next s n c)
+  = traceLoopST ("unstreamMU" `sArgs` c) $ fill s 0
   where
     fill s i = i `seq`
                case next s of