[Git][ghc/ghc][wip/T22404] Add test T22404
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Wed Jul 26 06:54:49 UTC 2023
Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC
Commits:
7bc65cd6 by Simon Peyton Jones at 2023-07-26T07:54:31+01:00
Add test T22404
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- + testsuite/tests/simplCore/should_compile/T22404.hs
- + testsuite/tests/simplCore/should_compile/T22404.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -621,14 +621,25 @@ like to inline `v1 in just the same way as in (P1). But if we "andUDs"
the usage from j's RHS and its body, we'll get ManyOccs for `v`. Important
optimisation lost!
+Solving this problem makes the Simplifier less fragile. For example,
+the Simplifier might inline `j`, and convert (P2) into (P1)... or it might
+not, depending in a perhaps-fragile way on the size of the join point.
+I was motivated to implement this feature of the occurrence analyser
+when trying to make optimisation join points simpler and more robust
+(see #
+
The occurrence analyser therefore has clever code that behaves just as
-if you inlined `j` at all its call sites. Here is a tricky variant (P3)
+if you inlined `j` at all its call sites. Here is a tricky variant
to keep in mind:
+
+ Program (P3)
+ -------------------------------
join j = case v of (a,b) -> a
in case f v of
A -> j
B -> j
C -> []
+
If you mentally inline `j` you'll see that `v` is used twice on the path
through A, so it should have ManyOcc. Bear this caes in mind!
@@ -638,7 +649,7 @@ through A, so it should have ManyOcc. Bear this caes in mind!
that we discover for the first time in this sweep of the
occurrence analyser.
-* In occ_env, the new (occ_join_points :: IdEnv UsageDetails) maps
+* In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps
each in-scope non-recursive join point, such as `j` above, to
a "zeroed form" of its RHS's usage details. The "zeroed form"
* deletes ManyOccs
@@ -689,11 +700,13 @@ There are a couple of tricky wrinkles
UsageDetails mentions `v`. Instead, just `andUDs` all that usage in
right here.
- This is done by `add_bad_joins`` in `addInScope`; we use
- `partitionVarEnv` to identify the `bad_joins` (the ones whose
- UsageDetails mention the newly bound variables); then for any of /those/
- that are /actually mentioned/ in the body, use `andUDs` to add their
- UsageDetails to the returned UsageDetails. Tricky!
+ This requires work in two places.
+ * In `preprocess_env`, we detect if the newly-bound variables intersect
+ the free vars of occ_join_points. (These free vars are conveniently
+ simply the domain of the OccInfoEnv for that join point.) If so,
+ we zap the entire occ_join_points.
+ * In `postprcess_uds`, we add the chucked-out join points to the
+ returned UsageDetails, with `andUDs`.
(W3) Consider this example, which shadows `j`, but this time in an argument
join j = rhs
@@ -701,7 +714,7 @@ There are a couple of tricky wrinkles
We can zap the entire occ_join_points when looking at the argument,
because `j` can't posibly occur -- it's a join point! And the smaller
occ_join_points is, the better. Smaller to look up in mkOneOcc, and
- more important, less looking-up when partitioning in (W2), in addInScope.
+ more important, less looking-up when checking (W2).
This is done in setNonTailCtxt. It's important /not/ to do this for
join-point RHS's because of course `j` can occur there!
@@ -971,33 +984,6 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine
(combine [NonRec (tagNonRecBinder lvl occ bndr') rhs']
body)
-{-
- -- Fast path for top level, non-recursive bindings, with no rules
- -- This is a very common case. Semantically though, you can delete this
- -- entire equation and fall through to the general case
- -- Fast path:
- -- * Top level so cannot be a join point
- -- * Top level so no binder swap, so no need to update unfolding
- -- * No rules so no faffing with them
- | TopLevel <- lvl
- , not (idHasRules bndr || (bndr `elemVarEnv` ire))
- = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env bndr thing_inside
- in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code]
- then WUD body_uds body
- else let
- unf = idUnfolding bndr
- rhs_env = addOneShotsFromDmd bndr $
- setNonTailCtxt (mkNonRecRhsCtxt tagged_bndr unf) env
- !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs
- !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf
- rhs_uds = adjustTailUsage Nothing rhs_wuds
- full_rhs_uds | isStableUnfolding unf = rhs_uds `andUDs` markAllNonTail unf_uds
- | otherwise = rhs_uds
-
- in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs`
- (combine [NonRec tagged_bndr rhs'] body)
--}
-
-- The normal case, including newly-discovered join points
-- Analyse the body and /then/ the RHS
| otherwise
@@ -1032,8 +1018,10 @@ occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity
-> Id -> CoreExpr
-> ([UsageDetails], Id, CoreExpr)
occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs
- | null rules, null imp_rule_infos -- Fast path for common case
- = ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs )
+ | null rules, null imp_rule_infos
+ = -- Fast path for common case of no rules. This is only worth
+ -- 0.1% perf on average, but it's also only a line or two of code
+ ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs )
| otherwise
= (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs )
where
@@ -1088,8 +1076,6 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs
[ l `andUDs` adjustTailArity mb_join r
| (_,l,r) <- rules_w_uds ]
-
- ----------
mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl
mkNonRecRhsCtxt bndr unf
| certainly_inline = OccVanilla -- See Note [Cascading inlines]
=====================================
testsuite/tests/simplCore/should_compile/T22404.hs
=====================================
@@ -0,0 +1,28 @@
+module T22404 where
+
+{-# NOINLINE foo #-}
+foo :: [a] -> (a,a)
+foo [x,y] = (x,y)
+foo (x:xs) = foo xs
+
+data T = A | B | C | D
+
+-- The point of this test is that 'v' ought
+-- not to be a thunk in the optimised program
+-- It is used only once in each branch. But we
+-- need a clever occurrence analyser to spot it;
+-- see Note [Occurrence analysis for join points]
+-- in GHC.Core.Opt.OccurAnoa
+
+f x xs = let v = foo xs in
+
+ let {-# NOINLINE j #-}
+ j True = case v of (a,b) -> a
+ j False = case v of (a,b) -> b
+ in
+
+ case x of
+ A -> j True
+ B -> j False
+ C -> case v of (a,b) -> b
+ D -> x
=====================================
testsuite/tests/simplCore/should_compile/T22404.stderr
=====================================
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bc65cd604496451bf3c4190e260fbfd55e9d10b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bc65cd604496451bf3c4190e260fbfd55e9d10b
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/20230726/eb4affbf/attachment-0001.html>
More information about the ghc-commits
mailing list