Adding "-auto-all" when using "-O2 -prof" causes "<<loop>>"

[BenMoseley]

The program below works fine (and outputs "ZeroPmt?") when compiled with "-O2 -prof -fno-cse", but when you add in "-auto-all" it causes "<<loop>>".

There are many ways to workaround the problem, uncommenting pretty much any of the commented-out lines avoids the issue, but my impression is that adding "-auto-all" shouldn't cause this.

This is with stock 6.10.1. "-dcore-lint" has no effect.

--
-- Compile with : ghc -O2 -prof -auto-all -fno-cse --make ~/loop.hs
--
-- ...and it breaks, outputting <<loop>>
-- ...compile without "-auto-all" and you get ZeroPmt
--
import Data.IORef
import qualified Data.Map as Map
import System.IO
import System.IO.Unsafe
import System.Mem.StableName

main :: IO ()
main = do

 -- putStrLn $ show $ unHC $ mkHC ZeroPmt -- Works OK
 putStrLn $ show $ unHC $ mkHC $ unHC $ mkHC ZeroPmt

data Expr = Add | ZeroPmt deriving (Ord, Eq, Show)
data ExprHC = ExprHC { unStableName :: !(StableName Expr), unHC ::
!Expr} deriving (Eq)

-- {-# NOINLINE mkHC #-} -- Works OK
-- mkHC e = hashConser e -- Works OK
mkHC = hashConser

{-# NOINLINE hashConser #-}
hashConser :: Expr -> ExprHC
hashConser e = deepSeq e (unsafePerformIO $ mkHC' e)
-- hashConser e = seq (e == e) (unsafePerformIO $ mkHC' e)
 where
   refTbl = unsafePerformIO $ newIORef Map.empty

   mkHC' e = do
     tbl <- readIORef refTbl
     case Map.lookup e tbl of
       Just ehc -> return ehc
       Nothing -> do
                     sn <- makeStableName e
                     let ehc = ExprHC sn e
                     writeIORef refTbl $ Map.insert e ehc tbl
                     return ehc

deepSeq :: Eq e => e -> x -> x
deepSeq e x = seq (e == e) x

[simonmar]

So what happened here is that GHC decided to transform this

hashConser e = deepSeq e (unsafePerformIO $ mkHC' e)

into this

hashConser e = case unsafePerformIO $ mkHC' e of x -> deepSeq e x

which it is allowed to do, because deepSeq is strict in both its arguments. But the second version has different behaviour in this case, due to the use of unsafePerformIO. Consider this call to hashConser:

hashConser (hashConser X)

the first call to hashConser is passed the (unevaluated) hashConser X as its argument. The first thing it does is to write into the memo table Map.insert e ehc tbl, where e is hashConser X. This causes the evaluation of e, which tries to look up in the hash table, leading to a loop.

GHC isn't breaking the rules here, I think. It is confusing that the unexpected behaviour only happens with -auto-all, but that's the nature of unsafePerformIO: it's possible to write programs that have non-deterministic behaviour.

You can fix it by using Control.Parallel.pseq instead of seq in the definition of deepSeq.