[commit: ghc] wip/nested-cpr: Do not generate workers with one element (# .. #) types (f559a15)

[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/f559a1593c89117140d4806383c3c27fcfa3c481/ghc

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

commit f559a1593c89117140d4806383c3c27fcfa3c481
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Nov 28 16:06:18 2013 +0000

    Do not generate workers with one element (# .. #) types


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

f559a1593c89117140d4806383c3c27fcfa3c481
 compiler/stranal/WwLib.lhs |   28 ++++++++++++++++++----------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index b6b99e8..0b819dc 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -536,16 +536,24 @@ mkWWcpr :: Type                              -- function body type
                    Type)                        -- Type of worker's body
 mkWWcpr body_ty res
   = do (arg_vars, con_app, decon) <- mkWWcpr_help False body_ty res
-       wrap_wild_uniq <- getUniqueM
-
-       let wrap_wild = mk_ww_local wrap_wild_uniq ubx_tup_ty
-           ubx_tup_con  = tupleCon UnboxedTuple (length arg_vars)
-           ubx_tup_app  = mkConApp2 ubx_tup_con (map idType arg_vars) arg_vars
-           ubx_tup_ty   = exprType ubx_tup_app
-
-       return ( \ wkr_call -> Case wkr_call wrap_wild (exprType con_app)  [(DataAlt ubx_tup_con, arg_vars, con_app)]
-              , \ body     -> decon body ubx_tup_app
-              , ubx_tup_ty )
+       case arg_vars of
+         -- When we have to wrap only on argument, skip the (# .. #)
+         [arg_var] -> do
+           return ( \ wkr_call -> mkRename wkr_call arg_var con_app
+                  , \ body     -> decon body (Var arg_var)
+                  , idType arg_var )
+
+         _ -> do
+           wrap_wild_uniq <- getUniqueM
+
+           let wrap_wild = mk_ww_local wrap_wild_uniq ubx_tup_ty
+               ubx_tup_con  = tupleCon UnboxedTuple (length arg_vars)
+               ubx_tup_app  = mkConApp2 ubx_tup_con (map idType arg_vars) arg_vars
+               ubx_tup_ty   = exprType ubx_tup_app
+
+           return ( \ wkr_call -> Case wkr_call wrap_wild (exprType con_app)  [(DataAlt ubx_tup_con, arg_vars, con_app)]
+                  , \ body     -> decon body ubx_tup_app
+                  , ubx_tup_ty )
 
 mkWWcpr_help :: Bool ->  -- This this an inner call?
                 Type ->