Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/Core/Lint.hs
    ... ... @@ -405,7 +405,6 @@ data LintPassResultConfig = LintPassResultConfig
    405 405
       { lpr_diagOpts         :: !DiagOpts
    
    406 406
       , lpr_platform         :: !Platform
    
    407 407
       , lpr_makeLintFlags    :: !LintFlags
    
    408
    -  , lpr_showLintWarnings :: !Bool
    
    409 408
       , lpr_passPpr          :: !SDoc
    
    410 409
       , lpr_localsInScope    :: ![Var]
    
    411 410
       }
    
    ... ... @@ -425,18 +424,16 @@ lintPassResult logger cfg binds
    425 424
                "Core Linted result of " ++
    
    426 425
                renderWithContext defaultSDocContext (lpr_passPpr cfg)
    
    427 426
            ; displayLintResults logger
    
    428
    -                            (lpr_showLintWarnings cfg) (lpr_passPpr cfg)
    
    427
    +                            (lpr_passPpr cfg)
    
    429 428
                                 (pprCoreBindings binds) warns_and_errs
    
    430 429
            }
    
    431 430
     
    
    432 431
     displayLintResults :: Logger
    
    433
    -                   -> Bool -- ^ If 'True', display linter warnings.
    
    434
    -                           --   If 'False', ignore linter warnings.
    
    435 432
                        -> SDoc -- ^ The source of the linted program
    
    436 433
                        -> SDoc -- ^ The linted program, pretty-printed
    
    437 434
                        -> WarnsAndErrs
    
    438 435
                        -> IO ()
    
    439
    -displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
    
    436
    +displayLintResults logger pp_what pp_pgm (warns, errs)
    
    440 437
       | not (isEmptyBag errs)
    
    441 438
       = do { lintMessage logger
    
    442 439
                (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs
    
    ... ... @@ -447,7 +444,6 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
    447 444
     
    
    448 445
       | not (isEmptyBag warns)
    
    449 446
       , log_enable_debug (logFlags logger)
    
    450
    -  , display_warnings
    
    451 447
       = lintMessage logger
    
    452 448
             (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
    
    453 449
     
    
    ... ... @@ -858,6 +854,31 @@ remember the details, but could probably recover it if we want to revisit.
    858 854
     So Lint current accepts (Coercion co) in arbitrary places.  There is no harm in
    
    859 855
     that: it really is a value, albeit a zero-bit value.
    
    860 856
     
    
    857
    +Note [Checking for rubbish literals]
    
    858
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    859
    +GHC uses "rubbish literals" (see Note [Rubbish literals] in GHC.Types.Literal)
    
    860
    +to fill for absent arguments, in worker/wrapper.  See Note [Absent fillers] in
    
    861
    +GHC.Core.Opt.WorkWrap.Utils.
    
    862
    +
    
    863
    +These rubbish literals are almost always discarded as dead code, in post-w/w
    
    864
    +optimisation.  If they are ever used at runtime, something is wrong.  For lifted
    
    865
    +absent fillers, instead of using a `LitRubbish` we use an error thunk. So if,
    
    866
    +through some catastrophe, it is used at runtime after all, we get a civilised
    
    867
    +runtime error
    
    868
    +
    
    869
    +But for /unlifted/ ones we can't use a thunk, so we use a random "rubbish" value
    
    870
    +of the right type.  That could lead to bizarre behaviour at runtime.
    
    871
    +
    
    872
    +Worse, for dictionaries, for reasons explained in Note [Absent fillers], we also
    
    873
    +don't use an error thunk. Now if we use it at runtime after all, a seg-fault will
    
    874
    +happen (e.g. #26416). Yikes!
    
    875
    +
    
    876
    +So Lint warns about the presence of rubbish literals, in the output of CorePrep
    
    877
    +only (see GHC.Driver.Config.Core.Lint.perPassFlags).  It's a warning, not an
    
    878
    +error, because it's not /necessarily/ wrong to see a rubbish literal. But it's
    
    879
    +suspicious and worth investigating if you have a seg-fault or bizarre behaviour.
    
    880
    +
    
    881
    +
    
    861 882
     ************************************************************************
    
    862 883
     *                                                                      *
    
    863 884
     \subsection[lintCoreExpr]{lintCoreExpr}
    
    ... ... @@ -883,7 +904,14 @@ lintCoreExpr (Var var)
    883 904
            ; return var_pair }
    
    884 905
     
    
    885 906
     lintCoreExpr (Lit lit)
    
    886
    -  = return (literalType lit, zeroUE)
    
    907
    +  = do { flags <- getLintFlags
    
    908
    +
    
    909
    +       ; -- See Note [Checking for rubbish literals]
    
    910
    +         when (lf_check_rubbish_lits flags)     $
    
    911
    +         checkWarnL (not (isLitRubbish lit)) $
    
    912
    +         hang (text "Unexpected rubbish literal:") 2 (ppr lit)
    
    913
    +
    
    914
    +       ; return (literalType lit, zeroUE) }
    
    887 915
     
    
    888 916
     lintCoreExpr (Cast expr co)
    
    889 917
       = do { (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr)
    
    ... ... @@ -2785,7 +2813,7 @@ lintAxioms :: Logger
    2785 2813
                -> [CoAxiom Branched]
    
    2786 2814
                -> IO ()
    
    2787 2815
     lintAxioms logger cfg what axioms =
    
    2788
    -  displayLintResults logger True what (vcat $ map pprCoAxiom axioms) $
    
    2816
    +  displayLintResults logger what (vcat $ map pprCoAxiom axioms) $
    
    2789 2817
       initL cfg $
    
    2790 2818
       do { mapM_ lint_axiom axioms
    
    2791 2819
          ; let axiom_groups = groupWith coAxiomTyCon axioms
    
    ... ... @@ -2968,9 +2996,10 @@ data LintFlags
    2968 2996
       = LF { lf_check_global_ids           :: Bool -- See Note [Checking for global Ids]
    
    2969 2997
            , lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers]
    
    2970 2998
            , lf_check_static_ptrs :: StaticPtrCheck -- ^ See Note [Checking StaticPtrs]
    
    2971
    -       , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications]
    
    2972
    -       , lf_check_linearity :: Bool -- ^ See Note [Linting linearity]
    
    2973
    -       , lf_check_fixed_rep :: Bool -- See Note [Checking for representation polymorphism]
    
    2999
    +       , lf_report_unsat_syns :: Bool  -- ^ See Note [Linting type synonym applications]
    
    3000
    +       , lf_check_linearity :: Bool    -- ^ See Note [Linting linearity]
    
    3001
    +       , lf_check_fixed_rep :: Bool    -- ^ See Note [Checking for representation polymorphism]
    
    3002
    +       , lf_check_rubbish_lits :: Bool -- ^ See Note [Checking for rubbish literals]
    
    2974 3003
         }
    
    2975 3004
     
    
    2976 3005
     -- 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.
    2168 2168
     -- Suppose @f x@ diverges; then @C (f x)@ is not a value.
    
    2169 2169
     -- We check for this using needsCaseBinding below
    
    2170 2170
     exprIsHNF :: CoreExpr -> Bool           -- True => Value-lambda, constructor, PAP
    
    2171
    -exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding
    
    2171
    +exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding True
    
    2172 2172
     
    
    2173 2173
     -- | Similar to 'exprIsHNF' but includes CONLIKE functions as well as
    
    2174 2174
     -- data constructors. Conlike arguments are considered interesting by the
    
    2175 2175
     -- inliner.
    
    2176 2176
     exprIsConLike :: CoreExpr -> Bool       -- True => lambda, conlike, PAP
    
    2177
    -exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding
    
    2177
    +exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding False
    
    2178 2178
     
    
    2179 2179
     -- | Returns true for values or value-like expressions. These are lambdas,
    
    2180 2180
     -- constructors / CONLIKE functions (as determined by the function argument)
    
    2181 2181
     -- or PAPs.
    
    2182 2182
     --
    
    2183
    -exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool
    
    2184
    -exprIsHNFlike is_con is_con_unf e
    
    2183
    +exprIsHNFlike :: HasDebugCallStack => (Var -> Bool)
    
    2184
    +                                   -> (Unfolding -> Bool)
    
    2185
    +                                   -> Bool
    
    2186
    +                                   -> CoreExpr -> Bool
    
    2187
    +{-# INLINE exprIsHNFlike #-}   -- Specialise at its two call sites
    
    2188
    +exprIsHNFlike is_con is_con_unf rubbish_lit_result e
    
    2185 2189
       = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $
    
    2186 2190
         is_hnf_like e
    
    2187 2191
       where
    
    ... ... @@ -2200,9 +2204,12 @@ exprIsHNFlike is_con is_con_unf e
    2200 2204
           || definitelyUnliftedType (idType v)
    
    2201 2205
             -- Unlifted binders are always evaluated (#20140)
    
    2202 2206
     
    
    2203
    -    is_hnf_like (Lit l)          = not (isLitRubbish l)
    
    2207
    +    is_hnf_like (Lit lit)
    
    2208
    +      | isLitRubbish lit = rubbish_lit_result
    
    2209
    +      | otherwise        = True
    
    2204 2210
             -- Regarding a LitRubbish as ConLike leads to unproductive inlining in
    
    2205 2211
             -- WWRec, see #20035
    
    2212
    +
    
    2206 2213
         is_hnf_like (Type _)         = True       -- Types are honorary Values;
    
    2207 2214
                                                   -- we don't mind copying them
    
    2208 2215
         is_hnf_like (Coercion _)     = True       -- Same for coercions
    
    ... ... @@ -2283,7 +2290,6 @@ exprIsHNFlike is_con is_con_unf e
    2283 2290
               | otherwise
    
    2284 2291
               = Nothing
    
    2285 2292
     
    
    2286
    -{-# INLINE exprIsHNFlike #-}
    
    2287 2293
     
    
    2288 2294
     {-
    
    2289 2295
     Note [exprIsHNF Tick]
    

  • compiler/GHC/Driver/Config/Core/Lint.hs
    ... ... @@ -106,26 +106,18 @@ initLintPassResultConfig dflags extra_vars pass = LintPassResultConfig
    106 106
       { lpr_diagOpts      = initDiagOpts dflags
    
    107 107
       , lpr_platform      = targetPlatform dflags
    
    108 108
       , lpr_makeLintFlags = perPassFlags dflags pass
    
    109
    -  , lpr_showLintWarnings = showLintWarnings pass
    
    110 109
       , lpr_passPpr = ppr pass
    
    111 110
       , lpr_localsInScope = extra_vars
    
    112 111
       }
    
    113 112
     
    
    114
    -showLintWarnings :: CoreToDo -> Bool
    
    115
    --- Disable Lint warnings on the first simplifier pass, because
    
    116
    --- there may be some INLINE knots still tied, which is tiresomely noisy
    
    117
    -showLintWarnings (CoreDoSimplify cfg)
    
    118
    -  | SimplPhase InitialPhase <- sm_phase (so_mode cfg)
    
    119
    -  = False
    
    120
    -showLintWarnings _ = True
    
    121
    -
    
    122 113
     perPassFlags :: DynFlags -> CoreToDo -> LintFlags
    
    123 114
     perPassFlags dflags pass
    
    124 115
       = (defaultLintFlags dflags)
    
    125
    -               { lf_check_global_ids = check_globals
    
    116
    +               { lf_check_global_ids           = check_globals
    
    126 117
                    , lf_check_inline_loop_breakers = check_lbs
    
    127
    -               , lf_check_static_ptrs = check_static_ptrs
    
    128
    -               , lf_check_linearity = check_linearity }
    
    118
    +               , lf_check_static_ptrs          = check_static_ptrs
    
    119
    +               , lf_check_linearity            = check_linearity
    
    120
    +               , lf_check_rubbish_lits         = check_rubbish }
    
    129 121
       where
    
    130 122
         -- See Note [Checking for global Ids]
    
    131 123
         check_globals = case pass of
    
    ... ... @@ -137,6 +129,14 @@ perPassFlags dflags pass
    137 129
         check_lbs = case pass of
    
    138 130
                           CoreDesugar    -> False
    
    139 131
                           CoreDesugarOpt -> False
    
    132
    +
    
    133
    +                      -- Disable Lint warnings on the first simplifier pass, because
    
    134
    +                      -- there may be some INLINE knots still tied, which is tiresomely noisy
    
    135
    +                      CoreDoSimplify cfg
    
    136
    +                        | SimplPhase InitialPhase <- sm_phase (so_mode cfg)
    
    137
    +                        -> True
    
    138
    +                        | otherwise
    
    139
    +                        -> False
    
    140 140
                           _              -> True
    
    141 141
     
    
    142 142
         -- See Note [Checking StaticPtrs]
    
    ... ... @@ -153,6 +153,11 @@ perPassFlags dflags pass
    153 153
                               CoreDesugar -> True
    
    154 154
                               _ -> False)
    
    155 155
     
    
    156
    +    -- See Note [Checking for rubbish literals] in GHC.Core.Lint
    
    157
    +    check_rubbish = case pass of
    
    158
    +                      CorePrep -> True
    
    159
    +                      _        -> False
    
    160
    +
    
    156 161
     initLintConfig :: DynFlags -> [Var] -> LintConfig
    
    157 162
     initLintConfig dflags vars =LintConfig
    
    158 163
       { l_diagOpts = initDiagOpts dflags
    
    ... ... @@ -168,4 +173,5 @@ defaultLintFlags dflags = LF { lf_check_global_ids = False
    168 173
                                  , lf_check_linearity = gopt Opt_DoLinearCoreLinting dflags
    
    169 174
                                  , lf_report_unsat_syns = True
    
    170 175
                                  , lf_check_fixed_rep = True
    
    176
    +                             , lf_check_rubbish_lits = True
    
    171 177
                                  }

  • compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
    ... ... @@ -10,12 +10,9 @@ import GHC.Driver.Config.Core.Lint
    10 10
     
    
    11 11
     import GHC.Core
    
    12 12
     import GHC.Core.Ppr
    
    13
    -
    
    14 13
     import GHC.Core.Lint
    
    15 14
     import GHC.Core.Lint.Interactive
    
    16 15
     
    
    17
    ---import GHC.Runtime.Context
    
    18
    -
    
    19 16
     import GHC.Data.Bag
    
    20 17
     
    
    21 18
     import GHC.Utils.Outputable as Outputable
    
    ... ... @@ -27,7 +24,7 @@ lintInteractiveExpr what hsc_env expr
    27 24
       | not (gopt Opt_DoCoreLinting dflags)
    
    28 25
       = return ()
    
    29 26
       | Just err <- lintExpr (initLintConfig dflags $ interactiveInScope $ hsc_IC hsc_env) expr
    
    30
    -  = displayLintResults logger False what (pprCoreExpr expr) (emptyBag, err)
    
    27
    +  = displayLintResults logger what (pprCoreExpr expr) (emptyBag, err)
    
    31 28
       | otherwise
    
    32 29
       = return ()
    
    33 30
       where
    

  • compiler/GHC/IfaceToCore.hs
    ... ... @@ -1413,7 +1413,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
    1413 1413
                               Nothing   -> return ()
    
    1414 1414
                               Just errs -> do
    
    1415 1415
                                 logger <- getLogger
    
    1416
    -                            liftIO $ displayLintResults logger False doc
    
    1416
    +                            liftIO $ displayLintResults logger doc
    
    1417 1417
                                                    (pprCoreExpr rhs')
    
    1418 1418
                                                    (emptyBag, errs) }
    
    1419 1419
                        ; return (bndrs', args', rhs') }
    
    ... ... @@ -2006,7 +2006,7 @@ tcUnfoldingRhs is_compulsory toplvl name expr
    2006 2006
             case lintUnfolding is_compulsory (initLintConfig dflags in_scope) noSrcLoc core_expr' of
    
    2007 2007
               Nothing   -> return ()
    
    2008 2008
               Just errs -> liftIO $
    
    2009
    -            displayLintResults logger False doc
    
    2009
    +            displayLintResults logger doc
    
    2010 2010
                                    (pprCoreExpr core_expr') (emptyBag, errs)
    
    2011 2011
         return core_expr'
    
    2012 2012
       where