+\begin{code}
+analyseCont :: InScopeSet -> SimplCont
+ -> ([Bool], -- Arg-info flags; one for each value argument
+ Bool, -- Context of the result of the call is interesting
+ Bool) -- There was an InlinePlease
+
+analyseCont in_scope cont
+ = case cont of
+ -- 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).
+ -- Why not? At least in the case-scrutinee situation, turning
+ -- case x of y -> ...
+ -- into
+ -- 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 becuase
+ -- 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 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.
+
+ (Stop _) -> boring_result -- Don't inline a lone variable
+ (Select _ _ _ _ _) -> boring_result -- Ditto
+ (ArgOf _ _ _) -> boring_result -- Ditto
+ (ApplyTo _ (Type _) _ cont) -> analyse_ty_app cont
+ other -> analyse_app cont
+ where
+ boring_result = ([], False, False)
+
+ -- For now, I'm treating not treating a variable applied to types as
+ -- "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.
+ analyse_ty_app (Stop _) = boring_result
+ analyse_ty_app (ArgOf _ _ _) = boring_result
+ analyse_ty_app (Select _ _ _ _ _) = ([], True, False) -- See the $fMonadST example above
+ analyse_ty_app (ApplyTo _ (Type _) _ cont) = analyse_ty_app cont
+ analyse_ty_app cont = analyse_app cont
+
+ analyse_app (InlinePlease cont)
+ = case analyse_app cont of
+ (infos, icont, inline) -> (infos, icont, True)
+
+ analyse_app (ApplyTo _ arg subst cont)
+ | isValArg arg = case analyse_app cont of
+ (infos, icont, inline) -> (analyse_arg subst arg : infos, icont, inline)
+ | otherwise = analyse_app cont
+
+ analyse_app cont = ([], interesting_call_context cont, False)
+
+ -- An argument is interesting if it has *some* structure
+ -- We are here trying to avoid unfolding a function that
+ -- is applied only to variables that have no unfolding
+ -- (i.e. they are probably lambda bound): f x y z
+ -- There is little point in inlining f here.
+ analyse_arg :: SubstEnv -> InExpr -> Bool
+ analyse_arg subst (Var v) = case lookupIdSubst (mkSubst in_scope subst) v of
+ DoneId v' _ -> isValueUnfolding (idUnfolding v')
+ other -> False
+ analyse_arg subst (Type _) = False
+ analyse_arg subst (App fn (Type _)) = analyse_arg subst fn
+ analyse_arg subst (Note _ a) = analyse_arg subst a
+ analyse_arg subst other = True
+
+ interesting_call_context (Stop ty) = canUpdateInPlace ty
+ interesting_call_context (InlinePlease _) = True
+ interesting_call_context (Select _ _ _ _ _) = True
+ interesting_call_context (CoerceIt _ cont) = interesting_call_context cont
+ interesting_call_context (ApplyTo _ (Type _) _ cont) = interesting_call_context cont
+ interesting_call_context (ApplyTo _ _ _ _) = True
+ interesting_call_context (ArgOf _ _ _) = True
+ -- 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.
+ -- x + (y * z)
+ -- Here the contIsInteresting makes the '*' keener to inline,
+ -- which in turn exposes a constructor which makes the '+' inline.
+ -- Assuming that +,* aren't small enough to inline regardless.
+ --
+ -- It's also very important to inline in a strict context for things
+ -- like
+ -- foldr k z (f x)
+ -- Here, the context of (f x) is strict, and if f's unfolding is
+ -- a build it's *great* to inline it here. So we must ensure that
+ -- the context for (f x) is not totally uninteresting.
+
+
+discardInline :: SimplCont -> SimplCont
+discardInline (InlinePlease cont) = cont
+discardInline (ApplyTo d e s cont) = ApplyTo d e s (discardInline cont)
+discardInline cont = cont
+
+-- Consider let x = <wurble> in ...
+-- If <wurble> returns an explicit constructor, we might be able
+-- to do update in place. So we treat even a thunk RHS context
+-- as interesting if update in place is possible. We approximate
+-- this by seeing if the type has a single constructor with a
+-- small arity. But arity zero isn't good -- we share the single copy
+-- for that case, so no point in sharing.
+
+canUpdateInPlace ty = case splitAlgTyConApp_maybe ty of
+ Just (_, _, [dc]) -> arity == 1 || arity == 2
+ where
+ arity = dataConRepArity dc
+ other -> False
+\end{code}