Fix bug in weak loop-breakers in OccurAnalwip/T20820

Note [Weak loop breakers] explains why we need to track variables free
in RHS of rules.  But we need to do this for /inactive/ rules as well
as active ones, unlike the rhs_fv_env stuff.

So we now have two fields in node Details, one for free vars of
active rules, and one for free vars of all rules.

This was shown up by #20820, which is now fixed.

3 files changed, 58 insertions, 10 deletions

diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 901bc83077..5d31eb2cfd 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -869,14 +869,14 @@ occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds)
     (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s
 
     ------------------------------
-    active_rule_fvs :: VarSet
-    active_rule_fvs = mapUnionVarSet nd_active_rule_fvs details_s
+    weak_fvs :: VarSet
+    weak_fvs = mapUnionVarSet nd_weak_fvs details_s
 
     ---------------------------
     -- Now reconstruct the cycle
     pairs :: [(Id,CoreExpr)]
-    pairs | all_simple = reOrderNodes   0 active_rule_fvs loop_breaker_nodes []
-          | otherwise  = loopBreakNodes 0 active_rule_fvs loop_breaker_nodes []
+    pairs | all_simple = reOrderNodes   0 weak_fvs loop_breaker_nodes []
+          | otherwise  = loopBreakNodes 0 weak_fvs loop_breaker_nodes []
           -- In the common case when all are "simple" (no rules at all)
           -- the loop_breaker_nodes will include all the scope edges
           -- so a SCC computation would yield a single CyclicSCC result;
@@ -966,8 +966,7 @@ There is a last nasty wrinkle.  Suppose we have
 
           h = h_rhs
           g = h
-          ...more...
-    }
+          ...more... }
 
 Remember that we simplify the RULES before any RHS (see Note
 [Rules are visible in their own rec group] above).
@@ -991,7 +990,11 @@ So q must remain in scope in the output program!
 We "solve" this by:
 
     Make q a "weak" loop breaker (OccInfo = IAmLoopBreaker True)
-    iff q is a mentioned in the RHS of an active RULE in the Rec group
+    iff q is a mentioned in the RHS of any RULE (active on not)
+    in the Rec group
+
+Note the "active or not" comment; even if a RULE is inactive, we
+want its RHS free vars to stay alive (#20820)!
 
 A normal "strong" loop breaker has IAmLoopBreaker False.  So:
 
@@ -1007,8 +1010,8 @@ Annoyingly, since we simplify the rules *first* we'll never inline
 q into p's RULE.  That trivial binding for q will hang around until
 we discard the rule.  Yuk.  But it's rare.
 
- Note [Rules and loop breakers]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Rules and loop breakers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we form the loop-breaker graph (Step 4 in Note [Recursive
 bindings: the grand plan]), we must be careful about RULEs.
 
@@ -1028,7 +1031,7 @@ Hence, if
     h has a RULE that mentions f
 
 then we *must* choose f to be a loop breaker.  Example: see Note
-[Specialisation rules]. So out plan is this:
+[Specialisation rules]. So our plan is this:
 
    Take the free variables of f's RHS, and augment it with all the
    variables reachable by a transitive sequence RULES from those
@@ -1330,8 +1333,13 @@ data Details
                                 -- If all nodes are simple we don't need a loop-breaker
                                 -- dep-anal before reconstructing.
 
+       , nd_weak_fvs :: IdSet    -- Variables bound in this Rec group that are free
+                                 -- in the RHS of any rule (active or not) for this bndr
+                                 -- See Note [Weak loop breakers]
+
        , nd_active_rule_fvs :: IdSet    -- Variables bound in this Rec group that are free
                                         -- in the RHS of an active rule for this bndr
+                                        -- See Note [Rules and loop breakers]
 
        , nd_score :: NodeScore
   }
@@ -1375,6 +1383,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs)
                  , nd_uds             = scope_uds
                  , nd_inl             = inl_fvs
                  , nd_simple          = null rules_w_uds && null imp_rule_info
+                 , nd_weak_fvs        = weak_fvs
                  , nd_active_rule_fvs = active_rule_fvs
                  , nd_score           = pprPanic "makeNodeDetails" (ppr bndr) }
 
@@ -1431,6 +1440,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs)
     rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds
     add_rule_uds (_, l, r) uds = l `andUDs` r `andUDs` uds
 
+    -------- active_rule_fvs ------------
     active_rule_fvs = foldr add_active_rule imp_rule_fvs rules_w_uds
     add_active_rule (rule, _, rhs_uds) fvs
       | is_active (ruleActivation rule)
@@ -1438,6 +1448,10 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs)
       | otherwise
       = fvs
 
+    -------- weak_fvs ------------
+    -- See Note [Weak loop breakers]
+    weak_fvs = foldr add_rule emptyVarSet rules_w_uds
+    add_rule (_, _, rhs_uds) fvs = udFreeVars bndr_set rhs_uds `unionVarSet` fvs
 
 mkLoopBreakerNodes :: OccEnv -> TopLevelFlag
                    -> UsageDetails   -- for BODY of let
diff --git a/testsuite/tests/simplCore/should_compile/T20820.hs b/testsuite/tests/simplCore/should_compile/T20820.hs
new file mode 100644
index 0000000000..546f61e919
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T20820.hs
@@ -0,0 +1,29 @@
+module T20820 ( ) where
+
+import Prelude hiding (concat)
+import Data.Semigroup           (Semigroup (sconcat, stimes))
+import Data.List.NonEmpty       (NonEmpty ((:|)))
+
+data ByteString = BS
+
+instance Semigroup ByteString where
+    (<>)    = undefined
+    sconcat (b:|bs) = concat (b:bs)
+    stimes  = stimesPolymorphic
+instance Monoid ByteString where
+    mempty  = undefined
+
+concat :: [ByteString] -> ByteString
+concat = undefined
+{-# NOINLINE concat #-}
+
+{-# RULES
+"ByteString concat [] -> mempty"
+   concat [] = mempty
+ #-}
+
+stimesPolymorphic :: Integral a => a -> ByteString -> ByteString
+stimesPolymorphic nRaw bs = stimesInt (fromIntegral nRaw) bs
+
+stimesInt :: Int -> ByteString -> ByteString
+stimesInt _ BS = mempty
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 4915d4b273..034a76fadd 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -374,3 +374,8 @@ test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_c
 test('T20639', normal, compile, ['-O2'])
 test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output'])
 test('T19790',  normal, compile, ['-O -ddump-rule-firings'])
+
+# This one had a Lint failure due to an occurrence analysis bug
+# -O0 is needed to trigger it because that switches rules off,
+# which (before the fix) lost crucial dependencies
+test('T20820',  normal, compile, ['-O0'])