summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2017-04-11 15:39:09 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2017-04-12 16:16:21 +0100
commit8d8d094d45fc638e3fac332fbce8138a1c06b9c3 (patch)
tree3f03bbbb7c9a187103ecd23f27749945193397fe
parentebb36b2c903abf20a955ea4e81f168b1ddf1a452 (diff)
downloadhaskell-8d8d094d45fc638e3fac332fbce8138a1c06b9c3.tar.gz
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.)
-rw-r--r--compiler/coreSyn/CoreArity.hs4
-rw-r--r--compiler/coreSyn/CoreUtils.hs48
2 files changed, 32 insertions, 20 deletions
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index dd70772835..3cf4743f56 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 a319a7c386..cc2d1724a5 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