diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-03-14 13:52:48 +0000 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-03-14 10:09:05 -0400 |
| commit | d2d13a4f6750e30389552974bd7465712d522735 (patch) | |
| tree | 981f611c8b4d7c78b6845a9e8e49e06c0607b417 /compiler/simplCore/SimplUtils.hs | |
| parent | c873012bdc1f349cbee75cf514c0d3403d21a5bc (diff) | |
| download | haskell-ghc-8.0.tar.gz | |
Fix CaseIdentity optimisation AGAINghc-8.0
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.
(cherry picked from commit 82b40598ea7a9c00abdeae37bc47896f880fbbdc)
Diffstat (limited to 'compiler/simplCore/SimplUtils.hs')
| -rw-r--r-- | compiler/simplCore/SimplUtils.hs | 18 |
1 files changed, 9 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] -- ~~~~~~~~~~~~~~~~ |