[Git][ghc/ghc][master] Check for rubbish literals in Lint
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a3afae0c by Simon Peyton Jones at 2025-12-25T15:26:36-05:00 Check for rubbish literals in Lint Addresses #26607. See new Note [Checking for rubbish literals] in GHC.Core.Lint - - - - - 5 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/IfaceToCore.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -405,7 +405,6 @@ data LintPassResultConfig = LintPassResultConfig { lpr_diagOpts :: !DiagOpts , lpr_platform :: !Platform , lpr_makeLintFlags :: !LintFlags - , lpr_showLintWarnings :: !Bool , lpr_passPpr :: !SDoc , lpr_localsInScope :: ![Var] } @@ -425,18 +424,16 @@ lintPassResult logger cfg binds "Core Linted result of " ++ renderWithContext defaultSDocContext (lpr_passPpr cfg) ; displayLintResults logger - (lpr_showLintWarnings cfg) (lpr_passPpr cfg) + (lpr_passPpr cfg) (pprCoreBindings binds) warns_and_errs } displayLintResults :: Logger - -> Bool -- ^ If 'True', display linter warnings. - -- If 'False', ignore linter warnings. -> SDoc -- ^ The source of the linted program -> SDoc -- ^ The linted program, pretty-printed -> WarnsAndErrs -> IO () -displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) +displayLintResults logger pp_what pp_pgm (warns, errs) | not (isEmptyBag errs) = do { lintMessage logger (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs @@ -447,7 +444,6 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) | not (isEmptyBag warns) , log_enable_debug (logFlags logger) - , display_warnings = lintMessage logger (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns)) @@ -858,6 +854,31 @@ remember the details, but could probably recover it if we want to revisit. So Lint current accepts (Coercion co) in arbitrary places. There is no harm in that: it really is a value, albeit a zero-bit value. +Note [Checking for rubbish literals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC uses "rubbish literals" (see Note [Rubbish literals] in GHC.Types.Literal) +to fill for absent arguments, in worker/wrapper. See Note [Absent fillers] in +GHC.Core.Opt.WorkWrap.Utils. + +These rubbish literals are almost always discarded as dead code, in post-w/w +optimisation. If they are ever used at runtime, something is wrong. For lifted +absent fillers, instead of using a `LitRubbish` we use an error thunk. So if, +through some catastrophe, it is used at runtime after all, we get a civilised +runtime error + +But for /unlifted/ ones we can't use a thunk, so we use a random "rubbish" value +of the right type. That could lead to bizarre behaviour at runtime. + +Worse, for dictionaries, for reasons explained in Note [Absent fillers], we also +don't use an error thunk. Now if we use it at runtime after all, a seg-fault will +happen (e.g. #26416). Yikes! + +So Lint warns about the presence of rubbish literals, in the output of CorePrep +only (see GHC.Driver.Config.Core.Lint.perPassFlags). It's a warning, not an +error, because it's not /necessarily/ wrong to see a rubbish literal. But it's +suspicious and worth investigating if you have a seg-fault or bizarre behaviour. + + ************************************************************************ * * \subsection[lintCoreExpr]{lintCoreExpr} @@ -883,7 +904,14 @@ lintCoreExpr (Var var) ; return var_pair } lintCoreExpr (Lit lit) - = return (literalType lit, zeroUE) + = do { flags <- getLintFlags + + ; -- See Note [Checking for rubbish literals] + when (lf_check_rubbish_lits flags) $ + checkWarnL (not (isLitRubbish lit)) $ + hang (text "Unexpected rubbish literal:") 2 (ppr lit) + + ; return (literalType lit, zeroUE) } lintCoreExpr (Cast expr co) = do { (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr) @@ -2785,7 +2813,7 @@ lintAxioms :: Logger -> [CoAxiom Branched] -> IO () lintAxioms logger cfg what axioms = - displayLintResults logger True what (vcat $ map pprCoAxiom axioms) $ + displayLintResults logger what (vcat $ map pprCoAxiom axioms) $ initL cfg $ do { mapM_ lint_axiom axioms ; let axiom_groups = groupWith coAxiomTyCon axioms @@ -2968,9 +2996,10 @@ data LintFlags = LF { lf_check_global_ids :: Bool -- See Note [Checking for global Ids] , lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers] , lf_check_static_ptrs :: StaticPtrCheck -- ^ See Note [Checking StaticPtrs] - , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications] - , lf_check_linearity :: Bool -- ^ See Note [Linting linearity] - , lf_check_fixed_rep :: Bool -- See Note [Checking for representation polymorphism] + , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications] + , lf_check_linearity :: Bool -- ^ See Note [Linting linearity] + , lf_check_fixed_rep :: Bool -- ^ See Note [Checking for representation polymorphism] + , lf_check_rubbish_lits :: Bool -- ^ See Note [Checking for rubbish literals] } -- See Note [Checking StaticPtrs] ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2168,20 +2168,24 @@ it doesn't have the trickiness of the let-can-float invariant to worry about. -- Suppose @f x@ diverges; then @C (f x)@ is not a value. -- We check for this using needsCaseBinding below exprIsHNF :: CoreExpr -> Bool -- True => Value-lambda, constructor, PAP -exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding +exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding True -- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as -- data constructors. Conlike arguments are considered interesting by the -- inliner. exprIsConLike :: CoreExpr -> Bool -- True => lambda, conlike, PAP -exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding +exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding False -- | Returns true for values or value-like expressions. These are lambdas, -- constructors / CONLIKE functions (as determined by the function argument) -- or PAPs. -- -exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf e +exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) + -> (Unfolding -> Bool) + -> Bool + -> CoreExpr -> Bool +{-# INLINE exprIsHNFlike #-} -- Specialise at its two call sites +exprIsHNFlike is_con is_con_unf rubbish_lit_result e = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ is_hnf_like e where @@ -2200,9 +2204,12 @@ exprIsHNFlike is_con is_con_unf e || definitelyUnliftedType (idType v) -- Unlifted binders are always evaluated (#20140) - is_hnf_like (Lit l) = not (isLitRubbish l) + is_hnf_like (Lit lit) + | isLitRubbish lit = rubbish_lit_result + | otherwise = True -- Regarding a LitRubbish as ConLike leads to unproductive inlining in -- WWRec, see #20035 + is_hnf_like (Type _) = True -- Types are honorary Values; -- we don't mind copying them is_hnf_like (Coercion _) = True -- Same for coercions @@ -2283,7 +2290,6 @@ exprIsHNFlike is_con is_con_unf e | otherwise = Nothing -{-# INLINE exprIsHNFlike #-} {- Note [exprIsHNF Tick] ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -106,26 +106,18 @@ initLintPassResultConfig dflags extra_vars pass = LintPassResultConfig { lpr_diagOpts = initDiagOpts dflags , lpr_platform = targetPlatform dflags , lpr_makeLintFlags = perPassFlags dflags pass - , lpr_showLintWarnings = showLintWarnings pass , lpr_passPpr = ppr pass , lpr_localsInScope = extra_vars } -showLintWarnings :: CoreToDo -> Bool --- Disable Lint warnings on the first simplifier pass, because --- there may be some INLINE knots still tied, which is tiresomely noisy -showLintWarnings (CoreDoSimplify cfg) - | SimplPhase InitialPhase <- sm_phase (so_mode cfg) - = False -showLintWarnings _ = True - perPassFlags :: DynFlags -> CoreToDo -> LintFlags perPassFlags dflags pass = (defaultLintFlags dflags) - { lf_check_global_ids = check_globals + { lf_check_global_ids = check_globals , lf_check_inline_loop_breakers = check_lbs - , lf_check_static_ptrs = check_static_ptrs - , lf_check_linearity = check_linearity } + , lf_check_static_ptrs = check_static_ptrs + , lf_check_linearity = check_linearity + , lf_check_rubbish_lits = check_rubbish } where -- See Note [Checking for global Ids] check_globals = case pass of @@ -137,6 +129,14 @@ perPassFlags dflags pass check_lbs = case pass of CoreDesugar -> False CoreDesugarOpt -> False + + -- Disable Lint warnings on the first simplifier pass, because + -- there may be some INLINE knots still tied, which is tiresomely noisy + CoreDoSimplify cfg + | SimplPhase InitialPhase <- sm_phase (so_mode cfg) + -> True + | otherwise + -> False _ -> True -- See Note [Checking StaticPtrs] @@ -153,6 +153,11 @@ perPassFlags dflags pass CoreDesugar -> True _ -> False) + -- See Note [Checking for rubbish literals] in GHC.Core.Lint + check_rubbish = case pass of + CorePrep -> True + _ -> False + initLintConfig :: DynFlags -> [Var] -> LintConfig initLintConfig dflags vars =LintConfig { l_diagOpts = initDiagOpts dflags @@ -168,4 +173,5 @@ defaultLintFlags dflags = LF { lf_check_global_ids = False , lf_check_linearity = gopt Opt_DoLinearCoreLinting dflags , lf_report_unsat_syns = True , lf_check_fixed_rep = True + , lf_check_rubbish_lits = True } ===================================== compiler/GHC/Driver/Config/Core/Lint/Interactive.hs ===================================== @@ -10,12 +10,9 @@ import GHC.Driver.Config.Core.Lint import GHC.Core import GHC.Core.Ppr - import GHC.Core.Lint import GHC.Core.Lint.Interactive ---import GHC.Runtime.Context - import GHC.Data.Bag import GHC.Utils.Outputable as Outputable @@ -27,7 +24,7 @@ lintInteractiveExpr what hsc_env expr | not (gopt Opt_DoCoreLinting dflags) = return () | Just err <- lintExpr (initLintConfig dflags $ interactiveInScope $ hsc_IC hsc_env) expr - = displayLintResults logger False what (pprCoreExpr expr) (emptyBag, err) + = displayLintResults logger what (pprCoreExpr expr) (emptyBag, err) | otherwise = return () where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1413,7 +1413,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd Nothing -> return () Just errs -> do logger <- getLogger - liftIO $ displayLintResults logger False doc + liftIO $ displayLintResults logger doc (pprCoreExpr rhs') (emptyBag, errs) } ; return (bndrs', args', rhs') } @@ -2006,7 +2006,7 @@ tcUnfoldingRhs is_compulsory toplvl name expr case lintUnfolding is_compulsory (initLintConfig dflags in_scope) noSrcLoc core_expr' of Nothing -> return () Just errs -> liftIO $ - displayLintResults logger False doc + displayLintResults logger doc (pprCoreExpr core_expr') (emptyBag, errs) return core_expr' where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3afae0c85fa57479378a5df5bbde2e3... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3afae0c85fa57479378a5df5bbde2e3... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Marge Bot (@marge-bot)