From 43d903cfaafb0b41242af128c7ddbf0b649f63bd Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Mon, 2 Jul 2007 13:24:31 +0000
Subject: [PATCH] Try harder to avoid making a variable with RULES into a
 loop-breaker

See Note [Recursive rules] in OccurAnal
---
 compiler/simplCore/OccurAnal.lhs |   33 +++++++++++++++++++++++++++------
 compiler/simplCore/Simplify.lhs  |    2 ++
 2 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 4dfd3bf..dc20fd2 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -300,16 +300,18 @@ reOrderCycle bndrs (bind : binds)
 		-- where df is the exported dictionary. Then df makes a really
 		-- bad choice for loop breaker
 	  
-	| is_con_app rhs = 3	-- Data types help with cases
+	| idHasRules bndr = 3
+		-- Avoid things with specialisations; we'd like
+		-- to take advantage of them in the subsequent bindings
+		-- Also vital to avoid risk of divergence:
+		-- Note [Recursive rules]
+
+	| is_con_app rhs = 2	-- Data types help with cases
 		-- This used to have a lower score than inlineCandidate, but
 		-- it's *really* helpful if dictionaries get inlined fast,
 		-- so I'm experimenting with giving higher priority to data-typed things
 
-	| inlineCandidate bndr rhs = 2	-- Likely to be inlined
-
-	| idHasRules bndr = 1
-		-- Avoid things with specialisations; we'd like
-		-- to take advantage of them in the subsequent bindings
+	| inlineCandidate bndr rhs = 1	-- Likely to be inlined
 
 	| otherwise = 0
 
@@ -352,6 +354,25 @@ makeLoopBreaker bndrs rhs_usg bndr
     rules_only = bndrs `intersectsUFM` rhs_usg
 \end{code}
 
+Note [Recursive rules]
+~~~~~~~~~~~~~~~~~~~~~~
+Consider this group, which is typical of what SpecConstr builds:
+
+   fs a = ....f (C a)....
+   f  x = ....f (C a)....
+   {-# RULE f (C a) = fs a #-}
+
+So 'f' and 'fs' are mutually recursive.  If we choose 'fs' as the loop breaker,
+all is well; the RULE is applied, and 'fs' becomes self-recursive.
+
+But if we choose 'f' as the loop breaker, we may get an infinite loop:
+	- the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify
+	- fs is inlined (say it's small)
+	- now there's another opportunity to apply the RULE
+
+So it's very important to choose the RULE-variable as the loop breaker.
+This showed up when compiling Control.Concurrent.Chan.getChanContents.
+
 Note [Closure conversion]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 We treat (\x. C p q) as a high-score candidate in the letrec scoring algorithm.
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index ac1f790..5142632 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -952,6 +952,8 @@ completeCall env var cont
 	-- the wrapper didn't occur for things that have specialisations till a 
 	-- later phase, so but now we just try RULES first
 	--
+	-- Note [Self-recursive rules]
+	-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 	-- You might think that we shouldn't apply rules for a loop breaker: 
 	-- doing so might give rise to an infinite loop, because a RULE is
 	-- rather like an extra equation for the function:
-- 
1.7.10.4