Worker/wrapper should make INLINE if it doesn't w/w

[ghc-hetmet.git] / compiler / stranal / WorkWrap.lhs

diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index 30754e5..772a862 100644 (file)
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -6,14 +6,12 @@
 \begin{code}
 module WorkWrap ( wwTopBinds, mkWrapper ) where
 
-#include "HsVersions.h"
-
 import CoreSyn
 import CoreUnfold      ( certainlyWillInline )
-import CoreUtils       ( exprType, exprIsHNF )
+import CoreUtils       ( exprType, exprIsHNF, mkInlineMe )
 import CoreArity       ( exprArity )
 import Var
-import Id              ( Id, idType, isOneShotLambda, 
+import Id              ( Id, idType, isOneShotLambda, idUnfolding,
                          setIdNewStrictness, mkWorkerId,
                          setIdWorkerInfo, setInlineActivation,
                          setIdArity, idInfo )
@@ -33,6 +31,8 @@ import WwLib
 import Util            ( lengthIs, notNull )
 import Outputable
 import MonadUtils
+
+#include "HsVersions.h"
 \end{code}
 
 We take Core bindings whose binders have:
@@ -162,7 +162,7 @@ reason), then we don't w-w it.
 
 The only reason this is monadised is for the unique supply.
 
-Note [Don't w/w inline things]
+Note [Don't w/w inline things (a)]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 It's very important to refrain from w/w-ing an INLINE function
 If we do so by mistake we transform
@@ -183,6 +183,21 @@ Notice that we refrain from w/w'ing an INLINE function even if it is
 in a recursive group.  It might not be the loop breaker.  (We could
 test for loop-breaker-hood, but I'm not sure that ever matters.)
 
+Note [Don't w/w inline things (b)]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In general, therefore, we refrain from w/w-ing *small* functions,
+because they'll inline anyway.  But we must take care: it may look
+small now, but get to be big later after other inling has happened.
+So we take the precaution of adding an INLINE pragma to any such
+functions.  
+
+I made this change when I observed a big function at the end of
+compilation with a useful strictness signature but no w-w.  When 
+I measured it on nofib, it didn't make much difference; just a few
+percent improved allocation on one benchmark (bspt/Euclid.space).  
+But nothing got worse.
+
+
 \begin{code}
 tryWW  :: RecFlag
        -> Id                           -- The fn binder
@@ -194,21 +209,22 @@ tryWW     :: RecFlag
                                        -- if two, then a worker and a
                                        -- wrapper.
 tryWW is_rec fn_id rhs
-  |  -- isNonRec is_rec &&     -- Now omitted: see Note [Don't w/w inline things]
-     certainlyWillInline unfolding
-
-  || isNeverActive inline_act
+  | isNeverActive inline_act
        -- No point in worker/wrappering if the thing is never inlined!
        -- Because the no-inline prag will prevent the wrapper ever
        -- being inlined at a call site. 
-  = return [ (new_fn_id, rhs) ]
+       -- 
+       -- Furthermore, don't even expose strictness info
+  = return [ (fn_id, rhs) ]
 
   | is_thunk && worthSplittingThunk maybe_fn_dmd res_info
   = ASSERT2( isNonRec is_rec, ppr new_fn_id )  -- The thunk must be non-recursive
+    checkSize new_fn_id rhs $ 
     splitThunk new_fn_id rhs
 
   | is_fun && worthSplittingFun wrap_dmds res_info
-  = splitFun new_fn_id fn_info wrap_dmds res_info inline_act rhs
+  = checkSize new_fn_id rhs $
+    splitFun new_fn_id fn_info wrap_dmds res_info inline_act rhs
 
   | otherwise
   = return [ (new_fn_id, rhs) ]
@@ -216,7 +232,6 @@ tryWW is_rec fn_id rhs
   where
     fn_info     = idInfo fn_id
     maybe_fn_dmd = newDemandInfo fn_info
-    unfolding   = unfoldingInfo fn_info
     inline_act   = inlinePragmaActivation (inlinePragInfo fn_info)
 
        -- In practice it always will have a strictness 
@@ -237,6 +252,16 @@ tryWW is_rec fn_id rhs
     is_thunk  = not is_fun && not (exprIsHNF rhs)
 
 ---------------------
+checkSize :: Id -> CoreExpr -> UniqSM [(Id,CoreExpr)] -> UniqSM [(Id,CoreExpr)]
+ -- See Note [Don't w/w inline things (a) and (b)]
+checkSize fn_id rhs thing_inside
+  | certainlyWillInline unfolding = return [ (fn_id, mkInlineMe rhs) ]
+               -- Note [Don't w/w inline things (b)]
+  | otherwise = thing_inside
+  where
+    unfolding = idUnfolding fn_id
+
+---------------------
 splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Activation -> Expr Var
          -> UniqSM [(Id, CoreExpr)]
 splitFun fn_id fn_info wrap_dmds res_info inline_act rhs