GitLab

sheaf pushed to branch wip/T26878 at Glasgow Haskell Compiler / GHC

Commits:

7a5b42ad

by sheaf at 2026-03-16T16:38:57+01:00

Simplify mkTick

This commit simplifies 'GHC.Core.Utils.mkTick', removing the
accumulating parameter 'rest' which was suspiciously treating a bunch of
different ticks as a group, and moving the group as a whole around the
AST, ignoring that the ticks in the group might have different placement
properties.

Also adds Note [Pushing SCCs inwards] which clarifies the logic for
pushing SCCs into lambdas, constructor applications, and dropping SCCs
around non-function variables (in particular the treatment of splittable
ticks).

A few other changes are also implemented:

  - simplify 'can_split' predicate (no functional change)
  - drop profiling ticks around coercions, fixing #26941
  - combine profiling ticks into one when possible

Fixes #26878 and #26941

Co-authored-by: simonpj <simon.peytonjones@gmail.com>

5 changed files:

compiler/GHC/Core/Utils.hs
compiler/GHC/Types/Tickish.hs
+ testsuite/tests/simplCore/should_compile/T26941.hs
+ testsuite/tests/simplCore/should_compile/T26941_aux.hs
testsuite/tests/simplCore/should_compile/all.T

Changes:

compiler/GHC/Core/Utils.hs

@@ -303,101 +303,194 @@ mkCast expr co
  *                                                                      *
  ********************************************************************* -}
 --- | Wraps the given expression in the source annotation, dropping the
 --- annotation if possible.
 +-- | Wraps the given expression in a Tick, floating the tick as far into
 +-- the AST as possible in order to try to satisfy the tick's desired placement
 +-- properties (as per Note [Tickish placement] in GHC.Types.Tickish).
 +--
 +-- Prefer using 'mkTick' over explicit use of the 'Tick' constructor.
 +--
 +-- Also performs small on-the-fly optimisations:
 +--
 +--   * Eliminate unnecessary ticks by either absorbing them into existing ones
 +--     or dropping them if that is valid (e.g. dropping profiling ticks around
 +--     types, coercions and literals).
 +--   * Split profiling ticks into counting/scoping parts so that the two parts
 +--     can be placed independently into the AST.
  mkTick :: CoreTickish -> CoreExpr -> CoreExpr
 -mkTick t orig_expr = mkTick' id orig_expr
 +mkTick t orig_expr = mkTick' orig_expr
   where
    -- Some ticks (cost-centres) can be split in two, with the
    -- non-counting part having laxer placement properties.
 -  canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
 +  -- See Note [Scoping ticks and counting ticks] in GHC.Types.Tickish.
 +  can_split = tickishCanSplit t
 -  -- mkTick' handles floating of ticks *into* the expression.
 -  mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with)
 -                                    -- Always a composition of (Tick t) wrappers
 -          -> CoreExpr               -- Current expression
 -          -> CoreExpr
 -          -- So in the call (mkTick' rest e), the expression
 -          --   (rest e)
 -          -- has the same type as e
 -          -- Returns an expression equivalent to (Tick t (rest e))
 -  mkTick' rest expr = case expr of
 -    -- Float ticks into unsafe coerce the same way we would do with a cast.
 -    Case scrut bndr ty alts@[Alt ac abs _rhs]
 -      | Just rhs <- isUnsafeEqualityCase scrut bndr alts
 -      -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)]
 +  stop_here e = Tick t e   -- Just wrap `t` around the current expression
 +                           -- That's the default option!
 -    -- Cost centre ticks should never be reordered relative to each
 -    -- other. Therefore we can stop whenever two collide.
 +  -- mkTick' handles floating of tick `t` *into* the expression.
 +  mkTick' :: CoreExpr -> CoreExpr
 +  mkTick' expr = case expr of
      Tick t2 e
 -      | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr
 -    -- Otherwise we assume that ticks of different placements float
 -    -- through each other.
 -      | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e
 +      -- Common up ticks when possible, including profiling ticks that
 +      -- share a cost centre and source notes that subsume one another.
 +      | Just t' <- combineTickish_maybe t t2
 +      -> mkTick t' e
 -    -- For annotations this is where we make sure to not introduce
 -    -- redundant ticks.
 -      | tickishContains t t2              -> mkTick' rest e  -- Drop t2
 -      | tickishContains t2 t              -> rest e          -- Drop t
 -      | otherwise                         -> mkTick' (rest . Tick t2) e
 +      -- Profiling ticks for different cost centres should never be reordered
 +      -- relative to each other. Therefore, we stop whenever two collide.
 +      | ProfNote {} <- t
 +      , ProfNote {} <- t2
 +      -> stop_here expr
 -    -- Ticks don't care about types, so we just float all ticks
 -    -- through them. Note that it's not enough to check for these
 -    -- cases top-level. While mkTick will never produce Core with type
 -    -- expressions below ticks, such constructs can be the result of
 -    -- unfoldings. We therefore make an effort to put everything into
 -    -- the right place no matter what we start with.
 -    Cast e co   -> mkCast (mkTick' rest e) co
 -    Coercion co -> Tick t $ rest (Coercion co)
 +      -- Ticks of different placements float through each other, so that each
 +      -- tick can be floated into its expected position in the AST.
 +      -- See Note [Tickish placement] in GHC.Types.Tickish.
 +      | tickishPlace t2 /= tickishPlace t
 +      -> Tick t2 $ mkTick' e
++
 +      | otherwise
 +      -> stop_here expr   -- Always safe
      Lam x e
        -- Always float through type lambdas. Even for non-type lambdas,
        -- floating is allowed for all but the most strict placement rule.
        | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime
 -      -> Lam x $ mkTick' rest e
 +      -> Lam x $ mkTick' e
 -      -- If it is both counting and scoped, we split the tick into its
 -      -- two components, often allowing us to keep the counting tick on
 -      -- the outside of the lambda and push the scoped tick inside.
 -      -- The point of this is that the counting tick can probably be
 -      -- floated, and the lambda may then be in a position to be
 -      -- beta-reduced.
 -      | canSplit
 -      -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
 +      -- Push SCCs into lambdas.
 +      -- See PSCC2 in Note [Pushing SCCs inwards].
 +      | can_split
 +      -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
      App f arg
 -      -- Always float through type applications.
 +      -- All ticks float inwards through non-runtime arguments, as per
 +      -- Note [Tickish placement] in GHC.Types.Tickish.
        | not (isRuntimeArg arg)
 -      -> App (mkTick' rest f) arg
 +      -> App (mkTick' f) arg
 -      -- We can also float through constructor applications, placement
 -      -- permitting. Again we can split.
 -      | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)
 +      -- Push SCCs into saturated constructor applications.
 +      -- See PSCC3 in Note [Pushing SCCs inwards].
 +      | isSaturatedConApp expr
 +      , tickishPlace t == PlaceCostCentre || can_split
        -> if tickishPlace t == PlaceCostCentre
 -         then rest $ tickHNFArgs t expr
 -         else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
 +         then tickHNFArgs t expr
 +         else Tick (mkNoScope t) $ tickHNFArgs (mkNoCount t) expr
++
 +    -- Ticks don't care about types, so we just float all ticks
 +    -- through them. Note that it's not enough to check for these
 +    -- cases at the top-level. While mkTick will never produce Core with type
 +    -- expressions below ticks, such constructs can be the result of
 +    -- unfoldings. We therefore make an effort to put everything into
 +    -- the right place no matter what we start with.
 +    Cast e co   -> mkCast (mkTick' e) co
++
 +    -- Float ticks into 'unsafeCoerce' the same way we would do with a cast.
 +    Case scrut bndr ty alts@[Alt ac abs _rhs]
 +      | Just rhs <- isUnsafeEqualityCase scrut bndr alts
 +      -> Case scrut bndr ty [Alt ac abs (mkTick' rhs)]
      Var x
 -      | notFunction && tickishPlace t == PlaceCostCentre
 -      -> rest expr  -- Drop t
 -      | notFunction && canSplit
 -      -> Tick (mkNoScope t) $ rest expr
 +      -- Drop SCCs around non-function variables.
 +      -- See PSCC1 in Note [Pushing SCCs inwards].
 +      | notFunction
 +        -- Does the tick `t` contain an SCC we can drop?
 +      , tickishPlace t == PlaceCostCentre || can_split
 +      -> if tickishPlace t == PlaceCostCentre
 +         then expr -- Drop pure SCC ticks:  scc<foo> (x :: Int) ==> x
 +         else
 +            -- Drop the scoping part of the tick, but keep the counting part.
 +            Tick (mkNoScope t) expr
        where
 -        -- SCCs can be eliminated on variables provided the variable
 -        -- is not a function.  In these cases the SCC makes no difference:
 -        -- the cost of evaluating the variable will be attributed to its
 -        -- definition site.  When the variable refers to a function, however,
 -        -- an SCC annotation on the variable affects the cost-centre stack
 -        -- when the function is called, so we must retain those.
          notFunction = not (isFunTy (idType x))
 -    Lit{}
 -      | tickishPlace t == PlaceCostCentre
 -      -> rest expr   -- Drop t
 +    -- It doesn't make sense to wrap static data (such as coercions, types and literals)
 +    -- in a tick which compiles to code, as the code will never be run.
 +    --
 +    -- It is in fact actively harmful, because Core Lint will fail on a
 +    -- coercion binding such as let co = <scc> (...), see #26941.
 +    -- It makes more sense to discard the cost centre tick rather than weakening
 +    -- Core Lint.
 +    e@(Coercion {}) | tickishIsCode t -> e
 +    e@(Type {})     | tickishIsCode t -> e
 +    e@(Lit {})      | tickishIsCode t -> e
++
 +    -- Catch-all: annotate where we stand.
 +    -- In particular (but not only): Let, most Cases.
 +    _any -> Tick t expr
++
 +{- Note [Pushing SCCs inwards]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +Amongst all ticks, SCCs have the laxest placement properties (PlaceCostCentre,
 +as described in Note [Tickish placement] GHC.Types.Tickish):
++
 +  PSCC1: SCCs around non-function variables can be eliminated.
 +    The cost of evaluating the variable will be attributed to its definition
 +    site, so the SCC makes no difference. Example:
++
 +      scc<foo> (x :: Int)  ==>  x
 -    -- Catch-all: Annotate where we stand
 -    _any -> Tick t $ rest expr
 +    NB: this is only valid when the variable is not a function. For example, in:
++
 +      scc<foo> (f :: Int -> Int)
++
 +    we must retain the cost centre annotation, as it affects the cost-centre
 +    pointer when the function is called. Discarding the SCC in this case would
 +    defeat the profiling mechanism entirely!
++
 +  PSCC2: SCCs can be pushed into lambdas.
++
 +       scc<foo> (\x -> e)  ==>  \x -> scc<foo> e
++
 +  PSCC3: We can push SCCs into (saturated) constructor applications.
 +    For example, for an arity 2 data constructor 'D':
++
 +       scc<foo> (D e1 e2)  ==>  D (scc<foo> e1) (scc<foo> e2)
++
 +Now, two kinds of ticks contain SCCs:
++
 +  - bare SCCs (i.e. ProfNote with profNoteCounts = False, profNoteScopes = True)
 +  - profiling ticks that both count and scope
++
 +The above explanation deals with bare SCCs. When handling profiling ticks that
 +both count and scope, we can split tick into two, so that the scoping part can
 +be pushed inwards (or even discarded). Specifically, we perform the following
 +transformations:
++
 +  PSCC1: Drop the SCC around non-function variables, keeping only the counting
 +    part:
++
 +       scctick<foo> (x :: Int)  ==>  tick<foo> x
++
 +  PSCC2: Push the SCC inside lambdas:
++
 +       scctick<foo> (\x. e)  ==>  tick<foo> (\x. scc<foo> e)
++
 +    NB: we must keep the counting part outside the lambda, in order to preserve
 +    tick counter tallies – it would not be sound to push the counting part inside.
++
 +  PSCC3: Push the SCC inside saturated contructor applications.
++
 +       scctick<foo> (D e1 e2)  ==>  tick<foo> (D (scc<foo> e1) (scc<foo> e2))
++
 +The benefit of these transformation is that the counting part, tick<foo>, can
 +likely be floated out of the way, which may expose additional optimisation
 +opportunities. For example:
++
 +  (scctick<foo> (\x. e)) arg
++
 +    ==>{PSCC2}
++
 +  (tick<foo> (\x. scc<foo> e)) arg
++
 +    ==>{GHC.Core.Opt.FloatOut.floatExpr, because 'tick<foo>' has no scope}
++
 +  tick<foo> ((\x. scc<foo> e) arg)
++
 +    ==>{beta reduction}
++
 +  tick<foo> (let x = arg in scc<foo> e)
 +-}
  mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
  mkTicks ticks expr = foldr mkTick expr ticks

compiler/GHC/Types/Tickish.hs

@@ -17,6 +17,7 @@ module GHC.Types.Tickish (
    TickishPlacement(..),
    tickishPlace,
    tickishContains,
 +  combineTickish_maybe,
    -- * Breakpoint tick identifiers
    BreakpointId(..), BreakTickIndex
@@ -261,8 +262,12 @@ Ticks have two independent attributes:
       See Note [Scoped ticks]
 +Note that profiling notes which both count and scope can be split into two
 +separate ticks, one that counts and doesn't scope and one that scopes and doesn't
 +count; see 'tickishCanSplit', 'mkNoCount' and 'mkNoScope'.
++
  Note [Counting ticks]
 -~~~~~~~~~~~~~~~~~~~~
 +~~~~~~~~~~~~~~~~~~~~~
  The following ticks count:
    - ProfNote ticks with profNoteCounts = True
    - HPC ticks
@@ -290,7 +295,7 @@ sharing, so in practice the actual number of ticks may vary, except
  that we never change the value from zero to non-zero or vice-versa.
  Note [Scoped ticks]
 -~~~~~~~~~~~~~~~~~~~~
 +~~~~~~~~~~~~~~~~~~~
  The following ticks are scoped:
    - ProfNote ticks with profNoteScope = True
    - Breakpoints
@@ -375,6 +380,44 @@ Whether we are allowed to float in additional cost depends on the tick:
      While these transformations are legal, we want to make a best effort to
      only make use of them where it exposes transformation opportunities.
++
 +Note [Tickish placement]
 +~~~~~~~~~~~~~~~~~~~~~~~~
 +The placement behaviour of ticks (i.e. which terms we want the tick to be placed
 +around in the AST) is governed by 'TickishPlacement'. We generally try to push
 +ticks inwards until they end up placed around the kind of term expected by their
 +placement rules.
++
 +From most restrictive to least restrictive placement rules:
++
 +  - PlaceRuntime: counting ticks.
++
 +    Ticks with 'PlaceRuntime' placement want to be placed on run-time expressions.
 +    They can be moved through pure compile-time constructs such as other ticks,
 +    casts or type lambdas.
++
 +    This is the most restrictive placement rule for ticks, as all tickishs have
 +    in common that they want to track runtime processes.
++
 +    Any tick that counts (see Note [Counting ticks]) has 'PlaceRuntime' placement.
++
 +  - PlaceNonLam: source notes.
++
 +    Like PlaceRuntime, but we can also float the tick through value lambdas.
 +    This makes sense where there is little difference between annotating the
 +    lambda and annotating the lambda's code.
++
 +  - PlaceCostCentre: non-counting profiling ticks.
++
 +    In addition to floating through lambdas, cost-centre style tickishs can also
 +    be moved from constructors and non-function variables. For example:
++
 +       let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
++
 +    Neither the constructor application, the variable or the literal are likely
 +    to have any cost worth mentioning. And even if 'y' names a thunk, the call
 +    would not care about the evaluation context. Therefore, removing all
 +    annotations in the above example is safe.
  -}
  -- | Returns @True@ for ticks that can be floated upwards easily even
@@ -441,35 +484,19 @@ isProfTick _          = False
  -- annotating for example using @mkTick@. If we find that we want to
  -- put a tickish on an expression ruled out here, we try to float it
  -- inwards until we find a suitable expression.
 +--
 +-- See Note [Tickish placement].
  data TickishPlacement =
 -    -- | Place ticks exactly on run-time expressions. We can still
 -    -- move the tick through pure compile-time constructs such as
 -    -- other ticks, casts or type lambdas. This is the most
 -    -- restrictive placement rule for ticks, as all tickishs have in
 -    -- common that they want to track runtime processes. The only
 -    -- legal placement rule for counting ticks.
 -    -- NB: We generally try to move these as close to the relevant
 -    -- runtime expression as possible. This means they get pushed through
 -    -- tyoe arguments. E.g. we create `(tick f) @Bool` instead of `tick (f @Bool)`.
 +    -- | Place ticks exactly on run-time expressions, moving them through pure
 +    -- compile-time constructs such as other ticks, casts or type lambdas.
      PlaceRuntime
 -    -- | As @PlaceRuntime@, but we float the tick through all
 -    -- lambdas. This makes sense where there is little difference
 -    -- between annotating the lambda and annotating the lambda's code.
 +    -- | As @PlaceRuntime@, but also allow to float the tick through all lambdas.
    | PlaceNonLam
 -    -- | In addition to floating through lambdas, cost-centre style
 -    -- tickishs can also be moved from constructors, non-function
 -    -- variables and literals. For example:
 -    --
 -    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
 -    --
 -    -- Neither the constructor application, the variable or the
 -    -- literal are likely to have any cost worth mentioning. And even
 -    -- if y names a thunk, the call would not care about the
 -    -- evaluation context. Therefore removing all annotations in the
 -    -- above example is safe.
 +    -- | As 'PlaceNonLam', but also float through constructors, non-function
 +    -- variables and literals.
    | PlaceCostCentre
    deriving (Eq,Show)
@@ -477,7 +504,9 @@ data TickishPlacement =
  instance Outputable TickishPlacement where
    ppr = text . show
 --- | Placement behaviour we want for the ticks
 +-- | Placement behaviour we want for the ticks.
 +--
 +-- See Note [Tickish placement].
  tickishPlace :: GenTickish pass -> TickishPlacement
  tickishPlace n@ProfNote{}
    | profNoteCount n        = PlaceRuntime
@@ -486,6 +515,43 @@ tickishPlace HpcTick{}     = PlaceRuntime
  tickishPlace Breakpoint{}  = PlaceRuntime
  tickishPlace SourceNote{}  = PlaceNonLam
 +-- | Merge two ticks into one, if that is possible.
 +--
 +-- Examples:
 +--
 +--  - combine two source note ticks if one contains the other,
 +--  - combine a non-counting profiling tick with a non-scoping profiling tick
 +--    for the same cost centre
 +--  - combine two equal breakpoint ticks or HPC ticks
 +combineTickish_maybe :: Eq (GenTickish pass)
 +                   => GenTickish pass -> GenTickish pass -> Maybe (GenTickish pass)
 +combineTickish_maybe
 +  (ProfNote { profNoteCC = cc1, profNoteCount = cnt1, profNoteScope = scope1 })
 +  (ProfNote { profNoteCC = cc2, profNoteCount = cnt2, profNoteScope = scope2 })
 +    | cc1 == cc2
 +    , not cnt1 || not cnt2
 +    = Just $ ProfNote { profNoteCC    = cc1
 +                      , profNoteCount = cnt1 || cnt2
 +                      , profNoteScope = scope1 || scope2
 +                      }
 +combineTickish_maybe t1@(SourceNote sp1 n1) t2@(SourceNote sp2 n2)
 +  | n1 == n2
 +  , sp1 `containsSpan` sp2
 +  = Just t1
 +  | n1 == n2
 +  , sp2 `containsSpan` sp1
 +  = Just t2
 +  -- NB: it would be possible to use 'combineRealSrcSpans' instead,
 +  -- but that has the risk of combining many source note ticks into a single
 +  -- tick with a huge source span.
 +combineTickish_maybe t1@(HpcTick {}) t2@(HpcTick {})
 +  | t1 == t2
 +  = Just t1
 +combineTickish_maybe t1@(Breakpoint {}) t2@(Breakpoint {})
 +  | t1 == t2
 +  = Just t1
 +combineTickish_maybe _ _ = Nothing
++
  -- | Returns whether one tick "contains" the other one, therefore
  -- making the second tick redundant.
  tickishContains :: Eq (GenTickish pass)

testsuite/tests/simplCore/should_compile/T26941.hs

 +{-# LANGUAGE DataKinds #-}
 +{-# LANGUAGE GADTs #-}
 +{-# LANGUAGE TypeOperators #-}
++
 +module T26941 where
++
 +import GHC.TypeLits
++
 +import T26941_aux ( SMayNat(SKnown), ListH, shxHead )
++
 +shsHead :: ListH (Just n : sh) Int -> SNat n
 +shsHead shx =
 +  case shxHead shx of
 +    SKnown SNat -> SNat

testsuite/tests/simplCore/should_compile/T26941_aux.hs

 +{-# LANGUAGE DataKinds #-}
 +{-# LANGUAGE GADTs #-}
 +{-# LANGUAGE StandaloneKindSignatures #-}
 +{-# LANGUAGE TypeOperators #-}
++
 +module T26941_aux where
++
 +import Data.Kind
 +import GHC.TypeLits
++
 +shxHead :: ListH (n : sh) i -> SMayNat i n
 +shxHead list = {-# SCC "bad_scc" #-}
 +  ( case list of (i `ConsKnown` _) -> SKnown i )
++
 +type ListH :: [Maybe Nat] -> Type -> Type
 +data ListH sh i where
 +  ConsKnown :: SNat n -> ListH sh i -> ListH (Just n : sh) i
++
 +data SMayNat i n where
 +  SKnown :: SNat n -> SMayNat i (Just n)

testsuite/tests/simplCore/should_compile/all.T

@@ -568,6 +568,8 @@ test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniqu
  test('T26349',  normal, compile, ['-O -ddump-rules'])
  test('T26681',  normal, compile, ['-O'])
 +test('T26941', [extra_files(['T26941_aux.hs']), req_profiling], multimod_compile, ['T26941', '-v0 -O -prof'])
++
  # T26709: we expect three `case` expressions not four
  test('T26709', [grep_errmsg(r'case')],
         multimod_compile,