GitLab

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

 +{-# 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

+g

testsuite/tests/simplCore/should_run/T15519.stdout

+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'])