[commit: ghc] wip/T14688: patch (30f275c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T14688
Link       : http://ghc.haskell.org/trac/ghc/changeset/30f275c3679d3f01d26c5d469931a0fb0b0c8541/ghc

>---------------------------------------------------------------

commit 30f275c3679d3f01d26c5d469931a0fb0b0c8541
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date:   Tue Jan 23 10:37:37 2018 +0000

    patch


>---------------------------------------------------------------

30f275c3679d3f01d26c5d469931a0fb0b0c8541
 compiler/coreSyn/CoreArity.hs  |  4 ++--
 compiler/coreSyn/CoreUnfold.hs |  4 ++--
 compiler/coreSyn/CoreUtils.hs  | 17 +++++++++--------
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 945cad6..538648d 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -514,9 +514,9 @@ getBotArity _        = Nothing
 mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun
 mk_cheap_fn dflags cheap_app
   | not (gopt Opt_DictsCheap dflags)
-  = \e _     -> exprIsCheapX cheap_app e
+  = \e _     -> exprIsCheapX True cheap_app e
   | otherwise
-  = \e mb_ty -> exprIsCheapX cheap_app e
+  = \e mb_ty -> exprIsCheapX True cheap_app e
              || case mb_ty of
                   Nothing -> False
                   Just ty -> isDictLikeTy ty
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index c459fd2..f30aca6 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -1241,8 +1241,8 @@ tryUnfolding dflags id lone_variable
           = True
           | otherwise
           = case cont_info of
-              CaseCtxt   -> not (lone_variable && is_wf)  -- Note [Lone variables]
-              ValAppCtxt -> True                              -- Note [Cast then apply]
+              CaseCtxt   -> not (lone_variable && is_exp)  -- Note [Lone variables]
+              ValAppCtxt -> True                           -- Note [Cast then apply]
               RuleArgCtxt -> uf_arity > 0  -- See Note [Unfold info lazy contexts]
               DiscArgCtxt -> uf_arity > 0  --
               RhsCtxt     -> uf_arity > 0  --
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 5e32dc6..c99e05f 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -1131,18 +1131,18 @@ in this (which it previously was):
 -}
 
 --------------------
+exprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]
+exprIsWorkFree = exprIsCheapX True isWorkFreeApp
+
 exprIsCheap :: CoreExpr -> Bool
-exprIsCheap = exprIsCheapX isCheapApp
+exprIsCheap = exprIsCheapX True isCheapApp
 
 exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable]
-exprIsExpandable = exprIsCheapX isExpandableApp
-
-exprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]
-exprIsWorkFree = exprIsCheapX isWorkFreeApp
+exprIsExpandable = exprIsCheapX False isExpandableApp
 
 --------------------
-exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
-exprIsCheapX ok_app e
+exprIsCheapX :: Bool -> CheapAppFun -> CoreExpr -> Bool
+exprIsCheapX ok_case ok_app e
   = ok e
   where
     ok e = go 0 e
@@ -1153,7 +1153,8 @@ exprIsCheapX ok_app e
     go _ (Type {})                    = True
     go _ (Coercion {})                = True
     go n (Cast e _)                   = go n e
-    go n (Case scrut _ _ alts)        = ok scrut &&
+    go n (Case scrut _ _ alts)        = ok_case &&
+                                        ok scrut &&
                                         and [ go n rhs | (_,_,rhs) <- alts ]
     go n (Tick t e) | tickishCounts t = False
                     | otherwise       = go n e