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:
- It's wrong from a strictness point of view, because it's made
scrut
strict inv
- 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 |