From f5c94708c39c7b64c0d52057408332ed837834e6 Mon Sep 17 00:00:00 2001
From: apt <unknown>
Date: Thu, 19 Jul 2001 15:32:05 +0000
Subject: [PATCH] [project @ 2001-07-19 15:32:05 by apt] reinstate inlinings
 that are completely within an INLINE

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

diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
index 19faf99..70112ed 100644
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ b/ghc/compiler/simplCore/SimplMonad.lhs
@@ -49,7 +49,8 @@ module SimplMonad (
 
 #include "HsVersions.h"
 
-import Id		( Id, mkSysLocal, idType, idUnfolding, isDataConWrapId )
+import Id		( Id, mkSysLocal, idType, idUnfolding, isDataConWrapId,
+			  isGlobalId )
 import CoreSyn
 import CoreUnfold	( isCompulsoryUnfolding )
 import CoreUtils	( exprOkForSpeculation )
@@ -61,7 +62,8 @@ import VarSet
 import OrdList
 import qualified Subst
 import Subst		( Subst, mkSubst, substEnv, 
-			  InScopeSet, mkInScopeSet, substInScope
+			  InScopeSet, mkInScopeSet, substInScope,
+			  isInScope 
 			)
 import Type             ( Type, isUnLiftedType )
 import UniqSupply	( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
@@ -629,18 +631,21 @@ setBlackList black_list m dflags env us sc
 getBlackList :: SimplM BlackList
 getBlackList dflags env us sc = (seBlackList env, us, sc)
 
-noInlineBlackList :: BlackList
+noInlineBlackList :: SimplM BlackList
 	-- Inside inlinings, black list anything that is in scope or imported.
 	-- except for things that must be unfolded (Compulsory)
 	-- and data con wrappers.  The latter is a hack, like the one in
 	-- SimplCore.simplRules, to make wrappers inline in rule LHSs.
 	-- We may as well do the same here.
-noInlineBlackList v = not (isCompulsoryUnfolding (idUnfolding v)) &&
-		      not (isDataConWrapId v)
-	-- NB: this implementation means that even inlinings *completely within*
-	-- an INLINE won't happen, which is perhaps overkill. 
-	-- An earlier verion had: (v `isInScope` subst) || not (isLocallyDefined v)
-	-- but it's more expensive, and it probably doesn't matter.
+noInlineBlackList dflags env us sc = (blacklisted,us,sc)
+	where blacklisted v =
+	   	  not (isCompulsoryUnfolding (idUnfolding v)) &&
+		  not (isDataConWrapId v) &&
+		  (v `isInScope` (seSubst env) || isGlobalId v)
+	-- NB: An earlier version omitted the last clause; this meant 
+	-- that even inlinings *completely within* an INLINE didn't happen. 
+	-- This was cheaper, and probably adequate, but produced awful code
+        -- for some dictionary constructions.
 \end{code}
 
 
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 1dc5ab0..638efec 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -429,7 +429,8 @@ simplNote InlineCall e cont
 simplNote InlineMe e cont
   | keep_inline cont		-- Totally boring continuation
   =				-- Don't inline inside an INLINE expression
-    setBlackList noInlineBlackList (simplExpr e)	`thenSmpl` \ e' ->
+    noInlineBlackList 			`thenSmpl` \ bl ->
+    setBlackList bl (simplExpr e)	`thenSmpl` \ e' ->
     rebuild (mkInlineMe e') cont
 
   | otherwise  	-- Dissolve the InlineMe note if there's
@@ -947,7 +948,8 @@ simplifyArgs is_data_con args cont_ty thing_inside
 		-- Even though x get's an occurrence of 'many', its RHS looks cheap,
 		-- and there's a good chance it'll get inlined back into C's RHS. Urgh!
   = getBlackList				`thenSmpl` \ old_bl ->
-    setBlackList noInlineBlackList		$
+    noInlineBlackList				`thenSmpl` \ ni_bl ->
+    setBlackList ni_bl				$
     go args					$ \ args' ->
     setBlackList old_bl				$
     thing_inside args'
-- 
1.7.10.4