[commit: ghc] wip/nested-cpr: Try hard to avoid useless w/w for (# .. #)-returning things (52356ac)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nested-cpr
Link       : http://ghc.haskell.org/trac/ghc/changeset/52356ac0a367b3111bced98eeae50c5d277019b8/ghc

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

commit 52356ac0a367b3111bced98eeae50c5d277019b8
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Dec 5 08:54:00 2013 +0000

    Try hard to avoid useless w/w for (# .. #)-returning things


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

52356ac0a367b3111bced98eeae50c5d277019b8
 compiler/stranal/DmdAnal.lhs |    7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 633cf32..fa92cfd 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -518,7 +518,12 @@ dmdAnalVarApp env dmd fun args
   | Just con <- isDataConWorkId_maybe fun  -- Data constructor
   , isVanillaDataCon con
   , n_val_args == dataConRepArity con      -- Saturated
-  , let cpr_info = Converges (cprConRes (dataConTag con) arg_rets)
+  , let -- This removes nested CPR information from applications of (#...#)
+        -- TODO: This duplicates isWWUseless in WwLib; remove one of them
+        cpr_info | isUnboxedTupleCon con
+                 , all (not . isJust . returnsCPR_maybe True) arg_rets
+                 = topRes
+                 | otherwise             = Converges $ cprConRes (dataConTag con) arg_rets
         res_ty = foldl bothDmdType (DmdType emptyDmdEnv [] cpr_info) arg_tys
   = -- pprTrace "dmdAnalVarApp" (vcat [ ppr con, ppr args, ppr n_val_args, ppr cxt_ds
     --                                , ppr arg_tys, ppr cpr_info, ppr res_ty]) $