From 41435f65023160d551aad8868938492cfd729f2f Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 22 Oct 2001 13:50:17 +0000
Subject: [PATCH] [project @ 2001-10-22 13:50:17 by simonpj] Make SimplGently
 a bit less gentle

---
 ghc/compiler/simplCore/SimplMonad.lhs |   23 +++++++++++++++++------
 ghc/compiler/simplCore/Simplify.lhs   |    2 +-
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 2b0d527..16e8499 100644
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -856,16 +856,27 @@ because they don't have bindings, so we must inline them no matter how
 gentle we are being.
 
 \begin{code}
-activeInline :: SimplEnv -> OutId -> Bool
-activeInline env id
+activeInline :: SimplEnv -> OutId -> OccInfo -> Bool
+activeInline env id occ
   = case getMode env of
-	SimplGently -> isDataConWrapId id
+	SimplGently -> isDataConWrapId id || isOneOcc occ
 		-- No inlining at all when doing gentle stuff,
-		-- except (hack alert) for data con wrappers
-		-- We want to inline data con wrappers even in gentle mode
-		-- because rule LHSs match better then
+		-- except (a) things that occur once
+		-- and (b) (hack alert) data con wrappers
+		-- 	   We want to inline data con wrappers even 
+		--	   in gentle mode because rule LHSs match better then
+-- The reason for (a) is that too little clean-up happens if you 
+-- don't inline use-once things.   Also a bit of inlining is *good* for
+-- full laziness; it can expose constant sub-expressions.
+-- Example in spectral/mandel/Mandel.hs, where the mandelset 
+-- function gets a useful let-float if you inline windowToViewport
+
 	SimplPhase n -> isActive n (idInlinePragma id)
 
+-- Belongs in BasicTypes; this frag occurs in OccurAnal too
+isOneOcc (OneOcc _ _) = True
+isOneOcc other	      = False
+
 activeRule :: SimplEnv -> Maybe (Activation -> Bool)
 -- Nothing => No rules at all
 activeRule env
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 88e6348..fce552a 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -911,7 +911,7 @@ completeCall env var occ_info cont
 						  (not (null arg_infos))
 						  call_cont
 
-    	active_inline = activeInline env var
+    	active_inline = activeInline env var occ_info
 	maybe_inline  = callSiteInline dflags active_inline inline_call occ_info
 				       var arg_infos interesting_cont
     in
-- 
1.7.10.4