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

Commits:

5 changed files:

Changes:

  • changelog.d/so_inline_is_a_predicate
    1 
    +section: ghc-lib
    2 
    +synopsis: Generalize the ``so_inline`` option of the simple optimizer to a predicate
    3 
    +          that selects the bindings to preserve.
    4 
    +
    5 
    +issues: #24386
    6 
    +mrs: !15988
    7 
    +
    8 
    +description: {
    9 
    +  The ``so_inline`` option of the simple optimizer was a boolean and now it is a
    10 
    +  predicate taking a binding ``Id`` and returning a boolean. ``const b`` has the
    11 
    +  same effect as formerly setting ``b``.
    12 
    +}

  • compiler/GHC/Core/SimpleOpt.hs
    ... ... @@ -108,6 +108,93 @@ unfolding-info to the scrutinee's Id.)
    108 108 
     * Bad bad bad: then the x in  case x of ... may be replaced with a version that has an unfolding.
    109 109
    110 110 
     See ticket #25790
    111 
    +
    112 
    +Note [Controlling inlining in the simple optimiser]
    113 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    114 
    +Sometimes, plugins that analyse Core programs may want to prevent the
    115 
    +inlining of certain bindings. While they could avoid running the simple
    116 
    +optimiser at all, that would leave plenty of generated bindings that do not
    117 
    +have a direct correspondence to the source code.
    118 
    +
    119 
    +For example, consider the following Haskell code:
    120 
    +
    121 
    +    foo = z
    122 
    +      where
    123 
    +        z  = z1 + z2
    124 
    +        z1 = 42
    125 
    +        z2 = 1
    126 
    +
    127 
    +Before the simple optimizer runs, the Core programs is roughly:
    128 
    +
    129 
    +    foo =
    130 
    +      let
    131 
    +        foo_aIb =
    132 
    +          let
    133 
    +            z2
    134 
    +              = let
    135 
    +                  z2_aHG = 1
    136 
    +                 in
    137 
    +                  z2_aHG
    138 
    +           in
    139 
    +            let
    140 
    +              z1 =
    141 
    +                let
    142 
    +                  z1_aHR = 42
    143 
    +                 in
    144 
    +                  z1_aHR
    145 
    +             in
    146 
    +              let
    147 
    +                z =
    148 
    +                  let
    149 
    +                    z_aI5 = z1 + z2
    150 
    +                   in
    151 
    +                    z_aI5
    152 
    +               in
    153 
    +                z
    154 
    +      in
    155 
    +        foo_aIb
    156 
    +
    157 
    +After the simple optimizer runs, the Core program is:
    158 
    +
    159 
    +    foo = 42 + 1
    160 
    +
    161 
    +And the bindings for `z`, `z1`, and `z2` are all gone. If a plugin wanted to
    162 
    +analyse those bindings, it would have to deal with the unsimplified Core, but
    163 
    +cope with the generated bindings `z2_aHG`, `z1_aHR`, `z_aI5`, and `foo_aIb`,
    164 
    +all of which have no direct correspondence to the source code.
    165 
    +
    166 
    +Fortunately, a plugin can still improve the output by using the `so_inline`
    167 
    +field of `SimpleOpts`. The `so_inline` field is a /function/ of type
    168 
    +`(Id -> Bool)` that tells the simple optimiser whether or not to inline the `Id`.
    169 
    +The client of the GHC can thereby control precisely which bindings are inlined
    170 
    +and which are not. For instance,
    171 
    +
    172 
    +    simplOptPgm
    173 
    +      (defaultSimpleOpts { so_inline = (`notElem` ["z", "z1", "z2"]) })
    174 
    +      ...
    175 
    +
    176 
    +produces the following Core program:
    177 
    +
    178 
    +    foo =
    179 
    +      let
    180 
    +        z2 = 1
    181 
    +       in
    182 
    +        let
    183 
    +          z1 = 42
    184 
    +         in
    185 
    +          let
    186 
    +            z = z1 + z2
    187 
    +           in
    188 
    +            z
    189 
    +
    190 
    +which contains the bindings of interest and little else.
    191 
    +
    192 
    +For the specifics of how this affects a concrete plugin (Liquid Haskell), see
    193 
    +the discussion in https://gitlab.haskell.org/ghc/ghc/-/issues/24386
    194 
    +
    195 
    +In addition to supporting clients of the GHC API, there is another use of
    196 
    +`so_inline` mentioned in 'simpleOptExprNoInline'.
    197 
    +
    111 198 
     -}
    112 199
    113 200 
     -- | Simple optimiser options
    ... ... @@ -115,8 +202,11 @@ data SimpleOpts = SimpleOpts
    115 202 
        { so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options
    116 203 
        , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
    117 204 
        , so_eta_red :: !Bool            -- ^ Eta reduction on?
    118 
    -   , so_inline :: !Bool             -- ^ False <=> do no inlining whatsoever,
    119 
    -                                    --    even for trivial or used-once things
    205 
    +   , so_inline :: !(Var -> Bool)    -- ^ False <=> do no inline the given
    206 
    +                                    --   binding whatsoever, even for trivial or
    207 
    +                                    --   used-once things
    208 
    +                                    --
    209 
    +                                    --   See Note [Controlling inlining in the simple optimiser]
    120 210 
        }
    121 211
    122 212 
     -- | Default options for the Simple optimiser.
    ... ... @@ -125,7 +215,7 @@ defaultSimpleOpts = SimpleOpts
    125 215 
        { so_uf_opts = defaultUnfoldingOpts
    126 216 
        , so_co_opts = OptCoercionOpts { optCoercionEnabled = False }
    127 217 
        , so_eta_red = False
    128 
    -   , so_inline  = True
    218 
    +   , so_inline  = const True
    129 219 
        }
    130 220
    131 221 
     simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    ... ... @@ -170,7 +260,7 @@ simpleOptExprNoInline :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    170 260 
     simpleOptExprNoInline opts expr
    171 261 
       = simple_opt_expr init_env expr
    172 262 
       where
    173 
    -    init_opts  = opts { so_inline = False }
    263 
    +    init_opts  = opts { so_inline = const False }
    174 264 
         init_env   = (emptyEnv init_opts) { soe_subst = init_subst }
    175 265 
         init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
    176 266
    ... ... @@ -639,12 +729,12 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt
    639 729
    640 730 
         pre_inline_unconditionally :: Bool
    641 731 
         pre_inline_unconditionally
    642 
    -       | not (so_inline opts)     = False    -- Not if so_inline is False
    643 
    -       | isExportedId in_bndr     = False
    644 
    -       | stable_unf               = False
    645 
    -       | not active               = False    -- Note [Inline prag in simplOpt]
    646 
    -       | not (safe_to_inline occ) = False
    647 
    -       | otherwise                = True
    732 
    +       | not (so_inline opts in_bndr) = False    -- Not if so_inline is False
    733 
    +       | isExportedId in_bndr         = False
    734 
    +       | stable_unf                   = False
    735 
    +       | not active                   = False    -- Note [Inline prag in simplOpt]
    736 
    +       | not (safe_to_inline occ)     = False
    737 
    +       | otherwise                    = True
    648 738
    649 739 
             -- Unconditionally safe to inline
    650 740 
     safe_to_inline :: OccInfo -> Bool
    ... ... @@ -711,15 +801,15 @@ simple_out_bind_pair env@(SOE { soe_subst = subst, soe_opts = opts })
    711 801
    712 802 
         post_inline_unconditionally :: Bool
    713 803 
         post_inline_unconditionally
    714 
    -       | not (so_inline opts)  = False -- Not if so_inline is False
    715 
    -       | isExportedId in_bndr  = False -- Note [Exported Ids and trivial RHSs]
    716 
    -       | stable_unf            = False -- Note [Stable unfoldings and postInlineUnconditionally]
    717 
    -       | not active            = False --     in GHC.Core.Opt.Simplify.Utils
    718 
    -       | is_loop_breaker       = False -- If it's a loop-breaker of any kind, don't inline
    719 
    -                                       -- because it might be referred to "earlier"
    720 
    -       | exprIsTrivial out_rhs = True
    721 
    -       | coercible_hack        = True
    722 
    -       | otherwise             = False
    804 
    +       | not (so_inline opts in_bndr) = False -- Not if so_inline is False
    805 
    +       | isExportedId in_bndr         = False -- Note [Exported Ids and trivial RHSs]
    806 
    +       | stable_unf                   = False -- Note [Stable unfoldings and postInlineUnconditionally]
    807 
    +       | not active                   = False --     in GHC.Core.Opt.Simplify.Utils
    808 
    +       | is_loop_breaker              = False -- If it's a loop-breaker of any kind, don't inline
    809 
    +                                              -- because it might be referred to "earlier"
    810 
    +       | exprIsTrivial out_rhs        = True
    811 
    +       | coercible_hack               = True
    812 
    +       | otherwise                    = False
    723 813
    724 814 
         is_loop_breaker = isWeakLoopBreaker occ_info
    725 815

  • compiler/GHC/Driver/Config.hs
    ... ... @@ -26,7 +26,7 @@ initSimpleOpts dflags = SimpleOpts
    26 26 
        { so_uf_opts = unfoldingOpts dflags
    27 27 
        , so_co_opts = initOptCoercionOpts dflags
    28 28 
        , so_eta_red = gopt Opt_DoEtaReduction dflags
    29 
    -   , so_inline  = True
    29 
    +   , so_inline  = const True
    30 30 
        }
    31 31
    32 32 
     -- | Instruct the interpreter evaluation to break...

  • testsuite/tests/ghc-api/T24386.hs
    1 
    +
    2 
    +-- This test checks that bindings are preserved when configuring the simple
    3 
    +-- optimizer to not inline bindings with names selected by a predicate.
    4 
    +--
    5 
    +-- This feature is important for the LiquidHaskell plugin, which relies on the
    6 
    +-- simple optimizer to make core programs easier to read, but needs to preserve
    7 
    +-- bindings that are relevant for verification.
    8 
    +--
    9 
    +-- See https://gitlab.haskell.org/ghc/ghc/-/issues/24386 for the full discussion.
    10 
    +--
    11 
    +
    12 
    +import           Control.Monad
    13 
    +import           Data.List (find)
    14 
    +import           Data.Time (getCurrentTime)
    15 
    +import GHC
    16 
    +import GHC.Core
    17 
    +import GHC.Core.SimpleOpt
    18 
    +import GHC.Data.StringBuffer
    19 
    +import GHC.Driver.Config
    20 
    +import GHC.Driver.DynFlags
    21 
    +import GHC.Driver.Env.Types
    22 
    +import GHC.Types.Name
    23 
    +import GHC.Unit.Module.ModGuts
    24 
    +import GHC.Unit.Types
    25 
    +import GHC.Utils.Error
    26 
    +import GHC.Utils.Outputable
    27 
    +
    28 
    +import System.Environment (getArgs)
    29 
    +
    30 
    +
    31 
    +main :: IO ()
    32 
    +main =
    33 
    +  testLocalBindingsDesugaring
    34 
    +
    35 
    +testLocalBindingsDesugaring :: IO ()
    36 
    +testLocalBindingsDesugaring = do
    37 
    +    let inputSource = unlines
    38 
    +          [ "module LocalBindingsDesugaring where"
    39 
    +          , "f :: ()"
    40 
    +          , "f = z"
    41 
    +          , "  where"
    42 
    +          , "    z = ()"
    43 
    +          ]
    44 
    +
    45 
    +        isExpectedDesugaring p = case findExpr "f" p of
    46 
    +          Just (Let (NonRec b _) _)
    47 
    +            -> isIdNamed "z" b
    48 
    +          _ -> False
    49 
    +
    50 
    +        isIdNamed name v = occNameString (occName v) == name
    51 
    +
    52 
    +    coreProgram <-
    53 
    +       compileToCore
    54 
    +         (not . isIdNamed "z")
    55 
    +         "LocalBindingsDesugaring"
    56 
    +         inputSource
    57 
    +    unless (isExpectedDesugaring coreProgram) $
    58 
    +      fail $ unlines $
    59 
    +        "Unexpected desugaring: No local binding for `z` found in the Core program."
    60 
    +        : map showPprQualified coreProgram
    61 
    +
    62 
    +-- | Find the Core expression bound to the given name.
    63 
    +findExpr :: String -> CoreProgram -> Maybe CoreExpr
    64 
    +findExpr _ [] =
    65 
    +  Nothing
    66 
    +findExpr name (p:ps) = case p of
    67 
    +  NonRec b e
    68 
    +    | occNameString (occName b) == name
    69 
    +    -> Just e
    70 
    +  Rec binds
    71 
    +    | Just (_, e) <- find (\(b, _e) -> occNameString (occName b) == name) binds
    72 
    +    -> Just e
    73 
    +  _ -> findExpr name ps
    74 
    +
    75 
    +showPprQualified :: Outputable a => a -> String
    76 
    +showPprQualified = showSDocQualified . ppr
    77 
    +
    78 
    +showSDocQualified :: SDoc -> String
    79 
    +showSDocQualified = renderWithContext ctx
    80 
    +  where
    81 
    +    ctx = defaultSDocContext { sdocStyle = cmdlineParserStyle }
    82 
    +
    83 
    +
    84 
    +
    85 
    +compileToCore :: (Id -> Bool) -> String -> String -> IO [CoreBind]
    86 
    +compileToCore keepBindings modName inputSource = do
    87 
    +    [libdir] <- getArgs
    88 
    +    now <- getCurrentTime
    89 
    +    runGhc (Just libdir) $ do
    90 
    +      df1 <- getSessionDynFlags
    91 
    +      GHC.setSessionDynFlags $ df1 { GHC.backend = GHC.bytecodeBackend }
    92 
    +      let target = Target {
    93 
    +                   targetId           = TargetFile (modName ++ ".hs") Nothing
    94 
    +                 , targetUnitId       = homeUnitId_ df1
    95 
    +                 , targetAllowObjCode = False
    96 
    +                 , targetContents     = Just (stringToStringBuffer inputSource, now)
    97 
    +                 }
    98 
    +      setTargets [target]
    99 
    +      void $ GHC.depanal [] False
    100 
    +
    101 
    +      dsMod <- getModSummary
    102 
    +                 (mkModule mainUnit (mkModuleName modName))
    103 
    +             >>= parseModule
    104 
    +             >>= typecheckModule NoTcMPlugins
    105 
    +             >>= desugarModule
    106 
    +      hsc_env <- getSession
    107 
    +      return $ mg_binds $ simpleOptimize keepBindings hsc_env $ dm_core_module dsMod
    108 
    +
    109 
    +-- Run the simple optimizer
    110 
    +simpleOptimize :: (Id -> Bool) -> GHC.HscEnv -> ModGuts -> ModGuts
    111 
    +simpleOptimize keepBindings hsc_env guts@(ModGuts
    112 
    +                               { mg_module  = mgmod
    113 
    +                               , mg_binds   = binds
    114 
    +                               , mg_rules   = rules
    115 
    +                               }) =
    116 
    +    let dflags = hsc_dflags hsc_env
    117 
    +        simpl_opts = (initSimpleOpts dflags) { so_inline = keepBindings }
    118 
    +        (binds2, rules2, _occ_anald_binds) =
    119 
    +          simpleOptPgm simpl_opts mgmod binds rules
    120 
    +      in guts
    121 
    +          { mg_binds = binds2
    122 
    +          , mg_rules = rules2
    123 
    +          }

  • testsuite/tests/ghc-api/all.T
    ... ... @@ -81,3 +81,4 @@ test('T26910', [ extra_run_opts(f'"{config.libdir}"')
    81 81 
     test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc'])
    82 82
    83 83 
     test('T25121_status', normal, compile_and_run, ['-package ghc'])
    84 
    +test('T24386', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help