[GHC] #10414: Buggy behavior with threaded runtime (-N1 working, -N2 getting into <<loop>>)

[GHC]

#10414: Buggy behavior with threaded runtime (-N1 working, -N2 getting into
<<loop>>)
-------------------------------------+-------------------------------------
        Reporter:  exio4             |                   Owner:
            Type:  bug               |                  Status:  new
        Priority:  normal            |               Milestone:
       Component:  Compiler          |                 Version:  7.10.1
      Resolution:                    |                Keywords:
Operating System:  Unknown/Multiple  |            Architecture:
 Type of failure:  Incorrect result  |  Unknown/Multiple
  at runtime                         |               Test Case:
      Blocked By:                    |                Blocking:
 Related Tickets:                    |  Differential Revisions:
-------------------------------------+-------------------------------------

Comment (by michaelt):

 The mechanism for attaching source must be before my eyes, but here is the
 reduced module:

 {{{#!hs
 {-# LANGUAGE MagicHash, UnboxedTuples #-}
 import Control.Applicative
 import Control.Monad
 import GHC.Exts

 newtype Eval a = Eval (State# RealWorld -> (# State# RealWorld, a #))

 instance Functor Eval where fmap = liftM

 instance Applicative Eval where  (<*>) = ap; pure  = return

 instance Monad Eval where
   return x = Eval $ \s -> (# s, x #)
   Eval x >>= k = Eval $ \s -> case x s of
                                 (# s', a #) -> case k a of
                                                       Eval f -> f s'

 rparWith s a = Eval $ \s0 -> spark# r s0
   where r = case s a of  Eval f -> case f realWorld# of  (# _, a' #) -> a'


 runEval :: Eval a -> a
 runEval (Eval x) = case x realWorld# of (# _, a #) -> a


 main :: IO ()
 main = do -- print $ length (pf 'x') -- either statement works at least on
 and off
           print (program 'y')   -- but I seem to lose the effect if I use
 both statements

 program =
   pchunk . concatMap (pchunk . concatMap (pchunk . concatMap (pchunk .
 show) . show) . show) . show
   where
   -- the effect seems to vanish if I eta expand pchunk
   pchunk  = runEval
          . fmap concat
          .  mapM (rparWith (mapM (\x -> Eval $ \s -> seq# x s) ))
          . chunk'

   -- the effect seems to disappear if I reject splitAt in favor
   -- of a pattern match chunk' (a:b:c:xs) = [a,b,c]: chunk' xs
   chunk' ::  [a] -> [[a]]
   chunk' [] = []
   chunk' xs =  as : chunk' bs where (as,bs) = splitAt 3 xs


 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10414#comment:14>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler