X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=eaeba103c73ae8f3b59493887329bc5ca55d992b;hp=496d7a07e73b69c29b708ece5e46616a2e0e6563;hb=4bc25e8c30559b7a6a87b39afcc79340ae778788;hpb=bd78c94a3b41f8d2097efc0415fa26e0cd1140ef

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index 496d7a0..eaeba10 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -22,7 +22,7 @@ module CoreUnfold (
 	mkCompulsoryUnfolding, seqUnfolding,
 	evaldUnfolding, mkOtherCon, otherCons,
 	unfoldingTemplate, maybeUnfoldingTemplate,
-	isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
+	isEvaldUnfolding, isValueUnfolding, isExpandableUnfolding, isCompulsoryUnfolding,
 	hasUnfolding, hasSomeUnfolding, neverUnfold,
 
 	couldBeSmallEnoughToInline, 
@@ -71,7 +71,8 @@ mkImplicitUnfolding expr
   = CoreUnfolding (simpleOptExpr emptySubst expr)
 		  True
 		  (exprIsHNF expr)
-		  (exprIsCheap expr)
+                  (exprIsCheap expr)
+                  (exprIsExpandable expr)
 		  (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
 
 mkUnfolding :: Bool -> CoreExpr -> Unfolding
@@ -85,6 +86,8 @@ mkUnfolding top_lvl expr
 		  (exprIsCheap expr)
 			-- OK to inline inside a lambda
 
+                  (exprIsExpandable expr)
+
 		  (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
 	-- Sometimes during simplification, there's a large let-bound thing	
 	-- which has been substituted, and so is now dead; so 'expr' contains
@@ -99,8 +102,8 @@ 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 (CoreUnfolding e top hnf cheap g) 
-	= ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr g, 
+  ppr (CoreUnfolding e top hnf cheap expable g) 
+	= ptext (sLit "Unf") <+> sep [ppr top <+> ppr hnf <+> ppr cheap <+> ppr expable <+> ppr g, 
 				     ppr e]
 
 mkCompulsoryUnfolding :: CoreExpr -> Unfolding
@@ -484,13 +487,13 @@ couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold
 
 certainlyWillInline :: Unfolding -> Bool
   -- Sees if the unfolding is pretty certain to inline	
-certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
+certainlyWillInline (CoreUnfolding _ _ _ is_cheap _ (UnfoldIfGoodArgs n_vals _ size _))
   = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
 certainlyWillInline _
   = False
 
 smallEnoughToInline :: Unfolding -> Bool
-smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
+smallEnoughToInline (CoreUnfolding _ _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
   = size <= opt_UF_UseThreshold
 smallEnoughToInline _
   = False
@@ -561,7 +564,7 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 		-- compulsory unfoldings (see MkId.lhs).
 		-- We don't allow them to be inactive
 
-	CoreUnfolding unf_template is_top is_value is_cheap guidance ->
+	CoreUnfolding unf_template is_top is_value is_cheap is_expable guidance ->
 
     let
 	result | yes_or_no = Just unf_template
@@ -639,7 +642,8 @@ callSiteInline dflags active_inline id lone_variable arg_infos cont_info
 			text "arg infos" <+> ppr arg_infos,
 			text "interesting continuation" <+> ppr cont_info,
 			text "is value:" <+> ppr is_value,
-			text "is cheap:" <+> ppr is_cheap,
+                        text "is cheap:" <+> ppr is_cheap,
+			text "is expandable:" <+> ppr is_expable,
 			text "guidance" <+> ppr guidance,
 			text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
 		  result