diff options
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 18 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/T13417.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
3 files changed, 18 insertions, 9 deletions
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index a3eb3570c4..ab270c5a86 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1821,21 +1821,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] -- ~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/simplCore/should_compile/T13417.hs b/testsuite/tests/simplCore/should_compile/T13417.hs new file mode 100644 index 0000000000..a919291bb7 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13417.hs @@ -0,0 +1,8 @@ +module T13417 where + +-- Amazingly this crashed GHC 8.0.2 + +data T a = E7 + +cons7 :: T a -> T b +cons7 E7 = E7 diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index c276834547..38d43039a8 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -237,3 +237,4 @@ test('T12076', extra_clean(['T12076a.hi', 'T12076a.o']), multimod_compile, ['T12 test('T12076lit', normal, compile, ['-O']) test('T12076sat', normal, compile, ['-O']) test('par01', only_ways(['optasm']), compile, ['-ddump-prep -dsuppress-uniques -O2']) +test('T13417', normal, compile, ['-O']) |