Commit 82b40598 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix CaseIdentity optimisation AGAIN

In this commit
    commit 02ac2974
    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.
parent 50512c6b
......@@ -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]
-- ~~~~~~~~~~~~~~~~
......
module T13417 where
-- Amazingly this crashed GHC 8.0.2
data T a = E7
cons7 :: T a -> T b
cons7 E7 = E7
......@@ -250,3 +250,4 @@ test('T13317',
test('T13340', normal, run_command, ['$MAKE -s --no-print-directory T13340'])
test('T13338', only_ways(['optasm']), compile, ['-dcore-lint'])
test('T13367', normal, run_command, ['$MAKE -s --no-print-directory T13367'])
test('T13417', normal, compile, ['-O'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment