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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1996-1998
%
This module contains "tidying" code for *nested* expressions, bindings, rules.
The code for *top-level* bindings is in TidyPgm.
\begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module CoreTidy (
tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
) where
#include "HsVersions.h"
import CoreSyn
import CoreArity
import Id
import IdInfo
import Type( tidyType, tidyTyVarBndr )
import Coercion( tidyCo )
import Var
import VarEnv
import UniqFM
import Name hiding (tidyNameOcc)
import SrcLoc
import Maybes
import Data.List
import Outputable
\end{code}
%************************************************************************
%* *
\subsection{Tidying expressions, rules}
%* *
%************************************************************************
\begin{code}
tidyBind :: TidyEnv
-> CoreBind
-> (TidyEnv, CoreBind)
tidyBind env (NonRec bndr rhs)
= tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
(env', NonRec bndr' (tidyExpr env' rhs))
tidyBind env (Rec prs)
= let
(env', bndrs') = mapAccumL (tidyLetBndr env') env prs
in
map (tidyExpr env') (map snd prs) =: \ rhss' ->
(env', Rec (zip bndrs' rhss'))
------------ Expressions --------------
tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
tidyExpr env (Var v) = Var (tidyVarOcc env v)
tidyExpr env (Type ty) = Type (tidyType env ty)
tidyExpr env (Coercion co) = Coercion (tidyCo env co)
tidyExpr _ (Lit lit) = Lit lit
tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
tidyExpr env (Tick t e) = Tick (tidyTickish env t) (tidyExpr env e)
tidyExpr env (Cast e co) = Cast (tidyExpr env e) (tidyCo env co)
tidyExpr env (Let b e)
= tidyBind env b =: \ (env', b') ->
Let b' (tidyExpr env' e)
tidyExpr env (Case e b ty alts)
= tidyBndr env b =: \ (env', b) ->
Case (tidyExpr env e) b (tidyType env ty)
(map (tidyAlt b env') alts)
tidyExpr env (Lam b e)
= tidyBndr env b =: \ (env', b) ->
Lam b (tidyExpr env' e)
------------ Case alternatives --------------
tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
tidyAlt _case_bndr env (con, vs, rhs)
= tidyBndrs env vs =: \ (env', vs) ->
(con, vs, tidyExpr env' rhs)
------------ Tickish --------------
tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
tidyTickish _ other_tickish = other_tickish
------------ Rules --------------
tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
tidyRules _ [] = []
tidyRules env (rule : rules)
= tidyRule env rule =: \ rule ->
tidyRules env rules =: \ rules ->
(rule : rules)
tidyRule :: TidyEnv -> CoreRule -> CoreRule
tidyRule _ rule@(BuiltinRule {}) = rule
tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
ru_fn = fn, ru_rough = mb_ns })
= tidyBndrs env bndrs =: \ (env', bndrs) ->
map (tidyExpr env') args =: \ args ->
rule { ru_bndrs = bndrs, ru_args = args,
ru_rhs = tidyExpr env' rhs,
ru_fn = tidyNameOcc env fn,
ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
\end{code}
%************************************************************************
%* *
\subsection{Tidying non-top-level binders}
%* *
%************************************************************************
\begin{code}
tidyNameOcc :: TidyEnv -> Name -> Name
-- In rules and instances, we have Names, and we must tidy them too
-- Fortunately, we can lookup in the VarEnv with a name
tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
Nothing -> n
Just v -> idName v
tidyVarOcc :: TidyEnv -> Var -> Var
tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
-- tidyBndr is used for lambda and case binders
tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
tidyBndr env var
| isTyVar var = tidyTyVarBndr env var
| otherwise = tidyIdBndr env var
tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
tidyBndrs env vars = mapAccumL tidyBndr env vars
tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
-> TidyEnv -- The one to extend
-> (Id, CoreExpr) -> (TidyEnv, Var)
-- Used for local (non-top-level) let(rec)s
tidyLetBndr rec_tidy_env env (id,rhs)
= ((tidy_occ_env,new_var_env), final_id)
where
((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
new_var_env = extendVarEnv var_env id final_id
-- Override the env we get back from tidyId with the
-- new IdInfo so it gets propagated to the usage sites.
-- We need to keep around any interesting strictness and
-- demand info because later on we may need to use it when
-- converting to A-normal form.
-- eg.
-- f (g x), where f is strict in its argument, will be converted
-- into case (g x) of z -> f z by CorePrep, but only if f still
-- has its strictness info.
--
-- Similarly for the demand info - on a let binder, this tells
-- CorePrep to turn the let into a case.
--
-- Similarly arity info for eta expansion in CorePrep
--
-- Set inline-prag info so that we preseve it across
-- separate compilation boundaries
final_id = new_id `setIdInfo` new_info
idinfo = idInfo id
new_info = idInfo new_id
`setArityInfo` exprArity rhs
`setStrictnessInfo` strictnessInfo idinfo
`setDemandInfo` demandInfo idinfo
`setInlinePragInfo` inlinePragInfo idinfo
`setUnfoldingInfo` new_unf
new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
| otherwise = noUnfolding
unf = unfoldingInfo idinfo
-- Non-top-level variables
tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
tidyIdBndr env@(tidy_env, var_env) id
= -- Do this pattern match strictly, otherwise we end up holding on to
-- stuff in the OccName.
case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
let
-- Give the Id a fresh print-name, *and* rename its type
-- The SrcLoc isn't important now,
-- though we could extract it from the Id
--
ty' = tidyType env (idType id)
name' = mkInternalName (idUnique id) occ' noSrcSpan
id' = mkLocalIdWithInfo name' ty' new_info
var_env' = extendVarEnv var_env id id'
-- Note [Tidy IdInfo]
new_info = vanillaIdInfo `setOccInfo` occInfo old_info
old_info = idInfo id
in
((tidy_env', var_env'), id')
}
------------ Unfolding --------------
tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
= df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
where
(tidy_env', bndrs') = tidyBndrs tidy_env bndrs
tidyUnfolding tidy_env
unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
unf_from_rhs
| isStableSource src
= unf { uf_tmpl = tidyExpr tidy_env unf_rhs } -- Preserves OccInfo
| otherwise
= unf_from_rhs
tidyUnfolding _ unf _ = unf -- NoUnfolding or OtherCon
\end{code}
Note [Tidy IdInfo]
~~~~~~~~~~~~~~~~~~
All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
should save some space; except that we preserve occurrence info for
two reasons:
(a) To make printing tidy core nicer
(b) Because we tidy RULES and InlineRules, which may then propagate
via --make into the compilation of the next module, and we want
the benefit of that occurrence analysis when we use the rule or
or inline the function. In particular, it's vital not to lose
loop-breaker info, else we get an infinite inlining loop
Note that tidyLetBndr puts more IdInfo back.
\begin{code}
(=:) :: a -> (a -> b) -> b
m =: k = m `seq` k m
\end{code}
|
