Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e60023b by Facundo Domínguez at 2026-05-07T18:01:16-04:00 Generalize so_inline to specify which bindings should be preserved This commit generalizes the so_inline option of the simple optimizer so we can indicate with a predicate the specific bindings that should be kept. This feature is important for the LiquidHaskell plugin, which relies on the simple optimizer to make core programs easier to read, but needs to preserve bindings that are relevant for verification. See https://gitlab.haskell.org/ghc/ghc/-/issues/24386 for the full discussion. - - - - - 5 changed files: - + changelog.d/so_inline_is_a_predicate - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Driver/Config.hs - + testsuite/tests/ghc-api/T24386.hs - testsuite/tests/ghc-api/all.T Changes: ===================================== changelog.d/so_inline_is_a_predicate ===================================== @@ -0,0 +1,12 @@ +section: ghc-lib +synopsis: Generalize the ``so_inline`` option of the simple optimizer to a predicate + that selects the bindings to preserve. + +issues: #24386 +mrs: !15988 + +description: { + The ``so_inline`` option of the simple optimizer was a boolean and now it is a + predicate taking a binding ``Id`` and returning a boolean. ``const b`` has the + same effect as formerly setting ``b``. +} ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -108,6 +108,93 @@ unfolding-info to the scrutinee's Id.) * Bad bad bad: then the x in case x of ... may be replaced with a version that has an unfolding. See ticket #25790 + +Note [Controlling inlining in the simple optimiser] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes, plugins that analyse Core programs may want to prevent the +inlining of certain bindings. While they could avoid running the simple +optimiser at all, that would leave plenty of generated bindings that do not +have a direct correspondence to the source code. + +For example, consider the following Haskell code: + + foo = z + where + z = z1 + z2 + z1 = 42 + z2 = 1 + +Before the simple optimizer runs, the Core programs is roughly: + + foo = + let + foo_aIb = + let + z2 + = let + z2_aHG = 1 + in + z2_aHG + in + let + z1 = + let + z1_aHR = 42 + in + z1_aHR + in + let + z = + let + z_aI5 = z1 + z2 + in + z_aI5 + in + z + in + foo_aIb + +After the simple optimizer runs, the Core program is: + + foo = 42 + 1 + +And the bindings for `z`, `z1`, and `z2` are all gone. If a plugin wanted to +analyse those bindings, it would have to deal with the unsimplified Core, but +cope with the generated bindings `z2_aHG`, `z1_aHR`, `z_aI5`, and `foo_aIb`, +all of which have no direct correspondence to the source code. + +Fortunately, a plugin can still improve the output by using the `so_inline` +field of `SimpleOpts`. The `so_inline` field is a /function/ of type +`(Id -> Bool)` that tells the simple optimiser whether or not to inline the `Id`. +The client of the GHC can thereby control precisely which bindings are inlined +and which are not. For instance, + + simplOptPgm + (defaultSimpleOpts { so_inline = (`notElem` ["z", "z1", "z2"]) }) + ... + +produces the following Core program: + + foo = + let + z2 = 1 + in + let + z1 = 42 + in + let + z = z1 + z2 + in + z + +which contains the bindings of interest and little else. + +For the specifics of how this affects a concrete plugin (Liquid Haskell), see +the discussion in https://gitlab.haskell.org/ghc/ghc/-/issues/24386 + +In addition to supporting clients of the GHC API, there is another use of +`so_inline` mentioned in 'simpleOptExprNoInline'. + -} -- | Simple optimiser options @@ -115,8 +202,11 @@ data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options , so_eta_red :: !Bool -- ^ Eta reduction on? - , so_inline :: !Bool -- ^ False <=> do no inlining whatsoever, - -- even for trivial or used-once things + , so_inline :: !(Var -> Bool) -- ^ False <=> do no inline the given + -- binding whatsoever, even for trivial or + -- used-once things + -- + -- See Note [Controlling inlining in the simple optimiser] } -- | Default options for the Simple optimiser. @@ -125,7 +215,7 @@ defaultSimpleOpts = SimpleOpts { so_uf_opts = defaultUnfoldingOpts , so_co_opts = OptCoercionOpts { optCoercionEnabled = False } , so_eta_red = False - , so_inline = True + , so_inline = const True } simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr @@ -170,7 +260,7 @@ simpleOptExprNoInline :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr simpleOptExprNoInline opts expr = simple_opt_expr init_env expr where - init_opts = opts { so_inline = False } + init_opts = opts { so_inline = const False } init_env = (emptyEnv init_opts) { soe_subst = init_subst } init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr)) @@ -639,12 +729,12 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt pre_inline_unconditionally :: Bool pre_inline_unconditionally - | not (so_inline opts) = False -- Not if so_inline is False - | isExportedId in_bndr = False - | stable_unf = False - | not active = False -- Note [Inline prag in simplOpt] - | not (safe_to_inline occ) = False - | otherwise = True + | not (so_inline opts in_bndr) = False -- Not if so_inline is False + | isExportedId in_bndr = False + | stable_unf = False + | not active = False -- Note [Inline prag in simplOpt] + | not (safe_to_inline occ) = False + | otherwise = True -- Unconditionally safe to inline safe_to_inline :: OccInfo -> Bool @@ -711,15 +801,15 @@ simple_out_bind_pair env@(SOE { soe_subst = subst, soe_opts = opts }) post_inline_unconditionally :: Bool post_inline_unconditionally - | not (so_inline opts) = False -- Not if so_inline is False - | isExportedId in_bndr = False -- Note [Exported Ids and trivial RHSs] - | stable_unf = False -- Note [Stable unfoldings and postInlineUnconditionally] - | not active = False -- in GHC.Core.Opt.Simplify.Utils - | is_loop_breaker = False -- If it's a loop-breaker of any kind, don't inline - -- because it might be referred to "earlier" - | exprIsTrivial out_rhs = True - | coercible_hack = True - | otherwise = False + | not (so_inline opts in_bndr) = False -- Not if so_inline is False + | isExportedId in_bndr = False -- Note [Exported Ids and trivial RHSs] + | stable_unf = False -- Note [Stable unfoldings and postInlineUnconditionally] + | not active = False -- in GHC.Core.Opt.Simplify.Utils + | is_loop_breaker = False -- If it's a loop-breaker of any kind, don't inline + -- because it might be referred to "earlier" + | exprIsTrivial out_rhs = True + | coercible_hack = True + | otherwise = False is_loop_breaker = isWeakLoopBreaker occ_info ===================================== compiler/GHC/Driver/Config.hs ===================================== @@ -26,7 +26,7 @@ initSimpleOpts dflags = SimpleOpts { so_uf_opts = unfoldingOpts dflags , so_co_opts = initOptCoercionOpts dflags , so_eta_red = gopt Opt_DoEtaReduction dflags - , so_inline = True + , so_inline = const True } -- | Instruct the interpreter evaluation to break... ===================================== testsuite/tests/ghc-api/T24386.hs ===================================== @@ -0,0 +1,123 @@ + +-- This test checks that bindings are preserved when configuring the simple +-- optimizer to not inline bindings with names selected by a predicate. +-- +-- This feature is important for the LiquidHaskell plugin, which relies on the +-- simple optimizer to make core programs easier to read, but needs to preserve +-- bindings that are relevant for verification. +-- +-- See https://gitlab.haskell.org/ghc/ghc/-/issues/24386 for the full discussion. +-- + +import Control.Monad +import Data.List (find) +import Data.Time (getCurrentTime) +import GHC +import GHC.Core +import GHC.Core.SimpleOpt +import GHC.Data.StringBuffer +import GHC.Driver.Config +import GHC.Driver.DynFlags +import GHC.Driver.Env.Types +import GHC.Types.Name +import GHC.Unit.Module.ModGuts +import GHC.Unit.Types +import GHC.Utils.Error +import GHC.Utils.Outputable + +import System.Environment (getArgs) + + +main :: IO () +main = + testLocalBindingsDesugaring + +testLocalBindingsDesugaring :: IO () +testLocalBindingsDesugaring = do + let inputSource = unlines + [ "module LocalBindingsDesugaring where" + , "f :: ()" + , "f = z" + , " where" + , " z = ()" + ] + + isExpectedDesugaring p = case findExpr "f" p of + Just (Let (NonRec b _) _) + -> isIdNamed "z" b + _ -> False + + isIdNamed name v = occNameString (occName v) == name + + coreProgram <- + compileToCore + (not . isIdNamed "z") + "LocalBindingsDesugaring" + inputSource + unless (isExpectedDesugaring coreProgram) $ + fail $ unlines $ + "Unexpected desugaring: No local binding for `z` found in the Core program." + : map showPprQualified coreProgram + +-- | Find the Core expression bound to the given name. +findExpr :: String -> CoreProgram -> Maybe CoreExpr +findExpr _ [] = + Nothing +findExpr name (p:ps) = case p of + NonRec b e + | occNameString (occName b) == name + -> Just e + Rec binds + | Just (_, e) <- find (\(b, _e) -> occNameString (occName b) == name) binds + -> Just e + _ -> findExpr name ps + +showPprQualified :: Outputable a => a -> String +showPprQualified = showSDocQualified . ppr + +showSDocQualified :: SDoc -> String +showSDocQualified = renderWithContext ctx + where + ctx = defaultSDocContext { sdocStyle = cmdlineParserStyle } + + + +compileToCore :: (Id -> Bool) -> String -> String -> IO [CoreBind] +compileToCore keepBindings modName inputSource = do + [libdir] <- getArgs + now <- getCurrentTime + runGhc (Just libdir) $ do + df1 <- getSessionDynFlags + GHC.setSessionDynFlags $ df1 { GHC.backend = GHC.bytecodeBackend } + let target = Target { + targetId = TargetFile (modName ++ ".hs") Nothing + , targetUnitId = homeUnitId_ df1 + , targetAllowObjCode = False + , targetContents = Just (stringToStringBuffer inputSource, now) + } + setTargets [target] + void $ GHC.depanal [] False + + dsMod <- getModSummary + (mkModule mainUnit (mkModuleName modName)) + >>= parseModule + >>= typecheckModule NoTcMPlugins + >>= desugarModule + hsc_env <- getSession + return $ mg_binds $ simpleOptimize keepBindings hsc_env $ dm_core_module dsMod + +-- Run the simple optimizer +simpleOptimize :: (Id -> Bool) -> GHC.HscEnv -> ModGuts -> ModGuts +simpleOptimize keepBindings hsc_env guts@(ModGuts + { mg_module = mgmod + , mg_binds = binds + , mg_rules = rules + }) = + let dflags = hsc_dflags hsc_env + simpl_opts = (initSimpleOpts dflags) { so_inline = keepBindings } + (binds2, rules2, _occ_anald_binds) = + simpleOptPgm simpl_opts mgmod binds rules + in guts + { mg_binds = binds2 + , mg_rules = rules2 + } ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -81,3 +81,4 @@ test('T26910', [ extra_run_opts(f'"{config.libdir}"') test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) test('T25121_status', normal, compile_and_run, ['-package ghc']) +test('T24386', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e60023bfac04260fa6f22a9a9bfb077... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e60023bfac04260fa6f22a9a9bfb077... You're receiving this email because of your account on gitlab.haskell.org.