X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUnfold.lhs;h=c443c10e4b4cd1efb411a91930e373f958f1c7ea;hb=435c5194b6047510d20a3d0c459c9b49e18da154;hp=fc31d5a22a9b88cd6954037ab4d268968fc9eef1;hpb=b8ee6f14ca6e9e49015ee9b404cf8b8191fede05;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index fc31d5a..c443c10 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -43,6 +43,7 @@ import PprCore		()	-- Instances
 import OccurAnal
 import CoreSubst hiding( substTy )
 import CoreFVs         ( exprFreeVars )
+import CoreArity       ( manifestArity )
 import CoreUtils
 import Id
 import DataCon
@@ -140,13 +141,17 @@ mkCompulsoryUnfolding expr	   -- Used for things that absolutely must be unfolde
                     expr 0    -- Arity of unfolding doesn't matter
                     (UnfWhen unSaturatedOk boringCxtOk)
 
-mkInlineRule :: Bool -> CoreExpr -> Arity -> Unfolding
-mkInlineRule unsat_ok expr arity 
+mkInlineRule :: CoreExpr -> Maybe Arity -> Unfolding
+mkInlineRule expr mb_arity 
   = mkCoreUnfolding True InlineRule 	 -- Note [Top-level flag on inline rules]
     		    expr' arity 
 		    (UnfWhen unsat_ok boring_ok)
   where
     expr' = simpleOptExpr expr
+    (unsat_ok, arity) = case mb_arity of
+                          Nothing -> (unSaturatedOk, manifestArity expr')
+                          Just ar -> (needSaturated, ar)
+              
     boring_ok = case calcUnfoldingGuidance True    -- Treat as cheap
     	      	     			   False   -- But not bottoming
                                            (arity+1) expr' of
@@ -184,7 +189,6 @@ calcUnfoldingGuidance expr_is_cheap top_bot bOMB_OUT_SIZE expr
       	        | uncondInline n_val_bndrs (iBox size)
                 , expr_is_cheap
       	        -> UnfWhen unSaturatedOk boringCxtOk   -- Note [INLINE for small functions]
-
 		| top_bot  -- See Note [Do not inline top-level bottoming functions]
 		-> UnfNever
 
@@ -473,21 +477,44 @@ funSize top_args fun n_val_args
 
 conSize :: DataCon -> Int -> ExprSize
 conSize dc n_val_args
-  | n_val_args == 0      = SizeIs (_ILIT(0)) emptyBag (_ILIT(1))	-- Like variables
+  | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(1))	-- Like variables
+
+-- See Note [Constructor size]
   | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox n_val_args +# _ILIT(1))
-  | otherwise		 = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1))
-	-- Treat a constructors application as size 1, regardless of how
-	-- many arguments it has; we are keen to expose them
-	-- (and we charge separately for their args).  We can't treat
-	-- them as size zero, else we find that (Just x) has size 0,
-	-- which is the same as a lone variable; and hence 'v' will 
-	-- always be replaced by (Just x), where v is bound to Just x.
-	--
-	-- However, unboxed tuples count as size zero
-	-- I found occasions where we had 
-	--	f x y z = case op# x y z of { s -> (# s, () #) }
-	-- and f wasn't getting inlined
 
+-- See Note [Unboxed tuple result discount]
+--  | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (_ILIT(0))
+
+-- See Note [Constructor size]
+  | otherwise = SizeIs (_ILIT(1)) emptyBag (iUnbox n_val_args +# _ILIT(1))
+\end{code}
+
+Note [Constructor size]
+~~~~~~~~~~~~~~~~~~~~~~~
+Treat a constructors application as size 1, regardless of how many
+arguments it has; we are keen to expose them (and we charge separately
+for their args).  We can't treat them as size zero, else we find that
+(Just x) has size 0, which is the same as a lone variable; and hence
+'v' will always be replaced by (Just x), where v is bound to Just x.
+
+However, unboxed tuples count as size zero. I found occasions where we had 
+	f x y z = case op# x y z of { s -> (# s, () #) }
+and f wasn't getting inlined.
+
+Note [Unboxed tuple result discount]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+I tried giving unboxed tuples a *result discount* of zero (see the
+commented-out line).  Why?  When returned as a result they do not
+allocate, so maybe we don't want to charge so much for them If you
+have a non-zero discount here, we find that workers often get inlined
+back into wrappers, because it look like
+    f x = case $wf x of (# a,b #) -> (a,b)
+and we are keener because of the case.  However while this change
+shrank binary sizes by 0.5% it also made spectral/boyer allocate 5%
+more. All other changes were very small. So it's not a big deal but I
+didn't adopt the idea.
+
+\begin{code}
 primOpSize :: PrimOp -> Int -> ExprSize
 primOpSize op n_val_args
  | not (primOpIsDupable op) = sizeN opt_UF_DearOp
@@ -626,9 +653,11 @@ actual arguments.
 \begin{code}
 couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
 couldBeSmallEnoughToInline threshold rhs 
-  = case calcUnfoldingGuidance False False threshold rhs of
-       (_, UnfNever) -> False
-       _             -> True
+  = case sizeExpr (iUnbox threshold) [] body of
+       TooBig -> False
+       _      -> True
+  where
+    (_, body) = collectBinders rhs
 
 ----------------
 smallEnoughToInline :: Unfolding -> Bool