[commit: ghc] wip/nested-cpr: Avoid CPR w/w for something that already returns an unboxed tuple (49d188b)

[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/49d188b7af36aebbbf54810b135f99a465e0a5c2/ghc

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

commit 49d188b7af36aebbbf54810b135f99a465e0a5c2
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Dec 4 18:39:16 2013 +0000

    Avoid CPR w/w for something that already returns an unboxed tuple


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

49d188b7af36aebbbf54810b135f99a465e0a5c2
 compiler/basicTypes/Demand.lhs |    1 -
 compiler/stranal/WwLib.lhs     |   14 ++++++++++++++
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 50ca43f..9688cdd 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -779,7 +779,6 @@ seqCPRResult :: CPRResult -> ()
 seqCPRResult NoCPR         = ()
 seqCPRResult (RetCon n rs) = n `seq` seqListWith seqDmdResult rs
 
-
 ------------------------------------------------------------------------
 -- Combined demand result                                             --
 ------------------------------------------------------------------------
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 8eeac2a..ba56060 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -542,6 +542,7 @@ mkWWcpr body_ty res
                   , \ body     -> decon body (Var arg_var)
                   , idType arg_var )
 
+         _ | isWWUseless body_ty res -> return (id, id, body_ty)
          _ -> do
            wrap_wild_uniq <- getUniqueM
 
@@ -593,6 +594,19 @@ mkWWcpr_help inner ty res
                   , \e body -> mkRename e var body
                   )
 
+-- If something is known to return (# t1, t2 #), this is a CPR property. But it would
+-- be useless to then add a wrapper that unwraps that unboxed tuple and recreates it.
+-- So try to detect that situation here.
+isWWUseless ::  Type -> DmdResult -> Bool
+isWWUseless ty res
+    | Just (con_tag, rs) <- returnsCPR_maybe False res
+    , all isTopRes rs
+    , Just (data_con, _, _, _) <- deepSplitCprType_maybe con_tag ty
+    , isUnboxedTupleCon data_con
+    = True
+    | otherwise
+    = False
+
 -- mkRename e v body
 -- binds v to e in body. This will later be removed by the simplifiers
 mkRename :: CoreExpr -> Var -> CoreExpr -> CoreExpr