Mikolaj Konarski pushed to branch wip/T28016-inline-boring-work-free at Glasgow Haskell Compiler / GHC Commits: 8301a6d6 by Mikolaj Konarski at 2026-10-27T12:32:34+01:00 Add a test for the INLINE constant of #15519 Note [Honour INLINE on 0-ary bindings] cites #15519, whose example no test covered: the INLINE binding x = case g a0 b0 of I# r -> T r is inlined into f, and g a0 b0 must still be computed once, not at every call of f. The test counts the calls of g with trace, which depends on an argument of g, so that the trace is not floated out of g's worker. Assisted-by: Claude Opus 5.5 - - - - - 92b13ca7 by Mikolaj Konarski at 2026-10-27T12:32:44+01:00 Experiment: float out before each simplifier phase (#28016) Not for merging. Before each phase of the main simplifier, run one simplifier iteration in that phase with case-of-case off, and then a float-out to top level only. A constant that an unfolding first active in that phase exposes when it is inlined, such as an INLINE [1] constant, is then floated before case-of-case and the runRW# rule move the caller's continuation into it, as the gentle run does for the first float-out (Note [Case-of-case and full laziness]). Assisted-by: Claude Opus 5.5 - - - - - 5 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - + testsuite/tests/simplCore/should_run/T15519.hs - + testsuite/tests/simplCore/should_run/T15519.stderr - + testsuite/tests/simplCore/should_run/T15519.stdout - testsuite/tests/simplCore/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -29,6 +29,7 @@ import GHC.Core.Ppr ( pprCoreBindings, pprRules ) import GHC.Core.Utils ( dumpIdInfoOfProgram, diffBinds, stripTicksE ) import GHC.Core.Lint.Interactive ( interactiveInScope ) import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm ) +import GHC.Core.Opt.Simplify.Env ( SimplMode(..) ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.Monad import GHC.Core.Opt.Pipeline.Types @@ -172,6 +173,24 @@ getCoreToDo dflags hpt_rule_base extra_vars simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter (initGentleSimplMode dflags) hpt_rule_base + first_float_switches = FloatOutSwitches + { floatOutLambdas = Just 0 + , floatOutConstants = True + , floatOutOverSatApps = False + , floatToTopLevelOnly = False + , floatJoinsToTop = False -- Initially, don't float join points at all + } + + -- EXPERIMENT (#28016): before each phase, let full laziness float to top + -- level the constants that the unfoldings active from that phase expose, + -- before case-of-case moves a continuation into them, as the gentle run + -- does for the first float-out. See Note [Case-of-case and full laziness]. + pre_float phase = runWhen full_laziness $ CoreDoPasses + [ CoreDoSimplify $ initSimplifyOpts dflags extra_vars 1 + ((initSimplMode dflags phase "pre-float") { sm_case_case = False }) + hpt_rule_base + , CoreDoFloatOutwards first_float_switches { floatToTopLevelOnly = True } ] + dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper] else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] @@ -206,14 +225,7 @@ getCoreToDo dflags hpt_rule_base extra_vars -- so that overloaded functions have all their dictionary lambdas manifest runWhen do_specialise CoreDoSpecialising, - runWhen full_laziness - (CoreDoFloatOutwards $ FloatOutSwitches - { floatOutLambdas = Just 0 - , floatOutConstants = True - , floatOutOverSatApps = False - , floatToTopLevelOnly = False - , floatJoinsToTop = False -- Initially, don't float join points at all - }), + runWhen full_laziness (CoreDoFloatOutwards first_float_switches), -- I have no idea why, but not floating constants to -- top level is very bad in some cases. -- @@ -232,9 +244,11 @@ getCoreToDo dflags hpt_rule_base extra_vars -- Run the simplifier phases 2,1,0 to allow rewrite rules to fire runWhen do_simpl3 - (CoreDoPasses $ [ simpl_phase (Phase phase) "main" max_iter - | phase <- [phases, phases-1 .. 1] ] ++ - [ simpl_phase (Phase 0) "main" (max max_iter 3) ]), + (CoreDoPasses $ concat [ [ pre_float (Phase phase) + , simpl_phase (Phase phase) "main" max_iter ] + | phase <- [phases, phases-1 .. 1] ] ++ + [ pre_float (Phase 0) + , simpl_phase (Phase 0) "main" (max max_iter 3) ]), -- Phase 0: allow all Ids to be inlined now -- This gets foldr inlined before strictness analysis ===================================== testsuite/tests/simplCore/should_run/T15519.hs ===================================== @@ -0,0 +1,33 @@ +{-# LANGUAGE MagicHash #-} +-- The example of Note [Honour INLINE on 0-ary bindings] (#15519): x is +-- inlined, and g a0 b0 must still be computed once, not at every call of f. +module Main (main) where + +import GHC.Exts +import Debug.Trace (trace) + +data T = T Int# + +g :: Int -> Int -> Int +g a b = trace "g" a * b + 1 +{-# NOINLINE g #-} + +a0, b0 :: Int +a0 = 3 +b0 = 4 +{-# NOINLINE a0 #-} +{-# NOINLINE b0 #-} + +x :: T +x = case g a0 b0 of I# r -> T r +{-# INLINE x #-} + +h :: T -> Int -> Int +h (T r) y = I# r + y + +f :: Int -> Int +f y = h x y +{-# NOINLINE f #-} + +main :: IO () +main = print (sum (map f [1 .. 3])) ===================================== testsuite/tests/simplCore/should_run/T15519.stderr ===================================== @@ -0,0 +1 @@ +g ===================================== testsuite/tests/simplCore/should_run/T15519.stdout ===================================== @@ -0,0 +1 @@ +45 ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -125,3 +125,4 @@ test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv']) test('T27005', [], multimod_compile_and_run, ['T27005', '-O']) test('T27705', [extra_hc_opts('+RTS -M500M -RTS')], multimod_compile_and_run, ['T27705', '-O2 -fexpose-all-unfoldings']) +test('T15519', normal, compile_and_run, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06d164e6ca54cb3079ea72f942b0b3f... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06d164e6ca54cb3079ea72f942b0b3f... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help