1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
module GHC.Driver.Config.Core.Opt.Simplify
( initSimplifyExprOpts
, initSimplifyOpts
, initSimplMode
, initGentleSimplMode
) where
import GHC.Prelude
import GHC.Core.Rules ( RuleBase )
import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..) )
import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )
import GHC.Driver.Config ( initOptCoercionOpts )
import GHC.Driver.Config.Core.Lint ( initLintPassResultConfig )
import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts )
import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt )
import GHC.Runtime.Context ( InteractiveContext(..) )
import GHC.Types.Basic ( CompilerPhase(..) )
import GHC.Types.Var ( Var )
initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
initSimplifyExprOpts dflags ic = SimplifyExprOpts
{ se_fam_inst = snd $ ic_instances ic
, se_mode = (initSimplMode dflags InitialPhase "GHCi")
{ sm_inline = False
-- Do not do any inlining, in case we expose some
-- unboxed tuple stuff that confuses the bytecode
-- interpreter
}
, se_top_env_cfg = TopEnvConfig
{ te_history_size = historySize dflags
, te_tick_factor = simplTickFactor dflags
}
}
initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
-- This is a particularly ugly construction, but we will get rid of it in !8341.
opts = SimplifyOpts
{ so_dump_core_sizes = not $ gopt Opt_SuppressCoreSizes dflags
, so_iterations = iterations
, so_mode = mode
, so_pass_result_cfg = if gopt Opt_DoCoreLinting dflags
then Just $ initLintPassResultConfig dflags extra_vars
(CoreDoSimplify opts)
else Nothing
, so_hpt_rules = hpt_rule_base
, so_top_env_cfg = TopEnvConfig { te_history_size = historySize dflags
, te_tick_factor = simplTickFactor dflags }
}
in opts
initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode
initSimplMode dflags phase name = SimplMode
{ sm_names = [name]
, sm_phase = phase
, sm_rules = gopt Opt_EnableRewriteRules dflags
, sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags
, sm_cast_swizzle = True
, sm_inline = True
, sm_uf_opts = unfoldingOpts dflags
, sm_case_case = True
, sm_pre_inline = gopt Opt_SimplPreInlining dflags
, sm_float_enable = floatEnable dflags
, sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags
, sm_arity_opts = initArityOpts dflags
, sm_rule_opts = initRuleOpts dflags
, sm_case_folding = gopt Opt_CaseFolding dflags
, sm_case_merge = gopt Opt_CaseMerge dflags
, sm_co_opt_opts = initOptCoercionOpts dflags
}
initGentleSimplMode :: DynFlags -> SimplMode
initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle")
{ -- Don't do case-of-case transformations.
-- This makes full laziness work better
-- See Note [Case-of-case and full laziness]
sm_case_case = False
}
floatEnable :: DynFlags -> FloatEnable
floatEnable dflags =
case (gopt Opt_LocalFloatOut dflags, gopt Opt_LocalFloatOutTopLevel dflags) of
(True, True) -> FloatEnabled
(True, False)-> FloatNestedOnly
(False, _) -> FloatDisabled
{- Note [Case-of-case and full laziness]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Case-of-case can hide opportunities for let-floating (full laziness).
For example
rec { f = \y. case (expensive x) of (a,b) -> blah }
We might hope to float the (expensive x) out of the \y-loop.
But if we inline `expensive` we might get
\y. case (case x of I# x' -> body) of (a,b) -> blah
Now if we do case-of-case we get
\y. case x if I# x2 ->
case body of (a,b) -> blah
Sadly, at this point `body` mentions `x2`, so we can't float it out of the
\y-loop.
Solution: don't do case-of-case in the "gentle" simplification phase that
precedes the first float-out transformation. Implementation:
* `sm_case_case` field in SimplMode
* Consult `sm_case_case` (via `seCaseCase`) before doing case-of-case
in GHC.Core.Opt.Simplify.Iteration.rebuildCall.
Wrinkles
* This applies equally to the case-of-runRW# transformation:
case (runRW# (\s. body)) of (a,b) -> blah
--->
runRW# (\s. case body of (a,b) -> blah)
Again, don't do this when `sm_case_case` is off. See #25055 for
a motivating example.
-}
|
