parTraversable not creating any sparks

[bwroga]

When I run this program with -s:

module Main where

import Control.Parallel.Strategies

main :: IO ()
main = do let xs = take 1000 $ product . take 1000 . repeat <$> [1..]
              x  = product (xs `using` parList rseq)
          putStrLn (show x)

Sparks are created:

SPARKS: 1000 (993 converted, 0 overflowed, 0 dud, 6 GC'd, 1 fizzled)

If I change parList to parTraversable

x  = product (xs `using` parTraversable rseq)

no sparks are created:

SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

If I change rseq to rdeepseq:

main = do let xs = (take 1000 $ product . take 1000 . repeat <$> [1..]) :: [Integer]
              x  = product (xs `using` parList rdeepseq)
          putStrLn (show x)

No sparks are created

SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

If I use parTraversable over a Map:

main :: IO ()
main = do let xs = (take 1000 $ take 1000 . repeat <$> [1..]) :: [[Integer]]
              m  = Map.fromList $ zip [0..] xs
              x  = product (fmap product m `using` parTraversable rseq)
          putStrLn (show x)

No sparks are created

SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

using rdeepseq results in the same behavior.

My cabal file has the following ghc options:

-O1 -threaded -rtsopts -with-rtsopts=-N4

I am using the stack resolver nightly-2017-10-06 which has parallel-3.2.1.1 and ghc-8.2.1

I originally asked about this on stackoverflow and the behavior was confirmed by another user.

[bgamari]

It looks like GHC's PrelRules.sparkRule, which rewrites applications of spark# to expressions already in head normal-form, is firing here, rewriting the sparks out of existence. In the case of the Map example the expression looks like this prior to the rule firing,

                   GHC.Prim.spark#
                     @ (Control.Parallel.Strategies.Lift Integer)
                     @ GHC.Prim.RealWorld
                     (Control.Parallel.Strategies.Lift @ Integer ipv1_s6xJ)
                     eta_B1

where eta_B1 :: State# RealWorld

[bgamari]

It looks like Lift is a sort of identity functor but sadly it carries no documentation so it's not entirely clear what purpose it serves.

[simonmar]

Something must have gone wrong in order to get to the point where spark# is applied to Lift x. partTraversable is traverse rparWith, where

rparWith s a = do l <- rpar r; return (case l of Lift x -> x)
  where r = case s a of
              Eval f -> case f realWorld# of
                          (# _, a' #) -> Lift a'

data Lift a = Lift a

So for rpar to be applied directly to the Lift a, we must have lifted out the evaluation early. Perhaps strictness is wrong somewhere?

[mikekeke]

Seems like I faced same issue trying examples from "Parallel and Concurrent Programming in Haskell" by Simon Marlow:
(Just (fib 35), Just (fib 36)) using parPair rdeepseq rdeepseq
or even
(fib 35, fib 36) using parPair rdeepseq rdeepseq
runs with 0 sparks created, on one core

While with
(fib 35, fib 36) usingevalPair (rparWith (rseq . force))
sparks created, 2 cores running with -N2

Same with parList

fib taken from book:
fib :: Integer -> Integer
fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

[Fuuzetsu]

@glutamate this ticket explains what we saw in Feb/March I think.