diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 5327acddf02c0394599ca992109227360dde90c9..4f7a0da83548e0c77199120a4099b223eed013ef 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -645,8 +645,21 @@ cpeRhsE env (Case scrut bndr ty alts) ; let bndr1 = bndr `setIdUnfolding` evaldUnfolding -- Record that the case binder is evaluated in the alternatives ; (env', bndr2) <- cpCloneBndr env bndr1 - ; alts' <- mapM (sat_alt env') alts - ; return (floats, Case scrut' bndr2 ty alts') } + ; let alts' + -- This flag is intended to aid in debugging strictness + -- analysis bugs. These are particularly nasty to chase down as + -- they may manifest as segmentation faults. When this flag is + -- enabled we instead produce an 'error' expression to catch + -- the case where a function we think should bottom + -- unexpectedly returns. + | gopt Opt_CatchBottoms (cpe_dynFlags env) + , not (altsAreExhaustive alts) + = addDefault alts (Just err) + | otherwise = alts + where err = mkRuntimeErrorApp rUNTIME_ERROR_ID ty + "Bottoming expression returned" + ; alts'' <- mapM (sat_alt env') alts' + ; return (floats, Case scrut' bndr2 ty alts'') } where sat_alt env (con, bs, rhs) = do { (env2, bs') <- cpCloneBndrs env bs diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs index eec524f86d564963c0df50c8a4009da3e5d418ca..540a36e0a102044f832a64b2a613b6ea045d0a6d 100644 --- a/compiler/coreSyn/CoreUtils.hs +++ b/compiler/coreSyn/CoreUtils.hs @@ -30,6 +30,7 @@ module CoreUtils ( exprIsBig, exprIsConLike, rhsIsStatic, isCheapApp, isExpandableApp, exprIsLiteralString, exprIsTopLevelBindable, + altsAreExhaustive, -- * Equality cheapEqExpr, cheapEqExpr', eqExpr, diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 2be121e13338df495ab874c9916493cbefaa0909..5e33c2ee54052639fb007068be3a0aaa5754b51d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -470,6 +470,7 @@ data GeneralFlag | Opt_CprAnal | Opt_WorkerWrapper | Opt_SolveConstantDicts + | Opt_CatchBottoms -- Interface files | Opt_IgnoreInterfacePragmas @@ -3778,6 +3779,7 @@ fFlagsDeps = [ flagSpec "version-macros" Opt_VersionMacros, flagSpec "worker-wrapper" Opt_WorkerWrapper, flagSpec "solve-constant-dicts" Opt_SolveConstantDicts, + flagSpec "catch-bottoms" Opt_CatchBottoms, flagSpec "show-warning-groups" Opt_ShowWarnGroups, flagSpec "hide-source-paths" Opt_HideSourcePaths, flagSpec "show-hole-constraints" Opt_ShowHoleConstraints, diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst index fd4adc7d209d671938e28cd2c8597e5b2eb4b464..af937ae64d29946bf9cf18ccf3a2b46adef1145b 100644 --- a/docs/users_guide/debugging.rst +++ b/docs/users_guide/debugging.rst @@ -389,6 +389,13 @@ Checking for consistency instead of ``undef`` in calls. This makes it easier to catch subtle code generator and runtime system bugs (e.g. see :ghc-ticket:`11487`). +.. ghc-flag:: -fcatch-bottoms + + Instructs the simplifier to emit ``error`` expressions in the continuation + of empty case analyses (which should bottom and consequently not return). + This is helpful when debugging demand analysis bugs which can sometimes + manifest as segmentation faults. + .. _checking-determinism: Checking for determinism diff --git a/utils/mkUserGuidePart/Options/CompilerDebugging.hs b/utils/mkUserGuidePart/Options/CompilerDebugging.hs index 97040206017f070ad074c3f4a94b0229ff4a7b38..e68216bdebcc7c2becc7a5acd980a66f204940a8 100644 --- a/utils/mkUserGuidePart/Options/CompilerDebugging.hs +++ b/utils/mkUserGuidePart/Options/CompilerDebugging.hs @@ -278,4 +278,10 @@ compilerDebuggingOptions = "Takes a string argument." , flagType = DynamicFlag } + , flag { flagName = "-fcatch-bottoms" + , flagDescription = + "Insert ``error`` expressions after bottoming expressions; useful "++ + "when debugging the compiler." + , flagType = DynamicFlag + } ]