Commit 8d8d094d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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.)
parent ebb36b2c
......@@ -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
......@@ -25,7 +25,7 @@ module CoreUtils (
exprType, coreAltType, coreAltsType, isExprLevPoly,
exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom,
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
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
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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment