X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=5797cba2bf336f6d1e3c762c94e2f5346ce27d94;hb=8604da0136707cc14845d14a88c2272fe576b6d0;hp=1bc945dbb8207cd7213b145e34fc0f17bd1c77b2;hpb=2859b53114d1307e9306940d36fa1bae0ad4934c;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 1bc945d..5797cba 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -27,12 +27,10 @@ module CoreUnfold (
 	couldBeSmallEnoughToInline, 
 	certainlyWillInline, smallEnoughToInline,
 
-	callSiteInline, CallContInfo(..)
+	callSiteInline, CallCtxt(..)
 
     ) where
 
-#include "HsVersions.h"
-
 import StaticFlags
 import DynFlags
 import CoreSyn
@@ -48,6 +46,7 @@ import Type
 import PrelNames
 import Bag
 import FastTypes
+import FastString
 import Outputable
 
 \end{code}
@@ -85,11 +84,11 @@ mkUnfolding top_lvl expr
 	-- it gets fixed up next round
 
 instance Outputable Unfolding where
-  ppr NoUnfolding = ptext SLIT("No unfolding")
-  ppr (OtherCon cs) = ptext SLIT("OtherCon") <+> ppr cs
-  ppr (CompulsoryUnfolding e) = ptext SLIT("Compulsory") <+> ppr e
+  ppr NoUnfolding = ptext (sLit "No unfolding")
+  ppr (OtherCon cs) = ptext (sLit "OtherCon") <+> ppr cs
+  ppr (CompulsoryUnfolding e) = ptext (sLit "Compulsory") <+> ppr e
   ppr (CoreUnfolding e top hnf cheap g) 
-	= ptext SLIT("Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
+	= ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
 				     ppr e]
 
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
@@ -106,9 +105,9 @@ mkCompulsoryUnfolding expr	-- Used for things that absolutely must be unfolded
 
 \begin{code}
 instance Outputable UnfoldingGuidance where
-    ppr UnfoldNever	= ptext SLIT("NEVER")
+    ppr UnfoldNever	= ptext (sLit "NEVER")
     ppr (UnfoldIfGoodArgs v cs size discount)
-      = hsep [ ptext SLIT("IF_ARGS"), int v,
+      = hsep [ ptext (sLit "IF_ARGS"), int v,
 	       brackets (hsep (map int cs)),
 	       int size,
 	       int discount ]
@@ -513,19 +512,25 @@ callSiteInline :: DynFlags
 	       -> Id			-- The Id
 	       -> Bool			-- True if there are are no arguments at all (incl type args)
 	       -> [Bool]		-- One for each value arg; True if it is interesting
-	       -> CallContInfo		-- True <=> continuation is interesting
+	       -> CallCtxt		-- True <=> continuation is interesting
 	       -> Maybe CoreExpr	-- Unfolding, if any
 
 
-data CallContInfo = BoringCont		
-		  | InterestingCont	-- Somewhat interesting
-		  | CaseCont		-- Very interesting; the argument of a case
-					-- that decomposes its scrutinee
+data CallCtxt = BoringCtxt
+
+	      | ArgCtxt Bool	-- We're somewhere in the RHS of function with rules
+				--	=> be keener to inline
+			Int	-- We *are* the argument of a function with this arg discount
+				--	=> be keener to inline
+		-- INVARIANT: ArgCtxt False 0 ==> BoringCtxt
+
+	      | CaseCtxt	-- We're the scrutinee of a case
+				-- that decomposes its scrutinee
 
-instance Outputable CallContInfo where
-  ppr BoringCont      = ptext SLIT("BoringCont")
-  ppr InterestingCont = ptext SLIT("InterestingCont")
-  ppr CaseCont 	      = ptext SLIT("CaseCont")
+instance Outputable CallCtxt where
+  ppr BoringCtxt    = ptext (sLit "BoringCtxt")
+  ppr (ArgCtxt _ _) = ptext (sLit "ArgCtxt")
+  ppr CaseCtxt 	    = ptext (sLit "CaseCtxt")
 
 callSiteInline dflags active_inline id lone_variable arg_infos cont_info
   = case idUnfolding id of {
@@ -588,17 +593,18 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 
 		    interesting_saturated_call 
 			= case cont_info of
-			    BoringCont -> not is_top && n_vals_wanted > 0	-- Note [Nested functions] 
-			    CaseCont   -> not lone_variable || not is_value	-- Note [Lone variables]
-			    InterestingCont -> n_vals_wanted > 0
+			    BoringCtxt -> not is_top && n_vals_wanted > 0	-- Note [Nested functions] 
+			    CaseCtxt   -> not lone_variable || not is_value	-- Note [Lone variables]
+			    ArgCtxt {} -> True
+				-- Was: n_vals_wanted > 0; but see test eyeball/inline1.hs
 
 		    small_enough = (size - discount) <= opt_UF_UseThreshold
 		    discount = computeDiscount n_vals_wanted arg_discounts 
 					       res_discount' arg_infos
 		    res_discount' = case cont_info of
-					BoringCont      -> 0
-					CaseCont        -> res_discount
-					InterestingCont -> 4 `min` res_discount
+					BoringCtxt  -> 0
+					CaseCtxt    -> res_discount
+					ArgCtxt _ _ -> 4 `min` res_discount
 			-- res_discount can be very large when a function returns
 			-- construtors; but we only want to invoke that large discount
 			-- when there's a case continuation.