From 916abd028990c7fb1588d1792f3ac799a257ba21 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 20 Nov 2002 15:39:47 +0000
Subject: [PATCH] [project @ 2002-11-20 15:39:47 by simonpj]
 ------------------------------------ 	Improve occurrence
 analysis a little 	------------------------------------

Consider

		x1 = a0 : []
		x2 = a1 : x1
		x3 = a2 : x2
		g  = f x3

First time round, it looks as if x1 and x2 occur as an arg of a
let(rec)-bound constructor, and hence should not be inlined. (If the
RHS of a let is just (C a b) where C is a constructor, then we like to
keep it that way, with atomic a,b, so that it can be inlined easily at
a 'case'.)

But in this case, x3 is inlined in g's RHS... and now x2 is not an arg
of a let-bound constructor, so it can be inlined, and then x1.   Result:

		g = f (a2 : a1 : a0 : [])

Which is fine.  What is *not* fine is that it has been costing us a
whole simplifier iteration for each element!

This commit adds another little hack to get around the problem: don't treat
constructor RHSs specially if the bound variable looks as if it occurs just
once so it'll be inlined.  This catches the common case very nicely.

It's a pain that we have the atomic-args-for-constructor-RHSs invariant.
But I can't see  how to do without it.
---
 ghc/compiler/simplCore/OccurAnal.lhs |   21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index a46580b..02fe904 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -246,7 +246,7 @@ occAnalBind env (NonRec binder rhs) body_usage
 
   where
     (final_body_usage, tagged_binder) = tagBinder body_usage binder
-    (rhs_usage, rhs')		      = occAnalRhs env binder rhs
+    (rhs_usage, rhs')		      = occAnalRhs env tagged_binder rhs
 \end{code}
 
 Dropping dead code for recursive bindings is done in a very simple way:
@@ -502,26 +502,34 @@ ToDo: try using the occurrence info for the inline'd binder.
 \begin{code}
 occAnalRhs :: OccEnv
 	   -> Id -> CoreExpr	-- Binder and rhs
+				-- For non-recs the binder is alrady tagged
+				-- with occurrence info
 	   -> (UsageDetails, CoreExpr)
 
 occAnalRhs env id rhs
   = (final_usage, rhs')
   where
-    (rhs_usage, rhs') = occAnal (rhsCtxt env) rhs
-	-- Note that we use an rhsCtxt.  This tells the occ anal that it's
-	-- looking at an RHS, which has an effect in occAnalApp
+    (rhs_usage, rhs') = occAnal ctxt rhs
+    ctxt | certainly_inline id = env
+	 | otherwise	       = rhsCtxt env
+	-- Note that we generally use an rhsCtxt.  This tells the occ anal n
+	-- that it's looking at an RHS, which has an effect in occAnalApp
 	--
 	-- But there's a problem.  Consider
 	--	x1 = a0 : []
 	--	x2 = a1 : x1
 	--	x3 = a2 : x2
-	--	g  = f x2
+	--	g  = f x3
 	-- First time round, it looks as if x1 and x2 occur as an arg of a 
 	-- let-bound constructor ==> give them a many-occurrence.
 	-- But then x3 is inlined (unconditionally as it happens) and
 	-- next time round, x2 will be, and the next time round x1 will be
 	-- Result: multiple simplifier iterations.  Sigh.  
-	-- Possible solution: use rhsCtxt for things that occur just once...
+	-- Crude solution: use rhsCtxt for things that occur just once...
+
+    certainly_inline id = case idOccInfo id of
+			    OneOcc in_lam one_br -> not in_lam && one_br
+			    other		 -> False
 
 	-- [March 98] A new wrinkle is that if the binder has specialisations inside
 	-- it then we count the specialised Ids as "extra rhs's".  That way
@@ -533,6 +541,7 @@ occAnalRhs env id rhs
     add v u = addOneOcc u v NoOccInfo		-- Give a non-committal binder info
 						-- (i.e manyOcc) because many copies
 						-- of the specialised thing can appear
+
 \end{code}
 
 Expressions
-- 
1.7.10.4