#include "HsVersions.h"
import CmdLineOpts ( switchIsOn, SimplifierSwitch(..),
- opt_SimplDoLambdaEtaExpansion, opt_SimplCaseMerge, opt_DictsStrict
+ opt_SimplDoLambdaEtaExpansion, opt_SimplCaseMerge, opt_DictsStrict,
+ opt_UF_UpdateInPlace
)
import CoreSyn
-import CoreUnfold ( isValueUnfolding )
import CoreUtils ( exprIsTrivial, cheapEqExpr, exprType, exprIsCheap, exprEtaExpandArity, bindNonRec )
-import Subst ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, lookupIdSubst )
-import Id ( Id, idType, isId, idName,
- idOccInfo, idUnfolding, idStrictness,
+import Subst ( InScopeSet, mkSubst, substBndrs, substBndr, substIds, substExpr )
+import Id ( idType, idName,
+ idUnfolding, idStrictness,
mkId, idInfo
)
-import IdInfo ( StrictnessInfo(..), arityLowerBound, setOccInfo, vanillaIdInfo )
+import IdInfo ( StrictnessInfo(..), ArityInfo, atLeastArity, vanillaIdInfo )
import Maybes ( maybeToBool, catMaybes )
-import Name ( isLocalName, setNameUnique )
-import Demand ( Demand, isStrict, wwLazy, wwLazy )
+import Name ( setNameUnique )
+import Demand ( isStrict )
import SimplMonad
-import Type ( Type, tyVarsOfType, tyVarsOfTypes, mkForAllTys, seqType, repType,
- splitTyConApp_maybe, mkTyVarTys, applyTys, splitFunTys, mkFunTys,
- isDictTy, isDataType, applyTy, splitFunTy, isUnLiftedType,
+import Type ( Type, mkForAllTys, seqType, repType,
+ splitTyConApp_maybe, mkTyVarTys, splitFunTys,
+ isDictTy, isDataType, isUnLiftedType,
splitRepFunTys
)
import TyCon ( tyConDataConsIfAvailable )
import DataCon ( dataConRepArity )
-import VarSet
-import VarEnv ( SubstEnv, SubstResult(..) )
+import VarEnv ( SubstEnv )
import Util ( lengthExceeds )
-import BasicTypes ( Arity )
import Outputable
\end{code}
-- (i.e. they are probably lambda bound): f x y z
-- There is little point in inlining f here.
interestingArg in_scope arg subst
- = analyse arg
+ = analyse (substExpr (mkSubst in_scope subst) arg)
+ -- 'analyse' only looks at the top part of the result
+ -- and substExpr is lazy, so this isn't nearly as brutal
+ -- as it looks.
where
- analyse (Var v)
- = case lookupIdSubst (mkSubst in_scope subst) v of
- ContEx subst arg -> interestingArg in_scope arg subst
- DoneEx arg -> analyse arg
- DoneId v' _ -> hasSomeUnfolding (idUnfolding v')
+ analyse (Var v) = hasSomeUnfolding (idUnfolding v)
-- Was: isValueUnfolding (idUnfolding v')
-- But that seems over-pessimistic
-
- -- NB: it's too pessimistic to return False for ContEx/DoneEx
- -- Consider let x = 3 in f x
- -- The substitution will contain (x -> ContEx 3)
- -- It's also too optimistic to return True for the ContEx/DoneEx case
- -- Consider (\x. f x y) y
- -- The substitution will contain (x -> ContEx y).
-
analyse (Type _) = False
analyse (App fn (Type _)) = analyse fn
analyse (Note _ a) = analyse a
analyse other = True
+ -- Consider let x = 3 in f x
+ -- The substitution will contain (x -> ContEx 3), and we want to
+ -- to say that x is an interesting argument.
+ -- But consider also (\x. f x y) y
+ -- The substitution will contain (x -> ContEx y), and we want to say
+ -- that x is not interesting (assuming y has no unfolding)
\end{code}
Comment about interestingCallContext
-- Note the repType: we want to look through newtypes for this purpose
-canUpdateInPlace ty = case splitTyConApp_maybe (repType ty) of {
+canUpdateInPlace ty
+ | not opt_UF_UpdateInPlace = False
+ | otherwise
+ = case splitTyConApp_maybe (repType ty) of {
Nothing -> False ;
Just (tycon, _) ->
\begin{code}
transformRhs :: OutExpr
- -> (Arity -> OutExpr -> SimplM (OutStuff a))
+ -> (ArityInfo -> OutExpr -> SimplM (OutStuff a))
-> SimplM (OutStuff a)
transformRhs rhs thing_inside
\begin{code}
tryEtaExpansion :: OutExpr
- -> (Arity -> OutExpr -> SimplM (OutStuff a))
+ -> (ArityInfo -> OutExpr -> SimplM (OutStuff a))
-> SimplM (OutStuff a)
tryEtaExpansion rhs thing_inside
| not opt_SimplDoLambdaEtaExpansion
fun_arity = exprEtaExpandArity fun
- final_arity | all_trivial_args = x_arity + extra_args_wanted
- | otherwise = x_arity
+ final_arity | all_trivial_args = atLeastArity (x_arity + extra_args_wanted)
+ | otherwise = atLeastArity x_arity
-- Arity can be more than the number of lambdas
-- because of coerces. E.g. \x -> coerce t (\y -> e)
-- will have arity at least 2