2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnExpr4]{Renaming of expressions (pass 4)}
6 Basically dependency analysis.
8 Handles @Match@, @GRHSsAndBinds@, @HsExpr@, and @Qual@ datatypes. In
9 general, all of these functions return a renamed thing, and a set of
13 #include "HsVersions.h"
16 rnMatch, rnGRHSsAndBinds, rnPat
18 -- and to make the interface self-sufficient...
22 import RnLoop -- break the RnPass4/RnExpr4/RnBinds4 loops
30 import Name ( Name(..) )
31 import NameTypes ( FullName{-instances-} )
32 import Outputable ( isConop )
33 import UniqSet ( emptyUniqSet, unitUniqSet,
34 unionUniqSets, unionManyUniqSets,
41 *********************************************************
45 *********************************************************
48 rnPat :: ProtoNamePat -> Rn4M RenamedPat
50 rnPat WildPatIn = returnRn4 WildPatIn
53 = lookupValue name `thenRn4` \ vname ->
54 returnRn4 (VarPatIn vname)
56 rnPat (LitPatIn n) = returnRn4 (LitPatIn n)
59 = rnPat pat `thenRn4` \ pat' ->
60 returnRn4 (LazyPatIn pat')
62 rnPat (AsPatIn name pat)
63 = rnPat pat `thenRn4` \ pat' ->
64 lookupValue name `thenRn4` \ vname ->
65 returnRn4 (AsPatIn vname pat')
67 rnPat (ConPatIn name pats)
68 = lookupValue name `thenRn4` \ name' ->
69 mapRn4 rnPat pats `thenRn4` \ patslist ->
70 returnRn4 (ConPatIn name' patslist)
72 rnPat (ConOpPatIn pat1 name pat2)
73 = lookupValue name `thenRn4` \ name' ->
74 rnPat pat1 `thenRn4` \ pat1' ->
75 rnPat pat2 `thenRn4` \ pat2' ->
76 returnRn4 (ConOpPatIn pat1' name' pat2')
78 rnPat (ListPatIn pats)
79 = mapRn4 rnPat pats `thenRn4` \ patslist ->
80 returnRn4 (ListPatIn patslist)
82 rnPat (TuplePatIn pats)
83 = mapRn4 rnPat pats `thenRn4` \ patslist ->
84 returnRn4 (TuplePatIn patslist)
86 rnPat (RecPatIn con rpats)
87 = panic "rnPat:RecPatIn"
91 ************************************************************************
95 ************************************************************************
98 rnMatch :: ProtoNameMatch -> Rn4M (RenamedMatch, FreeVars)
101 = getSrcLocRn4 `thenRn4` \ src_loc ->
102 namesFromProtoNames "variable in pattern"
103 (binders `zip` repeat src_loc) `thenRn4` \ new_binders ->
104 extendSS2 new_binders (rnMatch_aux match)
106 binders = collect_binders match
108 collect_binders :: ProtoNameMatch -> [ProtoName]
110 collect_binders (GRHSMatch _) = []
111 collect_binders (PatMatch pat match)
112 = collectPatBinders pat ++ collect_binders match
114 rnMatch_aux (PatMatch pat match)
115 = rnPat pat `thenRn4` \ pat' ->
116 rnMatch_aux match `thenRn4` \ (match', fvMatch) ->
117 returnRn4 (PatMatch pat' match', fvMatch)
119 rnMatch_aux (GRHSMatch grhss_and_binds)
120 = rnGRHSsAndBinds grhss_and_binds `thenRn4` \ (grhss_and_binds', fvs) ->
121 returnRn4 (GRHSMatch grhss_and_binds', fvs)
124 %************************************************************************
126 \subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
128 %************************************************************************
131 rnGRHSsAndBinds :: ProtoNameGRHSsAndBinds -> Rn4M (RenamedGRHSsAndBinds, FreeVars)
133 rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
134 = rnBinds binds `thenRn4` \ (binds', fvBinds, scope) ->
135 extendSS2 scope (rnGRHSs grhss) `thenRn4` \ (grhss', fvGRHS) ->
136 returnRn4 (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
138 rnGRHSs [] = returnRn4 ([], emptyUniqSet)
141 = rnGRHS grhs `thenRn4` \ (grhs', fvs) ->
142 rnGRHSs grhss `thenRn4` \ (grhss', fvss) ->
143 returnRn4 (grhs' : grhss', fvs `unionUniqSets` fvss)
145 rnGRHS (GRHS guard expr locn)
146 = pushSrcLocRn4 locn (
147 rnExpr guard `thenRn4` \ (guard', fvsg) ->
148 rnExpr expr `thenRn4` \ (expr', fvse) ->
149 returnRn4 (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
152 rnGRHS (OtherwiseGRHS expr locn)
153 = pushSrcLocRn4 locn (
154 rnExpr expr `thenRn4` \ (expr', fvs) ->
155 returnRn4 (OtherwiseGRHS expr' locn, fvs)
159 %************************************************************************
161 \subsubsection{Expressions}
163 %************************************************************************
166 rnExprs :: [ProtoNameHsExpr] -> Rn4M ([RenamedHsExpr], FreeVars)
168 rnExprs [] = returnRn4 ([], emptyUniqSet)
171 = rnExpr expr `thenRn4` \ (expr', fvExpr) ->
172 rnExprs exprs `thenRn4` \ (exprs', fvExprs) ->
173 returnRn4 (expr':exprs', fvExpr `unionUniqSets` fvExprs)
176 Variables. We look up the variable and return the resulting name. The
177 interesting question is what the free-variable set should be. We
178 don't want to return imported or prelude things as free vars. So we
179 look at the Name returned from the lookup, and make it part of the
185 or it's an @ValName@ and it's defined in this module
186 (this includes locally-defined constructrs, but that's too bad)
190 rnExpr :: ProtoNameHsExpr -> Rn4M (RenamedHsExpr, FreeVars)
193 = lookupValue v `thenRn4` \ vname ->
194 returnRn4 (HsVar vname, fv_set vname)
196 fv_set n@(Short uniq sname) = unitUniqSet n
197 fv_set n@(ValName uniq fname)
198 | isLocallyDefined fname
199 && not (isConop (getOccurrenceName fname))
201 fv_set other = emptyUniqSet
203 rnExpr (HsLit lit) = returnRn4 (HsLit lit, emptyUniqSet)
206 = rnMatch match `thenRn4` \ (match', fvMatch) ->
207 returnRn4 (HsLam match', fvMatch)
209 rnExpr (HsApp fun arg)
210 = rnExpr fun `thenRn4` \ (fun',fvFun) ->
211 rnExpr arg `thenRn4` \ (arg',fvArg) ->
212 returnRn4 (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
214 rnExpr (OpApp e1 op e2)
215 = rnExpr e1 `thenRn4` \ (e1', fvs_e1) ->
216 rnExpr op `thenRn4` \ (op', fvs_op) ->
217 rnExpr e2 `thenRn4` \ (e2', fvs_e2) ->
218 returnRn4 (OpApp e1' op' e2', (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
220 rnExpr (SectionL expr op)
221 = rnExpr expr `thenRn4` \ (expr', fvs_expr) ->
222 rnExpr op `thenRn4` \ (op', fvs_op) ->
223 returnRn4 (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
225 rnExpr (SectionR op expr)
226 = rnExpr op `thenRn4` \ (op', fvs_op) ->
227 rnExpr expr `thenRn4` \ (expr', fvs_expr) ->
228 returnRn4 (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
230 rnExpr (CCall fun args may_gc is_casm fake_result_ty)
231 = rnExprs args `thenRn4` \ (args', fvs_args) ->
232 returnRn4 (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
234 rnExpr (HsSCC label expr)
235 = rnExpr expr `thenRn4` \ (expr', fvs_expr) ->
236 returnRn4 (HsSCC label expr', fvs_expr)
238 rnExpr (HsCase expr ms src_loc)
239 = pushSrcLocRn4 src_loc $
240 rnExpr expr `thenRn4` \ (new_expr, e_fvs) ->
241 mapAndUnzipRn4 rnMatch ms `thenRn4` \ (new_ms, ms_fvs) ->
242 returnRn4 (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
244 rnExpr (HsLet binds expr)
245 = rnBinds binds `thenRn4` \ (binds', fvBinds, new_binders) ->
246 extendSS2 new_binders (rnExpr expr) `thenRn4` \ (expr',fvExpr) ->
247 returnRn4 (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
249 rnExpr (HsDo stmts src_loc)
250 = pushSrcLocRn4 src_loc $
251 rnStmts stmts `thenRn4` \ (stmts', fvStmts) ->
252 returnRn4 (HsDo stmts' src_loc, fvStmts)
254 rnExpr (ListComp expr quals)
255 = rnQuals quals `thenRn4` \ ((quals', qual_binders), fvQuals) ->
256 extendSS2 qual_binders (rnExpr expr) `thenRn4` \ (expr', fvExpr) ->
257 returnRn4 (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
259 rnExpr (ExplicitList exps)
260 = rnExprs exps `thenRn4` \ (exps', fvs) ->
261 returnRn4 (ExplicitList exps', fvs)
263 rnExpr (ExplicitTuple exps)
264 = rnExprs exps `thenRn4` \ (exps', fvExps) ->
265 returnRn4 (ExplicitTuple exps', fvExps)
267 rnExpr (RecordCon con rbinds)
268 = panic "rnExpr:RecordCon"
269 rnExpr (RecordUpd exp rbinds)
270 = panic "rnExpr:RecordUpd"
272 rnExpr (ExprWithTySig expr pty)
273 = rnExpr expr `thenRn4` \ (expr', fvExpr) ->
274 rnPolyType False nullTyVarNamesEnv pty `thenRn4` \ pty' ->
275 returnRn4 (ExprWithTySig expr' pty', fvExpr)
277 rnExpr (HsIf p b1 b2 src_loc)
278 = pushSrcLocRn4 src_loc $
279 rnExpr p `thenRn4` \ (p', fvP) ->
280 rnExpr b1 `thenRn4` \ (b1', fvB1) ->
281 rnExpr b2 `thenRn4` \ (b2', fvB2) ->
282 returnRn4 (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
284 rnExpr (ArithSeqIn seq)
285 = rn_seq seq `thenRn4` \ (new_seq, fvs) ->
286 returnRn4 (ArithSeqIn new_seq, fvs)
289 = rnExpr expr `thenRn4` \ (expr', fvExpr) ->
290 returnRn4 (From expr', fvExpr)
292 rn_seq (FromThen expr1 expr2)
293 = rnExpr expr1 `thenRn4` \ (expr1', fvExpr1) ->
294 rnExpr expr2 `thenRn4` \ (expr2', fvExpr2) ->
295 returnRn4 (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
297 rn_seq (FromTo expr1 expr2)
298 = rnExpr expr1 `thenRn4` \ (expr1', fvExpr1) ->
299 rnExpr expr2 `thenRn4` \ (expr2', fvExpr2) ->
300 returnRn4 (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
302 rn_seq (FromThenTo expr1 expr2 expr3)
303 = rnExpr expr1 `thenRn4` \ (expr1', fvExpr1) ->
304 rnExpr expr2 `thenRn4` \ (expr2', fvExpr2) ->
305 rnExpr expr3 `thenRn4` \ (expr3', fvExpr3) ->
306 returnRn4 (FromThenTo expr1' expr2' expr3',
307 unionManyUniqSets [fvExpr1, fvExpr2, fvExpr3])
311 %************************************************************************
313 \subsubsection{@Qual@s: in list comprehensions}
315 %************************************************************************
317 Note that although some bound vars may appear in the free var set for
318 the first qual, these will eventually be removed by the caller. For
319 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
320 @[q <- r, p <- q]@, the free var set for @q <- r@ will
321 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
322 @r@ will be removed only when we finally return from examining all the
326 rnQuals :: [ProtoNameQual]
327 -> Rn4M (([RenamedQual], -- renamed qualifiers
328 [Name]), -- qualifiers' binders
329 FreeVars) -- free variables
331 rnQuals [qual] -- must be at least one qual
332 = rnQual qual `thenRn4` \ ((new_qual, bs), fvs) ->
333 returnRn4 (([new_qual], bs), fvs)
335 rnQuals (qual: quals)
336 = rnQual qual `thenRn4` \ ((qual', bs1), fvQuals1) ->
337 extendSS2 bs1 (rnQuals quals) `thenRn4` \ ((quals', bs2), fvQuals2) ->
339 ((qual' : quals', bs2 ++ bs1), -- The ones on the right (bs2) shadow the
340 -- ones on the left (bs1)
341 fvQuals1 `unionUniqSets` fvQuals2)
343 rnQual (GeneratorQual pat expr)
344 = rnExpr expr `thenRn4` \ (expr', fvExpr) ->
346 binders = collectPatBinders pat
348 getSrcLocRn4 `thenRn4` \ src_loc ->
349 namesFromProtoNames "variable in list-comprehension-generator pattern"
350 (binders `zip` repeat src_loc) `thenRn4` \ new_binders ->
351 extendSS new_binders (rnPat pat) `thenRn4` \ pat' ->
353 returnRn4 ((GeneratorQual pat' expr', new_binders), fvExpr)
355 rnQual (FilterQual expr)
356 = rnExpr expr `thenRn4` \ (expr', fvs) ->
357 returnRn4 ((FilterQual expr', []), fvs)
359 rnQual (LetQual binds)
360 = rnBinds binds `thenRn4` \ (binds', binds_fvs, new_binders) ->
361 returnRn4 ((LetQual binds', new_binders), binds_fvs)
365 %************************************************************************
367 \subsubsection{@Stmt@s: in @do@ expressions}
369 %************************************************************************
372 rnStmts :: [ProtoNameStmt]
373 -> Rn4M ([RenamedStmt], -- renamed qualifiers
374 FreeVars) -- free variables
376 rnStmts [stmt@(ExprStmt _ _)] -- last stmt must be ExprStmt
377 = rnStmt stmt `thenRn4` \ ((stmt',[]), fvStmt) ->
378 returnRn4 ([stmt'], fvStmt)
381 = rnStmt stmt `thenRn4` \ ((stmt',bs), fvStmt) ->
382 extendSS2 bs (rnStmts stmts) `thenRn4` \ (stmts', fvStmts) ->
383 returnRn4 (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
386 rnStmt (BindStmt pat expr src_loc)
387 = pushSrcLocRn4 src_loc $
388 rnExpr expr `thenRn4` \ (expr', fvExpr) ->
390 binders = collectPatBinders pat
392 namesFromProtoNames "variable in do binding"
393 (binders `zip` repeat src_loc) `thenRn4` \ new_binders ->
394 extendSS new_binders (rnPat pat) `thenRn4` \ pat' ->
396 returnRn4 ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
398 rnStmt (ExprStmt expr src_loc)
400 rnExpr expr `thenRn4` \ (expr', fvs) ->
401 returnRn4 ((ExprStmt expr' src_loc, []), fvs)
403 rnStmt (LetStmt binds)
404 = rnBinds binds `thenRn4` \ (binds', binds_fvs, new_binders) ->
405 returnRn4 ((LetStmt binds', new_binders), binds_fvs)