[commit: ghc] master: Fix worker/wrapper for CPR functions (b8ff444)

[Simon Peyton Jones]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b8ff4448d899f783fc112f3774aab626979a4f22

>---------------------------------------------------------------

commit b8ff4448d899f783fc112f3774aab626979a4f22
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Apr 13 17:38:32 2012 +0100

    Fix worker/wrapper for CPR functions
    
    A long-standing and egregious bug in the worker/wrapper code meant
    that some functions with the CPR property weren't getting a CPR
    w/w. And that had the effect of making a tail-recursive function not
    tail recursive.  As well as increasing allocation.
    
    Fixes Trac #5920, and #5997.
    
    Nofib results (highlights):
    
            Program           Size    Allocs   Runtime   Elapsed  TotalMem
    --------------------------------------------------------------------------------
             boyer2          -0.1%    -15.3%      0.01      0.01     +0.0%
            mandel2          -0.0%     -8.1%      0.01      0.01     +0.0%
               para          -0.1%    -11.8%     -7.9%     -7.8%     +0.0%
    --------------------------------------------------------------------------------
                Min          -0.1%    -15.3%     -7.9%     -7.8%    -33.3%
                Max          +0.0%     +0.2%     +6.3%     +6.3%     +3.7%
     Geometric Mean          -0.0%     -0.4%     +0.1%     +0.1%     -0.5%
    
    Looks like a clear win.  And I have not even recompiled the libraries, so
    it'll probably be a bit better in the ed.

>---------------------------------------------------------------

 compiler/stranal/DmdAnal.lhs |   13 ++++++-------
 compiler/stranal/WwLib.lhs   |   25 ++++++++++++++++---------
 2 files changed, 22 insertions(+), 16 deletions(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 0bfd025..167debf 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -592,7 +592,7 @@ mkSigTy top_lvl rec_flag id rhs dmd_ty
     maybe_id_dmd = idDemandInfo_maybe id
 	-- Is Nothing the first time round
 
-    thunk_cpr_ok
+    thunk_cpr_ok   -- See Note [CPR for thunks]
 	| isTopLevel top_lvl       = False	-- Top level things don't get
 						-- their demandInfo set at all
 	| isRec rec_flag	   = False	-- Ditto recursive things
@@ -601,8 +601,8 @@ mkSigTy top_lvl rec_flag id rhs dmd_ty
 						-- See notes below
 \end{code}
 
-The thunk_cpr_ok stuff [CPR-AND-STRICTNESS]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [CPR for thunks]
+~~~~~~~~~~~~~~~~~~~~~
 If the rhs is a thunk, we usually forget the CPR info, because
 it is presumably shared (else it would have been inlined, and 
 so we'd lose sharing if w/w'd it into a function).  E.g.
@@ -662,8 +662,8 @@ have a CPR in it or not.  Simple solution:
 
 NB: strictly_demanded is never true of a top-level Id, or of a recursive Id.
 
-The Nothing case in thunk_cpr_ok [CPR-AND-STRICTNESS]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Optimistic in the Nothing case]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Demand info now has a 'Nothing' state, just like strictness info.
 The analysis works from 'dangerous' towards a 'safe' state; so we 
 start with botSig for 'Nothing' strictness infos, and we start with
@@ -1010,8 +1010,7 @@ extendSigsWithLam :: AnalEnv -> Id -> AnalEnv
 extendSigsWithLam env id
   = case idDemandInfo_maybe id of
 	Nothing	             -> extendAnalEnv NotTopLevel env id cprSig
-		-- Optimistic in the Nothing case;
-		-- See notes [CPR-AND-STRICTNESS]
+		-- See Note [Optimistic in the Nothing case]
 	Just (Eval (Prod _)) -> extendAnalEnv NotTopLevel env id cprSig
 	_                    -> env
 \end{code}
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 4b18b8b..5a82b8a 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -133,15 +133,10 @@ mkWwBodies fun_ty demands res_info one_shots
 	; (wrap_args, wrap_fn_args, work_fn_args, res_ty) <- mkWWargs emptyTvSubst fun_ty arg_info
 	; (work_args, wrap_fn_str,  work_fn_str) <- mkWWstr wrap_args
 
-        -- Don't do CPR if the worker doesn't have any value arguments
-        -- Then the worker is just a constant, so we don't want to unbox it.
-	; (wrap_fn_cpr, work_fn_cpr,  _cpr_res_ty)
-	       <- if any isId work_args then
-	             mkWWcpr res_ty res_info
-	          else
-	             return (id, id, res_ty)
-
-	; let (work_lam_args, work_call_args) = mkWorkerArgs work_args res_ty
+        -- Do CPR w/w.  See Note [Always do CPR w/w]
+	; (wrap_fn_cpr, work_fn_cpr,  cpr_res_ty) <- mkWWcpr res_ty res_info
+
+	; let (work_lam_args, work_call_args) = mkWorkerArgs work_args cpr_res_ty
 	; return ([idDemandInfo v | v <- work_call_args, isId v],
                   wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
                   mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args) }
@@ -154,6 +149,18 @@ mkWwBodies fun_ty demands res_info one_shots
         -- fw from being inlined into f's RHS
 \end{code}
 
+Note [Always do CPR w/w]
+~~~~~~~~~~~~~~~~~~~~~~~~
+At one time we refrained from doing CPR w/w for thunks, on the grounds that
+we might duplicate work.  But that is already handled by the demand analyser,
+which doesn't give the CPR proprety if w/w might waste work: see
+Note [CPR for thunks] in DmdAnal.    
+
+And if something *has* been given the CPR property and we don't w/w, it's
+a disaster, because then the enclosing function might say it has the CPR
+property, but now doesn't and there a cascade of disaster.  A good example
+is Trac #5920.
+
 
 %************************************************************************
 %*									*