import Var ( isCoVar )
import NewDemand
import SimplMonad
-import Type ( Type, funArgTy, mkForAllTys, mkTyVarTys,
- splitTyConApp_maybe, tyConAppArgs )
+import Type hiding( substTy )
import TyCon
import DataCon
import Unify ( dataConCannotMatch )
contIsInteresting looks for case expressions with just a single
default case.
+
\begin{code}
-interestingCallContext :: Bool -- False <=> no args at all
- -> Bool -- False <=> no value args
- -> SimplCont -> Bool
- -- The "lone-variable" case is important. I spent ages
- -- messing about with unsatisfactory varaints, but this is nice.
- -- The idea is that if a variable appear all alone
- -- as an arg of lazy fn, or rhs Stop
- -- as scrutinee of a case Select
- -- as arg of a strict fn ArgOf
- -- then we should not inline it (unless there is some other reason,
- -- e.g. is is the sole occurrence). We achieve this by making
- -- interestingCallContext return False for a lone variable.
- --
- -- Why? At least in the case-scrutinee situation, turning
- -- let x = (a,b) in case x of y -> ...
- -- into
- -- let x = (a,b) in case (a,b) of y -> ...
- -- and thence to
- -- let x = (a,b) in let y = (a,b) in ...
- -- is bad if the binding for x will remain.
- --
- -- Another example: I discovered that strings
- -- were getting inlined straight back into applications of 'error'
- -- because the latter is strict.
- -- s = "foo"
- -- f = \x -> ...(error s)...
-
- -- Fundamentally such contexts should not ecourage inlining because
- -- the context can ``see'' the unfolding of the variable (e.g. case or a RULE)
- -- so there's no gain.
- --
- -- However, even a type application or coercion isn't a lone variable.
- -- Consider
- -- case $fMonadST @ RealWorld of { :DMonad a b c -> c }
- -- We had better inline that sucker! The case won't see through it.
- --
- -- For now, I'm treating treating a variable applied to types
- -- in a *lazy* context "lone". The motivating example was
- -- f = /\a. \x. BIG
- -- g = /\a. \y. h (f a)
- -- There's no advantage in inlining f here, and perhaps
- -- a significant disadvantage. Hence some_val_args in the Stop case
-
-interestingCallContext some_args some_val_args cont
+interestingCallContext :: SimplCont -> CallContInfo
+interestingCallContext cont
= interesting cont
where
- interesting (Select {}) = some_args
- interesting (ApplyTo {}) = True -- Can happen if we have (coerce t (f x)) y
+ interesting (Select _ bndr _ _ _)
+ | isDeadBinder bndr = CaseCont
+ | otherwise = InterestingCont
+
+ interesting (ApplyTo {}) = InterestingCont
+ -- Can happen if we have (coerce t (f x)) y
-- Perhaps True is a bit over-keen, but I've
-- seen (coerce f) x, where f has an INLINE prag,
- -- So we have to give some motivaiton for inlining it
- interesting (StrictArg {}) = some_val_args
- interesting (StrictBind {}) = some_val_args -- ??
- interesting (Stop ty _ interesting) = some_val_args && interesting
- interesting (CoerceIt _ cont) = interesting cont
+ -- So we have to give some motivation for inlining it
+ interesting (StrictArg {}) = InterestingCont
+ interesting (StrictBind {}) = InterestingCont
+ interesting (Stop ty _ yes) = if yes then InterestingCont else BoringCont
+ interesting (CoerceIt _ cont) = interesting cont
-- If this call is the arg of a strict function, the context
-- is a bit interesting. If we inline here, we may get useful
-- evaluation information to avoid repeated evals: e.g.
-- where g has rules, then we *do* want to inline f, in case it
-- exposes a rule that might fire. Similarly, if the context is
-- h (g (f x x))
--- where h has rules, then we do want to inline f.
+-- where h has rules, then we do want to inline f; hence the
+-- call_cont argument to interestingArgContext
+--
-- The interesting_arg_ctxt flag makes this happen; if it's
-- set, the inliner gets just enough keener to inline f
-- regardless of how boring f's arguments are, if it's marked INLINE
-- The alternative would be to *always* inline an INLINE function,
-- regardless of how boring its context is; but that seems overkill
-- For example, it'd mean that wrapper functions were always inlined
-interestingArgContext fn cont
- = idHasRules fn || go cont
+interestingArgContext fn call_cont
+ = idHasRules fn || go call_cont
where
go (Select {}) = False
go (ApplyTo {}) = False
; mkLam' dflags bndrs body }
where
mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr
- mkLam' dflags bndrs (Cast body@(Lam _ _) co)
+ mkLam' dflags bndrs (Cast body co)
+ | not (any bad bndrs)
-- Note [Casts and lambdas]
- = do { lam <- mkLam' dflags (bndrs ++ bndrs') body'
+ = do { lam <- mkLam' dflags bndrs body
; return (mkCoerce (mkPiTypes bndrs co) lam) }
- where
- (bndrs',body') = collectBinders body
+ where
+ co_vars = tyVarsOfType co
+ bad bndr = isCoVar bndr && bndr `elemVarSet` co_vars
mkLam' dflags bndrs body
| dopt Opt_DoEtaReduction dflags,
(\x. e `cast` g1) --> (\x.e) `cast` (tx -> g1)
where x:tx.
-In general, this floats casts outside lambdas, where (I hope) they might meet
-and cancel with some other cast.
-
+In general, this floats casts outside lambdas, where (I hope) they
+might meet and cancel with some other cast:
+ \x. e `cast` co ===> (\x. e) `cast` (tx -> co)
+ /\a. e `cast` co ===> (/\a. e) `cast` (/\a. co)
+ /\g. e `cast` co ===> (/\g. e) `cast` (/\g. co)
+ (if not (g `in` co))
+
+Notice that it works regardless of 'e'. Originally it worked only
+if 'e' was itself a lambda, but in some cases that resulted in
+fruitless iteration in the simplifier. A good example was when
+compiling Text.ParserCombinators.ReadPrec, where we had a definition
+like (\x. Get `cast` g)
+where Get is a constructor with nonzero arity. Then mkLam eta-expanded
+the Get, and the next iteration eta-reduced it, and then eta-expanded
+it again.
+
+Note also the side condition for the case of coercion binders.
+It does not make sense to transform
+ /\g. e `cast` g ==> (/\g.e) `cast` (/\g.g)
+because the latter is not well-kinded.
-- c) floating lets out through big lambdas
-- [only if all tyvar lambdas, and only if this lambda
projects / ghc-hetmet.git / blobdiff