[commit: ghc] master: Make let and app consistent in exprIsCheapX (8d8d094)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8d8d094d45fc638e3fac332fbce8138a1c06b9c3/ghc

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

commit 8d8d094d45fc638e3fac332fbce8138a1c06b9c3
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Apr 11 15:39:09 2017 +0100

    Make let and app consistent in exprIsCheapX
    
    This fixes Trac #13558, by making App and Let behave
    consistently; see Note [Arguments and let-bindings exprIsCheapX]
    
    I renamed the mysterious exprIsOk to exprIsCheapX.  (The "X"
    is because it is parameterised over a CheapAppFun.)


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

8d8d094d45fc638e3fac332fbce8138a1c06b9c3
 compiler/coreSyn/CoreArity.hs |  4 ++--
 compiler/coreSyn/CoreUtils.hs | 48 +++++++++++++++++++++++++++----------------
 2 files changed, 32 insertions(+), 20 deletions(-)

diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index dd70772..3cf4743 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -512,9 +512,9 @@ getBotArity _        = Nothing
 mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun
 mk_cheap_fn dflags cheap_app
   | not (gopt Opt_DictsCheap dflags)
-  = \e _     -> exprIsOk cheap_app e
+  = \e _     -> exprIsCheapX cheap_app e
   | otherwise
-  = \e mb_ty -> exprIsOk cheap_app e
+  = \e mb_ty -> exprIsCheapX cheap_app e
              || case mb_ty of
                   Nothing -> False
                   Just ty -> isDictLikeTy ty
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index a319a7c..cc2d172 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -25,7 +25,7 @@ module CoreUtils (
         exprType, coreAltType, coreAltsType, isExprLevPoly,
         exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom,
         getIdFromTrivialExpr_maybe,
-        exprIsCheap, exprIsExpandable, exprIsOk, CheapAppFun,
+        exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
         exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,
         exprIsBig, exprIsConLike,
         rhsIsStatic, isCheapApp, isExpandableApp,
@@ -1095,31 +1095,43 @@ duplicate the (a +# b) primop, which we should not do lightly.
 (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.)
 
 
-Note [Arguments in exprIsOk]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-What predicate should we apply to the argument of an application?  We
-used to say "exprIsTrivial arg" due to concerns about duplicating
-nested constructor applications, but see #4978.  The principle here is
+Note [Arguments and let-bindings exprIsCheapX]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+What predicate should we apply to the argument of an application, or the
+RHS of a let-binding?
+
+We used to say "exprIsTrivial arg" due to concerns about duplicating
+nested constructor applications, but see #4978.  So now we just recursively
+use exprIsCheapX.
+
+We definitely want to treat let and app the same.  The principle here is
 that
-   let x = a +# b in c *# x
+   let x = blah in f x
 should behave equivalently to
-   c *# (a +# b)
-Since lets with cheap RHSs are accepted, so should paps with cheap arguments
+   f blah
+
+This in turn means that the 'letrec g' does not prevent eta expansion
+in this (which it previously was):
+    f = \x. let v = case x of
+                      True -> letrec g = \w. blah
+                              in g
+                      False -> \x. x
+            in \w. v True
 -}
 
 --------------------
 exprIsCheap :: CoreExpr -> Bool
-exprIsCheap = exprIsOk isCheapApp
+exprIsCheap = exprIsCheapX isCheapApp
 
 exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable]
-exprIsExpandable = exprIsOk isExpandableApp
+exprIsExpandable = exprIsCheapX isExpandableApp
 
 exprIsWorkFree :: CoreExpr -> Bool   -- See Note [exprIsWorkFree]
-exprIsWorkFree = exprIsOk isWorkFreeApp
+exprIsWorkFree = exprIsCheapX isWorkFreeApp
 
 --------------------
-exprIsOk :: CheapAppFun -> CoreExpr -> Bool
-exprIsOk ok_app e
+exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool
+exprIsCheapX ok_app e
   = ok e
   where
     ok e = go 0 e
@@ -1138,11 +1150,11 @@ exprIsOk ok_app e
                     | otherwise       = go n e
     go n (App f e)  | isRuntimeArg e  = go (n+1) f && ok e
                     | otherwise       = go n f
-    go _ (Let {})                     = False
+    go n (Let (NonRec _ r) e)         = go n e && ok r
+    go n (Let (Rec prs) e)            = go n e && all (ok . snd) prs
 
       -- Case: see Note [Case expressions are work-free]
-      -- App:  see Note [Arguments in exprIsOk]
-      -- Let:  the old exprIsCheap worked through lets
+      -- App, Let: see Note [Arguments and let-bindings exprIsCheapX]
 
 
 -------------------------------------
@@ -1157,7 +1169,7 @@ type CheapAppFun = Id -> Arity -> Bool
 
   -- NB: isCheapApp and isExpandableApp are called from outside
   --     this module, so don't be tempted to move the notRedex
-  --     stuff into the call site in exprIsOk, and remove it
+  --     stuff into the call site in exprIsCheapX, and remove it
   --     from the CheapAppFun implementations