Reproduction for GHC ticket #8763

repro.hs

module Main  (main) where 

import System.Environment (getArgs)
import Control.Monad (when, forM_)
import GHC.ST

nop :: Monad m => a -> m ()
nop _ = return ()
{-# NOINLINE nop #-}

f :: Int -> ST s ()
f n =
    do
      forM_ [2..n] $ \p -> do
        let isPrime = p == (p - 1)
        when isPrime $ 
          forM_ [p + p, p + p + p .. n] $ \k ->  do
            nop k
{-# NOINLINE f #-}

g :: Int -> ST s ()
g n =
    do
      forM_ [2,3..n] $ \p -> do
        let isPrime = p == (p - 1)
        when isPrime $ 
          forM_ [p + p, p + p + p .. n] $ \k ->  do
            nop k
{-# NOINLINE g #-}

fio :: Int -> IO ()
fio n =
    do
      forM_ [2..n] $ \p -> do
        let isPrime = p == (p - 1)
        when isPrime $ 
          forM_ [p + p, p + p + p .. n] $ \k ->  do
            nop k
            nop k
{-# NOINLINE fio #-}

gio :: Int -> IO ()
gio n =
    do
      forM_ [2,3..n] $ \p -> do
        let isPrime = p == (p - 1)
        when isPrime $ 
          forM_ [p + p, p + p + p .. n] $ \k ->  do
            nop k -- remove this line and it should have the same performance as fio
            nop k
{-# NOINLINE gio #-}

main :: IO ()
main = 
    do
      args <- getArgs
      let n  = (read (head args)) :: Int
      case n of
        1 -> print $ runST $ f 40000000
        2 -> print $ runST $ g 40000000
        3 -> fio 40000000 >>= print
        4 -> gio 40000000 >>= print
        _ -> error "arg must be '1', '2', '3' or '4'"