Fix CaseIdentity optimisation AGAIN

In this commit
    commit 02ac2974ce8e537372bff8d9e0a6efb461ed2c59
    Author: Simon Peyton Jones <simonpj@microsoft.com>
    Date:   Wed Nov 16 10:37:47 2011 +0000

    Fix CaseIdentity optimisaion

    In fixing one bug I'd introduced another;
       case x of { T -> T; F -> F }
    wasn't getting optmised!  Trivial to fix.

I introduced yet another!  This line of code in SimplUtils.mkCase1

    check_eq (Var v)    (DataAlt con) []   = v == dataConWorkId con
                                             -- Optimisation only

is patently false when arg_tys is non-empty.  Astonishing that it
has not shown up before now.

Easily fixed though.  This was all shown up by Trac #13417, which is
now fixed.

Merge to 8.0, 8.2.

1 files changed, 9 insertions, 9 deletions

diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 0fe262b2c7..49bb6c4991 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1886,21 +1886,21 @@ mkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _)      -- Identity case
     ticks = concatMap (stripTicksT tickishFloatable . thdOf3) (tail alts)
     identity_alt (con, args, rhs) = check_eq rhs con args
 
-    check_eq (Cast rhs co) con        args
+    check_eq (Cast rhs co) con args        -- See Note [RHS casts]
       = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args
-        -- See Note [RHS casts]
-    check_eq (Lit lit)  (LitAlt lit') _    = lit == lit'
+    check_eq (Tick t e) alt args
+      = tickishFloatable t && check_eq e alt args
+
+    check_eq (Lit lit) (LitAlt lit') _     = lit == lit'
     check_eq (Var v) _ _  | v == case_bndr = True
-    check_eq (Var v)    (DataAlt con) []   = v == dataConWorkId con
+    check_eq (Var v)   (DataAlt con) args
+      | null arg_tys, null args            = v == dataConWorkId con
                                              -- Optimisation only
-    check_eq (Tick t e) alt           args = tickishFloatable t &&
-                                             check_eq e alt args
     check_eq rhs        (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $
-                                             mkConApp con (arg_tys ++
-                                                           varsToCoreExprs args)
+                                             mkConApp2 con arg_tys args
     check_eq _          _             _    = False
 
-    arg_tys = map Type (tyConAppArgs (idType case_bndr))
+    arg_tys = tyConAppArgs (idType case_bndr)
 
         -- Note [RHS casts]
         -- ~~~~~~~~~~~~~~~~