summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-07-21 14:03:23 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2021-08-02 12:23:18 +0100
commit4d319d06d5c6d50ab14fb558c6f1d0d7fc55af54 (patch)
treea06e713d11317180596dd8038a4a0536eafa25bf
parent34e352173dd1fc3cd86c49380fda5a4eb5dd7aef (diff)
downloadhaskell-wip/debug-rules.tar.gz
Remove eager forcing of RuleInfo in substRuleInfowip/debug-rules
substRuleInfo updates the IdInfo for an Id, therefore it is important to not force said IdInfo whilst updating it, otherwise we end up in an infinite loop. This is what happened in #20112 where `mkTick` forced the IdInfo being updated by checking the arity in isSaturatedConApp. The fix is to stop the expression being forced so early by removing the call to seqRuleInfo. The call sequence looked something like: * `substRecBndrs` * `substIdBndr` * `substIdInfo` * `substRuleInfo` * `substRule` * `substExpr` * `mkTick` * `isSaturatedConApp` * Look at `IdInfo` for thing we are currently substituting because the rule is attached to `transpose` and mentions it in the `RHS` of the rule. Which arose because the `transpose` Id had a rule attached where the RHS of the rule also mentioned `transpose`. This call to seqRuleInfo was introduced in 4e7d56fde0f44d38bbb9a6fc72cf9c603264899d where it was explained > I think there are now *too many* seqs, and they waste work, but I don't have > time to find which ones. We also observe that there is the ominous note on `substRule` about making sure substExpr is called lazily. > {- Note [Substitute lazily] > ~~~~~~~~~~~~~~~~~~~~~~~~~~~ > The functions that substitute over IdInfo must be pretty lazy, because > they are knot-tied by substRecBndrs. > > One case in point was #10627 in which a rule for a function 'f' > referred to 'f' (at a different type) on the RHS. But instead of just > substituting in the rhs of the rule, we were calling simpleOptExpr, which > looked at the idInfo for 'f'; result <<loop>>. > > In any case we don't need to optimise the RHS of rules, or unfoldings, > because the simplifier will do that. Before `seqRuleInfo` was removed, this note was pretty much ignored in the `substSpec` case because the expression was immediately forced after `substRule` was called. Unfortunately it's a bit tricky to add a test for this as the failure only manifested (for an unknown reason) with a dwarf enabled compiler *AND* compiling with -g3. Fortunatley there is currently a CI configuration which builds a dwarf compiler to test this. Also, for good measure, finish off the work started in 840df33685e8c746ade4b9d4d0eb7c764a773e48 which renamed SpecInfo to RuleInfo but then didn't rename 'substSpec' to 'substRuleInfo'. Fixes #20112
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs2
-rw-r--r--compiler/GHC/Core/Subst.hs40
-rw-r--r--testsuite/tests/simplCore/should_compile/T20112.hs26
-rw-r--r--testsuite/tests/simplCore/should_compile/T20112A.hs21
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T1
5 files changed, 81 insertions, 9 deletions
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 47d2c3f454..40e9f138b7 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -665,7 +665,7 @@ add_info env old_bndr top_level new_rhs new_bndr
`setUnfoldingInfo` new_unfolding
old_rules = ruleInfo old_info
- new_rules = substSpec subst new_bndr old_rules
+ new_rules = substRuleInfo subst new_bndr old_rules
old_unfolding = realUnfoldingInfo old_info
new_unfolding | isStableUnfolding old_unfolding
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 36f3bad0d4..be05e1c44c 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -14,7 +14,7 @@ module GHC.Core.Subst (
TvSubstEnv, IdSubstEnv, InScopeSet,
-- ** Substituting into expressions and related types
- deShadowBinds, substSpec, substRulesForImportedIds,
+ deShadowBinds, substRuleInfo, substRulesForImportedIds,
substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
substUnfolding, substUnfoldingSC,
lookupIdSubst, lookupTCvSubst, substIdType, substIdOcc,
@@ -622,7 +622,7 @@ substIdType subst@(Subst _ _ tv_env cv_env) id
substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo subst new_id info
| nothing_to_do = Nothing
- | otherwise = Just (info `setRuleInfo` substSpec subst new_id old_rules
+ | otherwise = Just (info `setRuleInfo` substRuleInfo subst new_id old_rules
`setUnfoldingInfo` substUnfolding subst old_unf)
where
old_rules = ruleInfo info
@@ -668,14 +668,13 @@ substIdOcc subst v = case lookupIdSubst subst v of
other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst])
------------------
--- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'
-substSpec :: Subst -> Id -> RuleInfo -> RuleInfo
-substSpec subst new_id (RuleInfo rules rhs_fvs)
- = seqRuleInfo new_spec `seq` new_spec
+-- | Substitutes for the 'Id's within the 'RuleInfo' given the new function 'Id'
+substRuleInfo :: Subst -> Id -> RuleInfo -> RuleInfo
+substRuleInfo subst new_id (RuleInfo rules rhs_fvs)
+ = RuleInfo (map (substRule subst subst_ru_fn) rules)
+ (substDVarSet subst rhs_fvs)
where
subst_ru_fn = const (idName new_id)
- new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules)
- (substDVarSet subst rhs_fvs)
------------------
substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
@@ -738,6 +737,31 @@ looked at the idInfo for 'f'; result <<loop>>.
In any case we don't need to optimise the RHS of rules, or unfoldings,
because the simplifier will do that.
+Another place this went wrong was in `substRuleInfo`, which would immediately force
+the lazy call to substExpr, which led to an infinite loop (as reported by #20112).
+
+This time the call stack looked something like:
+
+* `substRecBndrs`
+* `substIdBndr`
+* `substIdInfo`
+* `substRuleInfo`
+* `substRule`
+* `substExpr`
+* `mkTick`
+* `isSaturatedConApp`
+* Look at `IdInfo` for thing we are currently substituting because the rule is attached to `transpose` and mentions it in the `RHS` of the rule.
+
+and the rule was
+
+{-# RULES
+"transpose/overlays1" forall xs. transpose (overlays1 xs) = overlays1 (fmap transpose xs)
+#-}
+
+This rule was attached to `transpose`, but also mentions itself in the RHS so we have
+to be careful to not force the `IdInfo` for transpose when dealing with the RHS of the rule.
+
+
Note [substTickish]
~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/simplCore/should_compile/T20112.hs b/testsuite/tests/simplCore/should_compile/T20112.hs
new file mode 100644
index 0000000000..72a4198246
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T20112.hs
@@ -0,0 +1,26 @@
+module T20112 (
+ -- * Data structure
+ AdjacencyMap, transpose, overlays1
+
+ ) where
+
+import Prelude hiding (reverse)
+import Data.List.NonEmpty(NonEmpty, toList)
+import Data.Coerce
+
+import qualified T20112A as AM
+
+newtype AdjacencyMap a = NAM ( AM.AdjacencyMap a )
+
+overlays1 :: Ord a => NonEmpty (AdjacencyMap a) -> AdjacencyMap a
+overlays1 = coerce AM.overlays . toList
+{-# NOINLINE overlays1 #-}
+
+transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a
+transpose = coerce AM.transpose
+{-# NOINLINE [1] transpose #-}
+
+{-# RULES
+"transpose/overlays1" forall xs. transpose (overlays1 xs) = overlays1 (fmap transpose xs)
+ #-}
+
diff --git a/testsuite/tests/simplCore/should_compile/T20112A.hs b/testsuite/tests/simplCore/should_compile/T20112A.hs
new file mode 100644
index 0000000000..a8f30efbc8
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T20112A.hs
@@ -0,0 +1,21 @@
+module T20112A (
+ -- * Data structure
+ AdjacencyMap, adjacencyMap, transpose, overlays
+
+ ) where
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+newtype AdjacencyMap a = AM {
+ adjacencyMap :: Map a (Set.Set a) }
+
+overlays :: Ord a => [AdjacencyMap a] -> AdjacencyMap a
+overlays = AM . Map.unionsWith Set.union . map adjacencyMap
+
+transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a
+transpose (AM m) = AM $ Map.foldrWithKey combine vs m
+ where
+ combine v es = Map.unionWith Set.union (Map.fromSet (const $ Set.singleton v) es)
+ vs = Map.fromSet (const Set.empty) (Map.keysSet m)
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 25296eda0f..c8fc59f78d 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -371,3 +371,4 @@ test('T20125', [ grep_errmsg(r'= T20125.MkT') ], compile, ['-O -ddump-simpl -ds
test('T20143', [ grep_errmsg(r'unsafeEqualityProof') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T20174', normal, compile, [''])
test('T16373', normal, compile, [''])
+test('T20112', normal, multimod_compile, ['T20112', '-O -v0 -g1'])