X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreUnfold.lhs;h=46f2ba2015f5332bd9941e19d8d81e3926f3f0e4;hb=1cfc9faaa059b9b090971399e4eb8ae9d364335c;hp=7412f0d6987f8863c0c0e934fb09b6a8467806bf;hpb=e205a0ce83c11de96656cf0b870eee3955b1c440;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 7412f0d..46f2ba2 100644
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -56,9 +56,10 @@ import PrelNames	( hasKey, buildIdKey, augmentIdKey )
 import Bag
 import FastTypes
 import Outputable
+import Util
 
 #if __GLASGOW_HASKELL__ >= 404
-import GlaExts		( fromInt, Int# )
+import GLAEXTS		( Int# )
 #endif
 \end{code}
 
@@ -297,7 +298,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
       | fun `hasKey` augmentIdKey = augmentSize
       | otherwise 
       = case globalIdDetails fun of
-	  DataConId dc -> conSizeN dc (valArgCount args)
+	  DataConWorkId dc -> conSizeN dc (valArgCount args)
 
 	  FCallId fc   -> sizeN opt_UF_DearOp
 	  PrimOpId op  -> primOpSize op (valArgCount args)
@@ -353,6 +354,11 @@ data ExprSize = TooBig
 		       FastInt		-- Size to subtract if result is scrutinised 
 					-- by a case expression
 
+-- subtract the discount before deciding whether to bale out. eg. we
+-- want to inline a large constructor application into a selector:
+--  	tup = (a_1, ..., a_99)
+--  	x = case tup of ...
+--
 mkSizeIs max n xs d | (n -# d) ># max = TooBig
 		    | otherwise	      = SizeIs n xs d
  
@@ -453,16 +459,12 @@ couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold
 						UnfoldNever -> False
 						other	    -> True
 
-certainlyWillInline :: Id -> Bool
-	-- Sees if the Id is pretty certain to inline	
-certainlyWillInline v
-  = case idUnfolding v of
-
-	CoreUnfolding _ _ _ is_cheap g@(UnfoldIfGoodArgs n_vals _ size _)
-	   ->    is_cheap
-	      && size - (n_vals +1) <= opt_UF_UseThreshold
-
-	other -> False
+certainlyWillInline :: Unfolding -> Bool
+  -- Sees if the unfolding is pretty certain to inline	
+certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
+  = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
+certainlyWillInline other
+  = False
 \end{code}
 
 @okToUnfoldInHifile@ is used when emitting unfolding info into an interface
@@ -577,6 +579,11 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con
 		-- then if the context is totally uninteresting (not applied, not scrutinised)
 		-- there is no point in substituting because it might just increase allocation,
 		-- by allocating the function itself many times
+		-- Note [Jan 2002]: this comment looks out of date.  The actual code
+		-- doesn't inline *ever* in an uninteresting context.  Why not?  I
+		-- think it's just because we don't want to inline top-level constants
+		-- into uninteresting contexts, lest we (for example) re-nest top-level
+		-- literal lists.
 		--
 		-- Note: there used to be a '&& not top_level' in the guard above,
 		--	 but that stopped us inlining top-level functions used only once,
@@ -585,7 +592,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con
 			-- If (not in_lam) && one_br then PreInlineUnconditionally
 			-- should have caught it, shouldn't it?  Unless it's a top
 			-- level thing.
-	    not (null arg_infos) || interesting_cont
+	    notNull arg_infos || interesting_cont
 
 	  | otherwise
 	  = case guidance of
@@ -663,7 +670,7 @@ computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used
 			-- Discount of 1 for each arg supplied, because the 
 			-- result replaces the call
     round (opt_UF_KeenessFactor * 
-	   fromInt (arg_discount + result_discount))
+	   fromIntegral (arg_discount + result_discount))
   where
     arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)