GitLab

Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC

Commits:

b20d031d
by Simon Peyton Jones at 2026-05-02T16:55:57+01:00
```
Revert to simpler form of dictSelRule
```

3 changed files:

compiler/GHC/Core/Opt/Simplify/Iteration.hs
compiler/GHC/Core/Opt/Simplify/Utils.hs
compiler/GHC/Types/Id/Make.hs

Changes:

compiler/GHC/Core/Opt/Simplify/Iteration.hs

@@ -1631,7 +1631,6 @@ rebuild_go env expr cont
        ApplyToVal { sc_arg = arg, sc_env = arg_se, sc_cast = arg_mco
                   , sc_cont = cont, sc_hole_ty = fun_ty }
 -        -- See Note [Avoid redundant simplification]
          -> do { arg' <- simplArg env Nothing fun_ty arg_se arg arg_mco
                ; rebuild_go env (App expr arg') cont }
@@ -1825,7 +1824,10 @@ simplArg :: SimplEnvIS              -- ^ Used only for its InScopeSet
           -> MOutCoercion            -- Wrap this around the result
           -> SimplM OutExpr
  simplArg _ _ _ (Simplified {}) arg mco
 -  = return (mkCastMCo arg mco)
 +  = -- See Note [Avoiding simplifying repeatedly]
 +    case mco of
 +       MRefl  -> return arg       -- Vastly common case
 +       MCo co -> return (mkCast arg co)
  simplArg env mb_arg_info fun_ty (UnSimplified arg_se) arg mco
    = do { let arg_env' = arg_se `setInScopeFromE` env
               arg_ty   = funArgTy fun_ty
@@ -2047,94 +2049,6 @@ Simplifier without first calling SimpleOpt, so anything involving
  GHCi or TH and operator sections will fall over if we don't take
  care here.
 -Note [Avoiding simplifying repeatedly]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -One way in which we can get exponential behaviour is if we simplify a
 -big expression, and then re-simplify it -- and then this happens in a
 -deeply-nested way.  So we must be jolly careful about re-simplifying
 -an expression (#26989).
+-
 -Example:
 -  f BIG, where f has a RULE
 -Then
 - * We simplify BIG before trying the rule; but the rule does not fire
 -   (forcing this simplification is why we have the RULE in this example)
 - * We inline f = \x. g x, in `simpl_lam`
 - * So if `simpl_lam` did preInlineUnconditionally we get (g BIG)
 - * Now if g has a RULE we'll simplify BIG again, and this whole thing can
 -   iterate.
 - * However, if `f` did not have a RULE, so that BIG has /not/ already been
 -   simplified, we /want/ to do preInlineUnconditionally in simpl_lam.
+-
 -So we go to some effort to avoid repeatedly simplifying the same thing.
 -Suppose we are in the Plan (AFTER) case of rule application, for a rule
 -      RULE forall x,y.  f (x,y) = ...x...
 -and a call
 -      f (e1,e2)
 -Then:
+-
 -* The (sc_env :: StaticEnv) field of ApplyToVal records if the argument
 -  has been evaluated.  See Note [StaticEnv] in GHC.Core.Opt.Simplify.Utils.
+-
 -* The rule fires returning
 -     RuleMatch { rm_rhs = (\x y. ...x..), rm_args = [ e1, e2 ] }
 -  We assume that `rm_rhs` has been occ-anal'd by whoever generates
 -  the `RuleMatch`.  (We do this once and for all when the rule is born;
 -  see Note [OccInfo in unfoldings and rules].)
+-
 -* `fireRuleAFTER` uses `pushOutArgs` to push [ e1, e2 ] back onto the
 -  continuation with sc_env=Simplified NoDup.
+-
 -* Beta-reduction fires (in `simpl_lam`) for the \x.
+-
 -* Suppose `x occurs many times.  Then we want to behave like `let x=e1 in ..`,
 -  but we use `simplArg`, which in turn uses that `sc_env` flag to avoid
 -  re-simplifying `e1`.
+-
 -* Suppose `x` occurs just once or not at all; then the call to
 -  `preInlineUnconditionally` in `simpl_lam` will fire, and extend the
 -  substitution with
 -      x :-> DoneEx e1
+-
 -* At the /occurrence/ of `x`, the function `simplInId` calls `simplOutExpr`
 -  on `e1`.  Calling `simplOutExpr` is critical: it knowns that we have already
 -  simplified `e1` so we must be cautious about doing so again.
+-
 -  The conservative case for `simplOutExpr` is just to call `rebuild_go`, which
 -  avoids re-simplifying `e1`.  But if `e1` turns out to be a lambda, and there
 -  are some arguments, we have a new beta redex so we occurrence-analyse and
 -  zoom off to `simplLam`.
+-
 -* We go to some efforts to avoid unnecessarily simplifying ApplyToVal,
 -  in at least two places
 -    - In simplCast/addCoerce, where we check for isReflCo
 -    - We sometimes try rewrite RULES befoe simplifying arguments;
 -      see Note [tryRules: plan (BEFORE)]
+-
 -You might wonder (#13379) if the same thing can happen for a deeply-nested
 -application like
 -   f (f (f ....) ) )
+-
 -The danger is that we may
 -o  - Simplify the  (big) function argument
 -  - Decide to inline the function
 -  - Then preInilneUnconditionally the argument
 -  - And then re-simplified the big argument
+-
 -But in fact we try inlining /before/ simplifying arguments at all, so this can't
 -really arise.  The main way that we get /simplified/ argument on the stack is
 -through rule application. Once they are there then the above scenario can
 -happen. But then the mechanism above prevents gratuitous re-simplification.
+-
+-
 -Wrinkles:
+-
 -(SR1) All that said /postInlineUnconditionally/ (called in `completeBind`) does
 -    fire in the above (f BIG) situation.  See Note [Post-inline for single-use
 -    things] in Simplify.Utils.  This certainly risks repeated simplification,
 -    but in practice seems to be a small win.
+-
+-
  ************************************************************************
  *                                                                      *
                       Join points
@@ -2702,17 +2616,92 @@ makes a particularly big difference for
          +# 3# (+# 4# 5#)
    We want this to happen in one pass
 -Note [Avoid redundant simplification]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -Because RULES often apply to simplified arguments (see Note [Plan (AFTER)]),
 -there's a danger of simplifying already-simplified arguments.  For example,
 -suppose we have
 -   RULE f (x,y) = $sf x  y
 -and the expression
 -   f (p,q) e1 e2
 -With Plan (AFTER) by the time the rule fires, we will have already simplified e1, e2,
 -and we want to avoid doing so a second time.  So ApplyToVal records if the argument
 -is already Simplified.
++
 +Note [Avoiding simplifying repeatedly]
 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 +One way in which we can get exponential behaviour is if we simplify a
 +big expression, and then re-simplify it -- and then this happens in a
 +deeply-nested way.  So we must be jolly careful about re-simplifying
 +an expression (#26989).
++
 +Example:
 +  f BIG, where f has a RULE
 +Then
 + * We simplify BIG before trying the rule; but the rule does not fire
 +   (forcing this simplification is why we have the RULE in this example)
 + * We inline f = \x. g x, in `simpl_lam`
 + * So if `simpl_lam` did preInlineUnconditionally we get (g BIG)
 + * Now if g has a RULE we'll simplify BIG again, and this whole thing can
 +   iterate.
 + * However, if `f` did not have a RULE, so that BIG has /not/ already been
 +   simplified, we /want/ to do preInlineUnconditionally in simpl_lam.
++
 +So we go to some effort to avoid repeatedly simplifying the same thing.
 +Suppose we are in the Plan (AFTER) case of rule application, for a rule
 +      RULE forall x,y.  f (x,y) = ...x...
 +and a call
 +      f (e1,e2)
 +Then:
++
 +* The (sc_env :: StaticEnv) field of ApplyToVal records if the argument
 +  has been evaluated.  See Note [StaticEnv] in GHC.Core.Opt.Simplify.Utils.
++
 +* The rule fires returning
 +     RuleMatch { rm_rhs = (\x y. ...x..), rm_args = [ e1, e2 ] }
 +  We assume that `rm_rhs` has been occ-anal'd by whoever generates
 +  the `RuleMatch`.  (We do this once and for all when the rule is born;
 +  see Note [OccInfo in unfoldings and rules].)
++
 +* `fireRuleAFTER` uses `pushOutArgs` to push [ e1, e2 ] back onto the
 +  continuation with sc_env=Simplified NoDup.
++
 +* Beta-reduction fires (in `simpl_lam`) for the \x.
++
 +* Suppose `x occurs many times.  Then we want to behave like `let x=e1 in ..`,
 +  but we use `simplArg`, which in turn uses that `sc_env` flag to avoid
 +  re-simplifying `e1`.
++
 +* Suppose `x` occurs just once or not at all; then the call to
 +  `preInlineUnconditionally` in `simpl_lam` will fire, and extend the
 +  substitution with
 +      x :-> DoneEx e1
++
 +* At the /occurrence/ of `x`, the function `simplInId` calls `simplOutExpr`
 +  on `e1`.  Calling `simplOutExpr` is critical: it knowns that we have already
 +  simplified `e1` so we must be cautious about doing so again.
++
 +  The conservative case for `simplOutExpr` is just to call `rebuild_go`, which
 +  avoids re-simplifying `e1`.  But if `e1` turns out to be a lambda, and there
 +  are some arguments, we have a new beta redex so we occurrence-analyse and
 +  zoom off to `simplLam`.
++
 +* We go to some efforts to avoid unnecessarily simplifying ApplyToVal,
 +  in at least two places
 +    - In simplCast/addCoerce, where we check for isReflCo
 +    - We sometimes try rewrite RULES befoe simplifying arguments;
 +      see Note [tryRules: plan (BEFORE)]
++
 +You might wonder (#13379) if the same thing can happen for a deeply-nested
 +application like
 +   f (f (f ....) ) )
++
 +The danger is that we may
 +  - Simplify the  (big) function argument
 +  - Decide to inline the function
 +  - Then preInilneUnconditionally the argument
 +  - And then re-simplified the big argument
++
 +But in fact we try inlining /before/ simplifying arguments at all, so this can't
 +really arise.  The main way that we get /simplified/ argument on the stack is
 +through rule application. Once they are there then the above scenario can
 +happen. But then the mechanism above prevents gratuitous re-simplification.
++
 +Wrinkles:
++
 +(SR1) All that said /postInlineUnconditionally/ (called in `completeBind`) does
 +    fire in the above (f BIG) situation.  See Note [Post-inline for single-use
 +    things] in Simplify.Utils.  This certainly risks repeated simplification,
 +    but in practice seems to be a small win.
  Note [Shadowing in the Simplifier]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

compiler/GHC/Core/Opt/Simplify/Utils.hs

@@ -1624,7 +1624,9 @@ preInlineUnconditionally env top_lvl bndr rhs_se rhs rhs_mco
      extend_subst_with inl_rhs
        = extendIdSubst env bndr $!
          case rhs_se of
 -          Simplified _         -> DoneEx (mkCastMCo inl_rhs rhs_mco) NotJoinPoint
 +          Simplified _ -> case rhs_mco of
 +                             MRefl  -> DoneEx inl_rhs NotJoinPoint -- Common case
 +                             MCo co -> DoneEx (mkCast inl_rhs co) NotJoinPoint
            UnSimplified rhs_env -> ContEx rhs_env inl_rhs rhs_mco
      one_occ IAmDead = True -- Happens in ((\x.1) v)

compiler/GHC/Types/Id/Make.hs

@@ -564,6 +564,34 @@ dictSelRule :: Name -> Arity -> Int -> CoreRule
  --       sel_i t1..tk (D t1..tk op1 ... opm) = opi
  --
  -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance
++
 +dictSelRule name n_ty_args val_index
 +  = rule
 +  where
 +    rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
 +                                     occNameFS (getOccName name)
 +                       , ru_fn    = name
 +                       , ru_nargs = n_ty_args + 1
 +                       , ru_try   = try }
++
 +    try :: RuleFun
 +    try _opts in_scope_env _fn args
 +      | (dict_arg : _) <- drop n_ty_args args
 +      , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe in_scope_env dict_arg
 +      , let meth_e = getNth con_args val_index
 +      = Just (RM { rm_floats = floats
 +                 , rm_rhs    = meth_e
 +                 , rm_args   = []
 +                 , rm_rule   = rule })
 +      | otherwise
 +      = Nothing
++
 +{-  Here is another variant
 +This one rewrites
 +    op (m1,..,mn)  -->   (\x.x) mi
 +This way we can take advantage of the stuff described in
 +Note [Avoiding simplifying repeatedly] in GHC.Core.Opt.Simplify.Iteration
++
  dictSelRule name n_ty_args val_index
    = rule
    where
@@ -586,7 +614,6 @@ dictSelRule name n_ty_args val_index
        | otherwise
        = Nothing
+-
  mkIdLam :: Type -> CoreExpr
  -- Make an identity lambda (\(x::ty).x), already occ-analysed
  mkIdLam ty
@@ -597,6 +624,7 @@ mkIdLam ty
                                , occ_n_br    = 1
                                , occ_int_cxt = NotInteresting
                                , occ_tail    = NoTailCallInfo }
 +-}
  {-
  ************************************************************************