Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/02ac2974ce8e537372bff8d9e0a6efb461ed2c59 >--------------------------------------------------------------- commit 02ac2974ce8e537372bff8d9e0a6efb461ed2c59 Author: Simon Peyton Jones <[email protected]> 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. >--------------------------------------------------------------- compiler/simplCore/SimplUtils.lhs | 19 ++++++++++--------- 1 files changed, 10 insertions(+), 9 deletions(-) diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 6a0820c..f38b720 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -43,7 +43,7 @@ import StaticFlags import CoreSyn import qualified CoreSubst import PprCore -import DataCon ( dataConCannotMatch ) +import DataCon ( dataConCannotMatch, dataConWorkId ) import CoreFVs import CoreUtils import CoreArity @@ -1747,14 +1747,15 @@ mkCase1 _dflags scrut case_bndr alts -- Identity case = do { tick (CaseIdentity case_bndr) ; return (re_cast scrut rhs1) } where - identity_alt (con, args, rhs) = check_eq con args rhs - - check_eq con args (Cast e co) | not (any (`elemVarSet` tyCoVarsOfCo co) args) - {- See Note [RHS casts] -} = check_eq con args e - check_eq _ _ (Var v) = v == case_bndr - check_eq (LitAlt lit') _ (Lit lit) = lit == lit' - check_eq (DataAlt con) args rhs = rhs `cheapEqExpr` mkConApp con (arg_tys ++ varsToCoreExprs args) - check_eq _ _ _ = False + identity_alt (con, args, rhs) = check_eq rhs con args + + check_eq (Cast rhs co) con args = not (any (`elemVarSet` tyCoVarsOfCo co) args) + {- See Note [RHS casts] -} && check_eq rhs con 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 -- Optimisation only + check_eq rhs (DataAlt con) args = rhs `cheapEqExpr` mkConApp con (arg_tys ++ varsToCoreExprs args) + check_eq _ _ _ = False arg_tys = map Type (tyConAppArgs (idType case_bndr)) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
