- where
- get_str var = case getIdStrictness var of
- NoStrictnessInfo -> (repeat wwLazy, False)
- StrictnessInfo demands result_bot -> (demands, result_bot)
-
-
- (args', result_cont) = contArgs in_scope cont
- inline_call = contIsInline result_cont
- interesting_cont = contIsInteresting result_cont
- discard_inline_cont | inline_call = discardInline cont
- | otherwise = cont
-
- ---------- Unfolding stuff
- maybe_inline = callSiteInline black_listed inline_call
- var args' interesting_cont
- Just unf_template = maybe_inline
- black_listed = black_list_fn var
-
- ---------- Specialisation stuff
- maybe_rule_match = lookupRule in_scope var args'
- Just (rule_name, rule_rhs, rule_args) = maybe_rule_match
-
-
--- First a special case
--- Don't actually inline the scrutinee when we see
--- case x of y { .... }
--- and x has unfolding (C a b). Why not? Because
--- we get a silly binding y = C a b. If we don't
--- inline knownCon can directly substitute x for y instead.
-completeInlining var (Con con con_args) (Select _ bndr alts se cont)
- | conOkForAlt con
- = knownCon (Var var) con con_args bndr alts se cont
-
--- Now the normal case
-completeInlining var unfolding cont
- = simplExprF unfolding cont
-
------------ costCentreOk
--- costCentreOk checks that it's ok to inline this thing
--- The time it *isn't* is this:
+---------------------------------------------------------
+-- Dealing with a call
+
+completeCall var occ_info cont
+ = getBlackList `thenSmpl` \ black_list_fn ->
+ getInScope `thenSmpl` \ in_scope ->
+ getContArgs var cont `thenSmpl` \ (args, call_cont, inline_call) ->
+ getDOptsSmpl `thenSmpl` \ dflags ->
+ let
+ black_listed = black_list_fn var
+ arg_infos = [ interestingArg in_scope arg subst
+ | (arg, subst, _) <- args, isValArg arg]
+
+ interesting_cont = interestingCallContext (not (null args))
+ (not (null arg_infos))
+ call_cont
+
+ inline_cont | inline_call = discardInline cont
+ | otherwise = cont
+
+ maybe_inline = callSiteInline dflags black_listed inline_call occ_info
+ var arg_infos interesting_cont
+ in
+ -- First, look for an inlining
+ case maybe_inline of {
+ Just unfolding -- There is an inlining!
+ -> tick (UnfoldingDone var) `thenSmpl_`
+ simplExprF unfolding inline_cont
+
+ ;
+ Nothing -> -- No inlining!
+
+
+ simplifyArgs (isDataConId var) args (contResultType call_cont) $ \ args' ->
+
+ -- Next, look for rules or specialisations that match
+ --
+ -- It's important to simplify the args first, because the rule-matcher
+ -- doesn't do substitution as it goes. We don't want to use subst_args
+ -- (defined in the 'where') because that throws away useful occurrence info,
+ -- and perhaps-very-important specialisations.
+ --
+ -- Some functions have specialisations *and* are strict; in this case,
+ -- we don't want to inline the wrapper of the non-specialised thing; better
+ -- to call the specialised thing instead.
+ -- But the black-listing mechanism means that inlining of the wrapper
+ -- won't occur for things that have specialisations till a later phase, so
+ -- it's ok to try for inlining first.
+ --
+ -- You might think that we shouldn't apply rules for a loop breaker:
+ -- doing so might give rise to an infinite loop, because a RULE is
+ -- rather like an extra equation for the function:
+ -- RULE: f (g x) y = x+y
+ -- Eqn: f a y = a-y
+ --
+ -- But it's too drastic to disable rules for loop breakers.
+ -- Even the foldr/build rule would be disabled, because foldr
+ -- is recursive, and hence a loop breaker:
+ -- foldr k z (build g) = g k z
+ -- So it's up to the programmer: rules can cause divergence
+
+ getSwitchChecker `thenSmpl` \ chkr ->
+ let
+ maybe_rule | switchIsOn chkr DontApplyRules = Nothing
+ | otherwise = lookupRule in_scope var args'
+ in
+ case maybe_rule of {
+ Just (rule_name, rule_rhs) ->
+ tick (RuleFired rule_name) `thenSmpl_`
+#ifdef DEBUG
+ (if dopt Opt_D_dump_inlinings dflags then
+ pprTrace "Rule fired" (vcat [
+ text "Rule:" <+> ptext rule_name,
+ text "Before:" <+> ppr var <+> sep (map pprParendExpr args'),
+ text "After: " <+> pprCoreExpr rule_rhs])
+ else
+ id) $
+#endif
+ simplExprF rule_rhs call_cont ;
+
+ Nothing -> -- No rules
+
+ -- Done
+ rebuild (mkApps (Var var) args') call_cont
+ }}
+
+
+---------------------------------------------------------
+-- Simplifying the arguments of a call
+
+simplifyArgs :: Bool -- It's a data constructor
+ -> [(InExpr, SubstEnv, Bool)] -- Details of the arguments
+ -> OutType -- Type of the continuation
+ -> ([OutExpr] -> SimplM OutExprStuff)
+ -> SimplM OutExprStuff
+
+-- Simplify the arguments to a call.
+-- This part of the simplifier may break the no-shadowing invariant
+-- Consider
+-- f (...(\a -> e)...) (case y of (a,b) -> e')
+-- where f is strict in its second arg
+-- If we simplify the innermost one first we get (...(\a -> e)...)
+-- Simplifying the second arg makes us float the case out, so we end up with
+-- case y of (a,b) -> f (...(\a -> e)...) e'
+-- So the output does not have the no-shadowing invariant. However, there is
+-- no danger of getting name-capture, because when the first arg was simplified
+-- we used an in-scope set that at least mentioned all the variables free in its
+-- static environment, and that is enough.