diff options
Diffstat (limited to 'compiler/GHC/Core/Utils.hs')
| -rw-r--r-- | compiler/GHC/Core/Utils.hs | 33 |
1 files changed, 29 insertions, 4 deletions
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index a67955ad2b..fcffaa553a 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -40,8 +40,8 @@ module GHC.Core.Utils ( cheapEqExpr, cheapEqExpr', eqExpr, diffExpr, diffBinds, - -- * Eta reduction - tryEtaReduce, + -- * Lambdas and eta reduction + tryEtaReduce, zapLamBndrs, -- * Manipulating data constructors and types exprToType, exprToCoercion_maybe, @@ -99,7 +99,7 @@ import GHC.Utils.Panic import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.List.SetOps( minusList ) -import GHC.Types.Basic ( Arity ) +import GHC.Types.Basic ( Arity, FullArgCount ) import GHC.Utils.Misc import GHC.Data.Pair import Data.ByteString ( ByteString ) @@ -2521,9 +2521,34 @@ to the rule that we can eta-reduce \x. f x ===> f This turned up in #7542. +-} +{- ********************************************************************* +* * + Zapping lambda binders +* * +********************************************************************* -} -************************************************************************ +zapLamBndrs :: FullArgCount -> [Var] -> [Var] +-- If (\xyz. t) appears under-applied to only two arguments, +-- we must zap the occ-info on x,y, because they appear under the \x +-- See Note [Occurrence analysis for lambda binders] in GHc.Core.Opt.OccurAnal +-- +-- NB: both `arg_count` and `bndrs` include both type and value args/bndrs +zapLamBndrs arg_count bndrs + | no_need_to_zap = bndrs + | otherwise = zap_em arg_count bndrs + where + no_need_to_zap = all isOneShotBndr (drop arg_count bndrs) + + zap_em :: FullArgCount -> [Var] -> [Var] + zap_em 0 bs = bs + zap_em _ [] = [] + zap_em n (b:bs) | isTyVar b = b : zap_em (n-1) bs + | otherwise = zapLamIdInfo b : zap_em (n-1) bs + + +{- ********************************************************************* * * \subsection{Determining non-updatable right-hand-sides} * * |