[Git][ghc/ghc][wip/simplifier-tweaks] Move mergeCaseAlts to prepareAlts
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Mar 26 14:18:28 UTC 2024
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
7ac340e0 by Simon Peyton Jones at 2024-03-26T14:17:37+00:00
Move mergeCaseAlts to prepareAlts
This makes it happen on InAlts, which reduces the number of Simplifier
iterations by one.
See Note [Merging nested cases] in GHC.Core.Opt.Simplify.Utils
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Utils.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -3342,7 +3342,7 @@ simplAlts env0 scrut case_bndr alts cont'
; (alt_env', scrut', case_bndr') <- improveSeq fam_envs env2 scrut
case_bndr case_bndr2 alts
- ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut' case_bndr alts
+ ; (imposs_deflt_cons, in_alts) <- prepareAlts (seMode env0) scrut' case_bndr alts
-- NB: it's possible that the returned in_alts is empty: this is handled
-- by the caller (rebuildCase) in the missingAlt function
-- NB: pass case_bndr::InId, not case_bndr' :: OutId, to prepareAlts
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -74,7 +74,6 @@ import GHC.Types.Demand
import GHC.Types.Var.Set
import GHC.Types.Basic
-import GHC.Data.Maybe ( orElse )
import GHC.Data.OrdList ( isNilOL )
import GHC.Data.FastString ( fsLit )
@@ -2403,24 +2402,28 @@ OutId. Test simplCore/should_compile/simpl013 apparently shows this
up, although I'm not sure exactly how..
-}
-prepareAlts :: OutExpr -> InId -> [InAlt] -> SimplM ([AltCon], [InAlt])
+prepareAlts :: SimplMode -> OutExpr -> InId -> [InAlt] -> SimplM ([AltCon], [InAlt])
-- The returned alternatives can be empty, none are possible
--
-- Note that case_bndr is an InId; see Note [Shadowing in prepareAlts]
-prepareAlts scrut case_bndr alts
+prepareAlts mode scrut case_bndr alts
| Just (tc, tys) <- splitTyConApp_maybe (idType case_bndr)
= do { us <- getUniquesM
- ; let (idcs1, alts1) = filterAlts tc tys imposs_cons alts
- (yes2, alts2) = refineDefaultAlt us (idMult case_bndr) tc tys idcs1 alts1
+ ; let (yes1, alts1) | sm_case_merge mode = mergeCaseAlts case_bndr alts
+ | otherwise = (False, alts)
+ -- See Note [Merging nested cases]
+ (idcs2, alts2) = filterAlts tc tys imposs_cons alts1
+ (yes3, alts3) = refineDefaultAlt us (idMult case_bndr) tc tys idcs2 alts2
-- The multiplicity on case_bndr's is the multiplicity of the
-- case expression The newly introduced patterns in
-- refineDefaultAlt must be scaled by this multiplicity
- (yes3, idcs3, alts3) = combineIdenticalAlts idcs1 alts2
+ (yes4, idcs4, alts4) = combineIdenticalAlts idcs2 alts3
-- "idcs" stands for "impossible default data constructors"
-- i.e. the constructors that can't match the default case
- ; when yes2 $ tick (FillInCaseDefault case_bndr)
- ; when yes3 $ tick (AltMerge case_bndr)
- ; return (idcs3, alts3) }
+ ; when yes1 $ tick (CaseMerge case_bndr)
+ ; when yes3 $ tick (FillInCaseDefault case_bndr)
+ ; when yes4 $ tick (AltMerge case_bndr)
+ ; return (idcs4, alts4) }
| otherwise -- Not a data type, so nothing interesting happens
= return ([], alts)
@@ -2429,6 +2432,24 @@ prepareAlts scrut case_bndr alts
Var v -> otherCons (idUnfolding v)
_ -> []
+{- Note [Merging nested cases]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The basic case-merge stuff is described in Note [Merge Nested Cases] in GHC.Core.Utils
+
+We do it here in `prepareAlts` (on InAlts) rather than after (on OutAlts) for two reasons:
+
+* It "belongs" here with `filterAlts`, `refineDefaultAlt` and `combineIdenticalAlts`.
+
+* In test perf/compiler/T22428 I found that I was getting extra Simplifer iterations:
+ 1. Create a join point
+ 2. That join point gets inlined at all call sites, so it is now dead.
+ 3. Case-merge happened, but left behind some trivial bindings (see `mergeCaseAlts`)
+ 4. Get rid of the trivial bindings
+ The first two seem reasonable. It's imaginable that we could do better on
+ (3), by making case-merge join-point-aware, but it's not trivial. But the
+ fourth is just stupid. Rather than always do an extra iteration, it's better
+ to do the transformation on the input-end of teh Simplifier.
+-}
{-
************************************************************************
@@ -2439,74 +2460,9 @@ prepareAlts scrut case_bndr alts
mkCase tries these things
-* Note [Merge Nested Cases]
* Note [Eliminate Identity Case]
* Note [Scrutinee Constant Folding]
-Note [Merge Nested Cases]
-~~~~~~~~~~~~~~~~~~~~~~~~~
- case e of b { ==> case e of b {
- p1 -> rhs1 p1 -> rhs1
- ... ...
- pm -> rhsm pm -> rhsm
- _ -> case b of b' { pn -> let b'=b in rhsn
- pn -> rhsn ...
- ... po -> let b'=b in rhso
- po -> rhso _ -> let b'=b in rhsd
- _ -> rhsd
- }
-
-which merges two cases in one case when -- the default alternative of
-the outer case scrutinises the same variable as the outer case. This
-transformation is called Case Merging. It avoids that the same
-variable is scrutinised multiple times.
-
-Wrinkles
-
-(MC1) `tryMergeCase` "looks though" an inner single-alternative case-on-variable.
- For example
- case x of {
- ...outer-alts...
- DEFAULT -> case y of (a,b) ->
- case x of { A -> rhs1; B -> rhs2 }
- ===>
- case x of
- ...outer-alts...
- a -> case y of (a,b) -> rhs1
- B -> case y of (a,b) -> rhs2
-
- This duplicates the `case y` but it removes the case x; so it is a win
- in terms of execution time (combining the cases on x) at the cost of
- perhaps duplicating the `case y`. A case in point is integerEq, which
- is defined thus
- integerEq :: Integer -> Integer -> Bool
- integerEq !x !y = isTrue# (integerEq# x y)
- which becomes
- integerEq
- = \ (x :: Integer) (y_aAL :: Integer) ->
- case x of x1 { __DEFAULT ->
- case y of y1 { __DEFAULT ->
- case x1 of {
- IS x2 -> case y1 of {
- __DEFAULT -> GHC.Types.False;
- IS y2 -> tagToEnum# @Bool (==# x2 y2) };
- IP x2 -> ...
- IN x2 -> ...
- We want to merge the outer `case x` with the inner `case x1`.
-
- This story is not fully robust; it will be defeated by a let-binding,
- whih we don't want to duplicate. But accounting for single-alternative
- case-on-variable is easy to do, and seems useful in common cases so
- `tryMergeCase` does it.
-
-(MC2) The auxiliary bindings b'=b are annoying, because they force another
- simplifier pass, but there seems no easy way to avoid them. See
- Note [Which transformations are innocuous] in GHC.Core.Opt.Stats.
-
-See also
-* Note [Example of case-merging and caseRules]
-* Note [Cascading case merge]
-
Note [Eliminate Identity Case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
case e of ===> e
@@ -2675,7 +2631,7 @@ and now we can do case-merge again, getting the desired
-}
-mkCase, mkCase1, mkCase2, mkCase3
+mkCase, mkCase2, mkCase3
:: SimplMode
-> OutExpr -> OutId
-> OutType -> [OutAlt] -- Alternatives in standard (increasing) order
@@ -2688,76 +2644,12 @@ mkCase, mkCase1, mkCase2, mkCase3
-- Note [Cascading case merge]
--------------------------------------------------
-mkCase mode scrut outer_bndr alts_ty alts
- | sm_case_merge mode
- , Just alts' <- tryMergeCase outer_bndr alts
- = do { tick (CaseMerge outer_bndr)
- ; mkCase1 mode scrut outer_bndr alts_ty alts' }
- -- Warning: don't call mkCase recursively!
- -- Firstly, there's no point, because inner alts have already had
- -- mkCase applied to them, so they won't have a case in their default
- -- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
- -- in munge_rhs may put a case into the DEFAULT branch!
- | otherwise
- = mkCase1 mode scrut outer_bndr alts_ty alts
-
-tryMergeCase :: OutId -> [OutAlt] -> Maybe [OutAlt]
--- See Note [Merge Nested Cases]
-tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
- = case go 5 (\e -> e) emptyVarSet deflt_rhs of
- Nothing -> Nothing
- Just inner_alts -> Just (mergeAlts outer_alts inner_alts)
- -- NB: mergeAlts gives priority to the left
- -- case x of
- -- A -> e1
- -- DEFAULT -> case x of
- -- A -> e2
- -- B -> e3
- -- When we merge, we must ensure that e1 takes
- -- precedence over e2 as the value for A!
- where
- go :: Int -> (OutExpr -> OutExpr) -> VarSet -> OutExpr -> Maybe [OutAlt]
- -- In the call (go wrap free_bndrs rhs), the `wrap` function has free `free_bndrs`;
- -- so do not push `wrap` under any binders that would shadow `free_bndrs`
- --
- -- The 'n' is just a depth-bound to avoid pathalogical quadratic behaviour with
- -- case x1 of DEFAULT -> case x2 of DEFAULT -> case x3 of DEFAULT -> ...
- -- when for each `case` we'll look down the whole chain to see if there is
- -- another `case` on that same variable. Also all of these (case xi) evals
- -- get duplicated in each branch of the outer case, so 'n' controls how much
- -- duplication we are prepared to put up with.
- go 0 _ _ _ = Nothing
-
- go n wrap free_bndrs (Tick t rhs)
- = go n (wrap . Tick t) free_bndrs rhs
- go _ wrap free_bndrs (Case (Var inner_scrut_var) inner_bndr _ inner_alts)
- | inner_scrut_var == outer_bndr
- , let wrap_let rhs' | isDeadBinder inner_bndr = rhs'
- | otherwise = Let (NonRec inner_bndr (Var outer_bndr)) rhs'
- -- The let is OK even for unboxed binders,
- free_bndrs' = extendVarSet free_bndrs outer_bndr
- = Just [ assert (not (any (`elemVarSet` free_bndrs') bndrs)) $
- Alt con bndrs (wrap (wrap_let rhs))
- | Alt con bndrs rhs <- inner_alts ]
- go n wrap free_bndrs (Case (Var inner_scrut) inner_bndr ty inner_alts)
- | [Alt con bndrs rhs] <- inner_alts -- Wrinkle (MC1)
- , let wrap_case rhs' = Case (Var inner_scrut) inner_bndr ty $
- tryMergeCase inner_bndr alts `orElse` alts
- where
- alts = [Alt con bndrs rhs']
- = assert (not (outer_bndr `elem` (inner_bndr : bndrs))) $
- go (n-1) (wrap . wrap_case) (free_bndrs `extendVarSet` inner_scrut) rhs
-
- go _ _ _ _ = Nothing
-
-tryMergeCase _ _ = Nothing
-
--------------------------------------------------
-- 2. Eliminate Identity Case
-- See Note [Eliminate Identity Case]
--------------------------------------------------
-mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case
+mkCase _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case
| all identity_alt alts
= do { tick (CaseIdentity case_bndr)
; return (mkTicks ticks $ re_cast scrut rhs1) }
@@ -2796,7 +2688,7 @@ mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity cas
re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co
re_cast scrut _ = scrut
-mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts
+mkCase mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts
--------------------------------------------------
-- 2. Scrutinee Constant Folding
@@ -2919,64 +2811,4 @@ Note [Dead binders]
Note that dead-ness is maintained by the simplifier, so that it is
accurate after simplification as well as before.
-
-Note [Cascading case merge]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Case merging should cascade in one sweep, because it
-happens bottom-up
-
- case e of a {
- DEFAULT -> case a of b
- DEFAULT -> case b of c {
- DEFAULT -> e
- A -> ea
- B -> eb
- C -> ec
-==>
- case e of a {
- DEFAULT -> case a of b
- DEFAULT -> let c = b in e
- A -> let c = b in ea
- B -> eb
- C -> ec
-==>
- case e of a {
- DEFAULT -> let b = a in let c = b in e
- A -> let b = a in let c = b in ea
- B -> let b = a in eb
- C -> ec
-
-
-However here's a tricky case that we still don't catch, and I don't
-see how to catch it in one pass:
-
- case x of c1 { I# a1 ->
- case a1 of c2 ->
- 0 -> ...
- DEFAULT -> case x of c3 { I# a2 ->
- case a2 of ...
-
-After occurrence analysis (and its binder-swap) we get this
-
- case x of c1 { I# a1 ->
- let x = c1 in -- Binder-swap addition
- case a1 of c2 ->
- 0 -> ...
- DEFAULT -> case x of c3 { I# a2 ->
- case a2 of ...
-
-When we simplify the inner case x, we'll see that
-x=c1=I# a1. So we'll bind a2 to a1, and get
-
- case x of c1 { I# a1 ->
- case a1 of c2 ->
- 0 -> ...
- DEFAULT -> case a1 of ...
-
-This is correct, but we can't do a case merge in this sweep
-because c2 /= a1. Reason: the binding c1=I# a1 went inwards
-without getting changed to c1=I# c2.
-
-I don't think this is worth fixing, even if I knew how. It'll
-all come out in the next pass anyway.
-}
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -16,7 +16,7 @@ module GHC.Core.Utils (
-- * Taking expressions apart
findDefault, addDefault, findAlt, isDefaultAlt,
- mergeAlts, trimConArgs,
+ mergeAlts, mergeCaseAlts, trimConArgs,
filterAlts, combineIdenticalAlts, refineDefaultAlt,
scaleAltsBy,
@@ -642,6 +642,61 @@ Similar things can happen (augmented by GADTs) when the Simplifier
filters down the matching alternatives in GHC.Core.Opt.Simplify.rebuildCase.
-}
+---------------------------------
+mergeCaseAlts :: Id -> [CoreAlt] -> (Bool, [CoreAlt])
+-- Result: (yes, alts'); if 'yes' then something actually happened
+-- See Note [Merge Nested Cases]
+mergeCaseAlts outer_bndr alts
+ | (Alt DEFAULT _ deflt_rhs : outer_alts) <- alts
+ , Just inner_alts <- go 5 (\e -> e) emptyVarSet deflt_rhs
+ = (True, mergeAlts outer_alts inner_alts)
+ -- NB: mergeAlts gives priority to the left
+ -- case x of
+ -- A -> e1
+ -- DEFAULT -> case x of
+ -- A -> e2
+ -- B -> e3
+ -- When we merge, we must ensure that e1 takes
+ -- precedence over e2 as the value for A!
+
+ | otherwise
+ = (False, alts)
+ where
+ go :: Int -> (OutExpr -> OutExpr) -> VarSet -> OutExpr -> Maybe [OutAlt]
+ -- In the call (go wrap free_bndrs rhs), the `wrap` function has free `free_bndrs`;
+ -- so do not push `wrap` under any binders that would shadow `free_bndrs`
+ --
+ -- The 'n' is just a depth-bound to avoid pathalogical quadratic behaviour with
+ -- case x1 of DEFAULT -> case x2 of DEFAULT -> case x3 of DEFAULT -> ...
+ -- when for each `case` we'll look down the whole chain to see if there is
+ -- another `case` on that same variable. Also all of these (case xi) evals
+ -- get duplicated in each branch of the outer case, so 'n' controls how much
+ -- duplication we are prepared to put up with.
+ go 0 _ _ _ = Nothing
+
+ go n wrap free_bndrs (Tick t rhs)
+ = go n (wrap . Tick t) free_bndrs rhs
+ go _ wrap free_bndrs (Case (Var inner_scrut_var) inner_bndr _ inner_alts)
+ | inner_scrut_var == outer_bndr
+ , let wrap_let rhs' = Let (NonRec inner_bndr (Var outer_bndr)) rhs'
+ -- inner_bndr is never dead! It's the scrutinee!
+ -- The let is OK even for unboxed binders,
+ free_bndrs' = extendVarSet free_bndrs outer_bndr
+ do_one (Alt con bndrs rhs)
+ | any (`elemVarSet` free_bndrs') bndrs = Nothing
+ | otherwise = Just (Alt con bndrs (wrap (wrap_let rhs)))
+ = mapM do_one inner_alts
+ go n wrap free_bndrs (Case (Var inner_scrut) inner_bndr ty inner_alts)
+ | [Alt con bndrs rhs] <- inner_alts -- Wrinkle (MC1)
+ , not (outer_bndr `elem` (inner_bndr : bndrs))
+ , let wrap_case rhs' = Case (Var inner_scrut) inner_bndr ty $
+ snd (mergeCaseAlts inner_bndr [Alt con bndrs rhs'])
+ -- Recursive call: see Note [Cascading case merge]
+ = go (n-1) (wrap . wrap_case) (free_bndrs `extendVarSet` inner_scrut) rhs
+
+ go _ _ _ _ = Nothing
+
+
---------------------------------
mergeAlts :: [Alt a] -> [Alt a] -> [Alt a]
-- ^ Merge alternatives preserving order; alternatives in
@@ -757,7 +812,132 @@ refineDefaultAlt us mult tycon tys imposs_deflt_cons all_alts
| otherwise -- The common case
= (False, all_alts)
-{- Note [Refine DEFAULT case alternatives]
+{- Note [Merge Nested Cases]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+ case e of b { ==> case e of b {
+ p1 -> rhs1 p1 -> rhs1
+ ... ...
+ pm -> rhsm pm -> rhsm
+ _ -> case b of b' { pn -> let b'=b in rhsn
+ pn -> rhsn ...
+ ... po -> let b'=b in rhso
+ po -> rhso _ -> let b'=b in rhsd
+ _ -> rhsd
+ }
+
+which merges two cases in one case when -- the default alternative of
+the outer case scrutinises the same variable as the outer case. This
+transformation is called Case Merging. It avoids that the same
+variable is scrutinised multiple times.
+
+Wrinkles
+
+(MC1) `tryMergeCase` "looks though" an inner single-alternative case-on-variable.
+ For example
+ case x of {
+ ...outer-alts...
+ DEFAULT -> case y of (a,b) ->
+ case x of { A -> rhs1; B -> rhs2 }
+ ===>
+ case x of
+ ...outer-alts...
+ a -> case y of (a,b) -> rhs1
+ B -> case y of (a,b) -> rhs2
+
+ This duplicates the `case y` but it removes the case x; so it is a win
+ in terms of execution time (combining the cases on x) at the cost of
+ perhaps duplicating the `case y`. A case in point is integerEq, which
+ is defined thus
+ integerEq :: Integer -> Integer -> Bool
+ integerEq !x !y = isTrue# (integerEq# x y)
+ which becomes
+ integerEq
+ = \ (x :: Integer) (y_aAL :: Integer) ->
+ case x of x1 { __DEFAULT ->
+ case y of y1 { __DEFAULT ->
+ case x1 of {
+ IS x2 -> case y1 of {
+ __DEFAULT -> GHC.Types.False;
+ IS y2 -> tagToEnum# @Bool (==# x2 y2) };
+ IP x2 -> ...
+ IN x2 -> ...
+ We want to merge the outer `case x` with thea inner `case x1`.
+
+ This story is not fully robust; it will be defeated by a let-binding,
+ whih we don't want to duplicate. But accounting for single-alternative
+ case-on-variable is easy to do, and seems useful in common cases so
+ `tryMergeCase` does it.
+
+(MC2) The auxiliary bindings b'=b are annoying, because they force another
+ simplifier pass, but there seems no easy way to avoid them. See
+ Note [Which transformations are innocuous] in GHC.Core.Opt.Stats.
+
+See also
+* Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils
+* Note [Cascading case merge]
+
+Note [Cascading case merge]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Case merging should cascade in one sweep, because it
+happens bottom-up
+
+ case e of a {
+ DEFAULT -> case a of b
+ DEFAULT -> case b of c {
+ DEFAULT -> e
+ A -> ea
+ B -> eb
+ C -> ec
+==>
+ case e of a {
+ DEFAULT -> case a of b
+ DEFAULT -> let c = b in e
+ A -> let c = b in ea
+ B -> eb
+ C -> ec
+==>
+ case e of a {
+ DEFAULT -> let b = a in let c = b in e
+ A -> let b = a in let c = b in ea
+ B -> let b = a in eb
+ C -> ec
+
+
+However here's a tricky case that we still don't catch, and I don't
+see how to catch it in one pass:
+
+ case x of c1 { I# a1 ->
+ case a1 of c2 ->
+ 0 -> ...
+ DEFAULT -> case x of c3 { I# a2 ->
+ case a2 of ...
+
+After occurrence analysis (and its binder-swap) we get this
+
+ case x of c1 { I# a1 ->
+ let x = c1 in -- Binder-swap addition
+ case a1 of c2 ->
+ 0 -> ...
+ DEFAULT -> case x of c3 { I# a2 ->
+ case a2 of ...
+
+When we simplify the inner case x, we'll see that
+x=c1=I# a1. So we'll bind a2 to a1, and get
+
+ case x of c1 { I# a1 ->
+ case a1 of c2 ->
+ 0 -> ...
+ DEFAULT -> case a1 of ...
+
+This is correct, but we can't do a case merge in this sweep
+because c2 /= a1. Reason: the binding c1=I# a1 went inwards
+without getting changed to c1=I# c2.
+
+I don't think this is worth fixing, even if I knew how. It'll
+all come out in the next pass anyway.
+
+
+Note [Refine DEFAULT case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
refineDefaultAlt replaces the DEFAULT alt with a constructor if there
is one possible value it could be.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ac340e06d2f6f05672cb5f69fc9a5ab5409ac1b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ac340e06d2f6f05672cb5f69fc9a5ab5409ac1b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240326/ae764867/attachment-0001.html>
More information about the ghc-commits
mailing list