Floating a non-exhaustive case can cause seg-faults

Consider

{-# LANGUAGE MagicHash #-}
module Main where

import GHC.Exts

data Var = TyVar !Int Bool Bool
         | TcTyVar Bool !Int Bool
         | Var Bool Bool !Int
         deriving (Show)

scrut :: Var -> (Bool, String)
scrut v = (True, case v of
    TcTyVar {} -> "OK"
    _ -> show v ++ show (case (case v of 
                                 TyVar b _ _ -> b 
                                 Var _ _ b -> b) of 
                           I# x# -> if x# ==# 7# 
                                    then show (I# (x# +# 1#)) 
                                    else show (I# (x# +# 2#))))

main = putStrLn $ snd (scrut (TcTyVar True 1 False))

Try this:

ghc -O -fno-specialise Segfault.hs
./Segfault

The bug is in the new case-floating machinery. If you compile with -dverbose-core2core you'll see the following after the first float-out phase:

Main.scrut =
  \ (v_acT :: Main.Var) ->
    case case v_acT of _ {
           Main.TyVar b_acU ds_dw6 ds_dw7 -> b_acU;
           Main.Var ds_dw4 ds_dw5 b_acV -> b_acV
         }
    of _ { GHC.Types.I# x#_szn ->
    (GHC.Types.True,
     case v_acT of wild_Xh {
       __DEFAULT ->
         GHC.Base.augment
           @ GHC.Types.Char
           (\ (@ b_axY)
              (c_axZ [Lbv=OneShot] :: GHC.Types.Char -> b_axY -> b_axY)
              (n_ay0 [Lbv=OneShot] :: b_axY) ->
              GHC.Base.foldr
                @ GHC.Types.Char @ b_axY c_axZ n_ay0 ($cshow_avj v_acT))
           (GHC.Show.$fShow[]_$cshow
              @ GHC.Types.Char
              GHC.Show.$fShowChar
              (case case x#_szn of _ {
                      __DEFAULT -> GHC.Types.False;
                      7 -> GHC.Types.True
                    }
               of _ {
                 GHC.Types.False ->
                   GHC.Show.$fShowInt_$cshow (GHC.Types.I# (GHC.Prim.+# x#_szn 2));
                 GHC.Types.True ->
                   GHC.Show.$fShowInt_$cshow (GHC.Types.I# (GHC.Prim.+# x#_szn 1))
               }));
       Main.TcTyVar ds_dwf ds_dwg ds_dwh -> lvl_szP
     })
    }

See the way that case case v_acT has gotten floated right out? There are two separate bugs here:

1. It's wrong from a strictness point of view, because it's made scrut strict in v
2. It's wrong from a semantics point of view, because the floated-out case is non-exhaustive, and that's what ultimately leads to the seg fault.

Problem (2) is with CoreUtils.exprOkForSpeculation. A non-exhaustive case is not ok for speculation!

Problem (1) is with the AnnCase case of SetLevels.lvlExpr, where we're testing the wrong expression for ok-for-speculation-nes. Both are quite easy to fix.

Thanks to Max for identifying this bug.

Trac metadata

Trac field	Value
Version	7.2.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture