2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnExpr]{Renaming of expressions}
6 Basically dependency analysis.
8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes. In
9 general, all of these functions return a renamed thing, and a set of
14 rnMatch, rnGRHSs, rnPat, rnExpr, rnExprs,
15 rnStmt, rnStmts, checkPrecMatch
18 #include "HsVersions.h"
20 import {-# SOURCE #-} RnSource ( rnSrcDecls, rnBinds )
27 import RnTypes ( rnHsTypeFVs, precParseErr, sectionPrecErr )
28 import CmdLineOpts ( DynFlag(..), opt_IgnoreAsserts )
29 import Literal ( inIntRange, inCharRange )
30 import BasicTypes ( Fixity(..), FixityDirection(..), IPName(..),
31 defaultFixity, negateFixity, compareFixity )
32 import PrelNames ( hasKey, assertIdKey,
33 eqClassName, foldrName, buildName, eqStringName,
34 cCallableClassName, cReturnableClassName,
35 enumClassName, ordClassName,
36 ratioDataConName, splitName, fstName, sndName,
37 ioDataConName, plusIntegerName, timesIntegerName,
38 replicatePName, mapPName, filterPName,
39 crossPName, zipPName, lengthPName, indexPName, toPName,
40 enumFromToPName, enumFromThenToPName, assertErrorName,
41 fromIntegerName, fromRationalName, minusName, negateName,
42 qTyConName, monadNames )
43 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
44 floatPrimTyCon, doublePrimTyCon )
45 import TysWiredIn ( intTyCon )
46 import RdrName ( RdrName )
47 import Name ( Name, NamedThing(..), mkSystemName, nameSrcLoc, nameOccName )
49 import UnicodeUtil ( stringToUtf8 )
50 import UniqFM ( isNullUFM )
51 import UniqSet ( emptyUniqSet )
52 import List ( intersectBy )
53 import ListSetOps ( removeDups )
59 *********************************************************
63 *********************************************************
66 rnPat :: RdrNamePat -> RnM (RenamedPat, FreeVars)
68 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
71 = lookupBndrRn name `thenM` \ vname ->
72 returnM (VarPat vname, emptyFVs)
74 rnPat (SigPatIn pat ty)
75 = doptM Opt_GlasgowExts `thenM` \ glaExts ->
78 then rnPat pat `thenM` \ (pat', fvs1) ->
79 rnHsTypeFVs doc ty `thenM` \ (ty', fvs2) ->
80 returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
82 else addErr (patSigErr ty) `thenM_`
85 doc = text "In a pattern type-signature"
87 rnPat (LitPat s@(HsString _))
88 = returnM (LitPat s, unitFV eqStringName)
91 = litFVs lit `thenM` \ fvs ->
92 returnM (LitPat lit, fvs)
94 rnPat (NPatIn lit mb_neg)
95 = rnOverLit lit `thenM` \ (lit', fvs1) ->
97 Nothing -> returnM (Nothing, emptyFVs)
98 Just _ -> lookupSyntaxName negateName `thenM` \ (neg, fvs) ->
99 returnM (Just neg, fvs)
100 ) `thenM` \ (mb_neg', fvs2) ->
101 returnM (NPatIn lit' mb_neg',
102 fvs1 `plusFV` fvs2 `addOneFV` eqClassName)
103 -- Needed to find equality on pattern
105 rnPat (NPlusKPatIn name lit _)
106 = rnOverLit lit `thenM` \ (lit', fvs1) ->
107 lookupBndrRn name `thenM` \ name' ->
108 lookupSyntaxName minusName `thenM` \ (minus, fvs2) ->
109 returnM (NPlusKPatIn name' lit' minus,
110 fvs1 `plusFV` fvs2 `addOneFV` ordClassName)
113 = rnPat pat `thenM` \ (pat', fvs) ->
114 returnM (LazyPat pat', fvs)
116 rnPat (AsPat name pat)
117 = rnPat pat `thenM` \ (pat', fvs) ->
118 lookupBndrRn name `thenM` \ vname ->
119 returnM (AsPat vname pat', fvs)
121 rnPat (ConPatIn con stuff) = rnConPat con stuff
125 = rnPat pat `thenM` \ (pat', fvs) ->
126 returnM (ParPat pat', fvs)
128 rnPat (ListPat pats _)
129 = mapFvRn rnPat pats `thenM` \ (patslist, fvs) ->
130 returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
132 rnPat (PArrPat pats _)
133 = mapFvRn rnPat pats `thenM` \ (patslist, fvs) ->
134 returnM (PArrPat patslist placeHolderType,
135 fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
137 implicit_fvs = mkFVs [lengthPName, indexPName]
139 rnPat (TuplePat pats boxed)
140 = mapFvRn rnPat pats `thenM` \ (patslist, fvs) ->
141 returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name)
143 tycon_name = tupleTyCon_name boxed (length pats)
145 rnPat (TypePat name) =
146 rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
147 returnM (TypePat name', fvs)
149 ------------------------------
150 rnConPat con (PrefixCon pats)
151 = lookupOccRn con `thenM` \ con' ->
152 mapFvRn rnPat pats `thenM` \ (pats', fvs) ->
153 returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` con')
155 rnConPat con (RecCon rpats)
156 = lookupOccRn con `thenM` \ con' ->
157 rnRpats rpats `thenM` \ (rpats', fvs) ->
158 returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` con')
160 rnConPat con (InfixCon pat1 pat2)
161 = lookupOccRn con `thenM` \ con' ->
162 rnPat pat1 `thenM` \ (pat1', fvs1) ->
163 rnPat pat2 `thenM` \ (pat2', fvs2) ->
165 getModeRn `thenM` \ mode ->
166 -- See comments with rnExpr (OpApp ...)
167 (if isInterfaceMode mode
168 then returnM (ConPatIn con' (InfixCon pat1' pat2'))
169 else lookupFixityRn con' `thenM` \ fixity ->
170 mkConOpPatRn con' fixity pat1' pat2'
172 returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
176 ************************************************************************
180 ************************************************************************
183 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnM (RenamedMatch, FreeVars)
185 rnMatch ctxt match@(Match pats maybe_rhs_sig grhss)
186 = addSrcLoc (getMatchLoc match) $
188 -- Bind pattern-bound type variables
190 rhs_sig_tys = case maybe_rhs_sig of
193 pat_sig_tys = collectSigTysFromPats pats
194 doc_sig = text "In a result type-signature"
195 doc_pat = pprMatchContext ctxt
197 bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys) $
199 -- Note that we do a single bindLocalsRn for all the
200 -- matches together, so that we spot the repeated variable in
202 bindLocalsFVRn doc_pat (collectPatsBinders pats) $ \ new_binders ->
204 mapFvRn rnPat pats `thenM` \ (pats', pat_fvs) ->
205 rnGRHSs grhss `thenM` \ (grhss', grhss_fvs) ->
206 doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
207 (case maybe_rhs_sig of
208 Nothing -> returnM (Nothing, emptyFVs)
209 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenM` \ (ty', ty_fvs) ->
210 returnM (Just ty', ty_fvs)
211 | otherwise -> addErr (patSigErr ty) `thenM_`
212 returnM (Nothing, emptyFVs)
213 ) `thenM` \ (maybe_rhs_sig', ty_fvs) ->
216 binder_set = mkNameSet new_binders
217 unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
218 all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
220 warnUnusedMatches unused_binders `thenM_`
222 returnM (Match pats' maybe_rhs_sig' grhss', all_fvs)
223 -- The bindLocals and bindTyVars will remove the bound FVs
227 %************************************************************************
229 \subsubsection{Guarded right-hand sides (GRHSs)}
231 %************************************************************************
234 rnGRHSs :: RdrNameGRHSs -> RnM (RenamedGRHSs, FreeVars)
236 rnGRHSs (GRHSs grhss binds _)
237 = rnBinds binds $ \ binds' ->
238 mapFvRn rnGRHS grhss `thenM` \ (grhss', fvGRHSs) ->
239 returnM (GRHSs grhss' binds' placeHolderType, fvGRHSs)
241 rnGRHS (GRHS guarded locn)
242 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
244 (if not (opt_GlasgowExts || is_standard_guard guarded) then
245 addWarn (nonStdGuardErr guarded)
250 rnStmts guarded `thenM` \ ((_, guarded'), fvs) ->
251 returnM (GRHS guarded' locn, fvs)
253 -- Standard Haskell 1.4 guards are just a single boolean
254 -- expression, rather than a list of qualifiers as in the
256 is_standard_guard [ResultStmt _ _] = True
257 is_standard_guard [ExprStmt _ _ _, ResultStmt _ _] = True
258 is_standard_guard other = False
261 %************************************************************************
263 \subsubsection{Expressions}
265 %************************************************************************
268 rnExprs :: [RdrNameHsExpr] -> RnM ([RenamedHsExpr], FreeVars)
269 rnExprs ls = rnExprs' ls emptyUniqSet
271 rnExprs' [] acc = returnM ([], acc)
272 rnExprs' (expr:exprs) acc
273 = rnExpr expr `thenM` \ (expr', fvExpr) ->
275 -- Now we do a "seq" on the free vars because typically it's small
276 -- or empty, especially in very long lists of constants
278 acc' = acc `plusFV` fvExpr
280 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenM` \ (exprs', fvExprs) ->
281 returnM (expr':exprs', fvExprs)
283 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
284 grubby_seqNameSet ns result | isNullUFM ns = result
288 Variables. We look up the variable and return the resulting name.
291 rnExpr :: RdrNameHsExpr -> RnM (RenamedHsExpr, FreeVars)
294 = lookupOccRn v `thenM` \ name ->
295 if name `hasKey` assertIdKey && not opt_IgnoreAsserts then
296 -- We expand it to (GHC.Err.assertError location_string)
299 -- The normal case. Even if the Id was 'assert', if we are
300 -- ignoring assertions we leave it as GHC.Base.assert;
301 -- this function just ignores its first arg.
302 returnM (HsVar name, unitFV name)
305 = newIPName v `thenM` \ name ->
308 Linear _ -> mkFVs [splitName, fstName, sndName]
309 Dupable _ -> emptyFVs
311 returnM (HsIPVar name, fvs)
314 = litFVs lit `thenM` \ fvs ->
315 returnM (HsLit lit, fvs)
317 rnExpr (HsOverLit lit)
318 = rnOverLit lit `thenM` \ (lit', fvs) ->
319 returnM (HsOverLit lit', fvs)
322 = rnMatch LambdaExpr match `thenM` \ (match', fvMatch) ->
323 returnM (HsLam match', fvMatch)
325 rnExpr (HsApp fun arg)
326 = rnExpr fun `thenM` \ (fun',fvFun) ->
327 rnExpr arg `thenM` \ (arg',fvArg) ->
328 returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
330 rnExpr (OpApp e1 op _ e2)
331 = rnExpr e1 `thenM` \ (e1', fv_e1) ->
332 rnExpr e2 `thenM` \ (e2', fv_e2) ->
333 rnExpr op `thenM` \ (op'@(HsVar op_name), fv_op) ->
336 -- When renaming code synthesised from "deriving" declarations
337 -- we're in Interface mode, and we should ignore fixity; assume
338 -- that the deriving code generator got the association correct
339 -- Don't even look up the fixity when in interface mode
340 getModeRn `thenM` \ mode ->
341 (if isInterfaceMode mode
342 then returnM (OpApp e1' op' defaultFixity e2')
343 else lookupFixityRn op_name `thenM` \ fixity ->
344 mkOpAppRn e1' op' fixity e2'
345 ) `thenM` \ final_e ->
348 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
351 = rnExpr e `thenM` \ (e', fv_e) ->
352 lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
353 mkNegAppRn e' neg_name `thenM` \ final_e ->
354 returnM (final_e, fv_e `plusFV` fv_neg)
357 = rnExpr e `thenM` \ (e', fvs_e) ->
358 returnM (HsPar e', fvs_e)
360 -- Template Haskell extensions
361 rnExpr (HsBracket br_body)
362 = checkGHCI (thErr "bracket") `thenM_`
363 rnBracket br_body `thenM` \ (body', fvs_e) ->
364 returnM (HsBracket body', fvs_e `addOneFV` qTyConName)
365 -- We use the Q tycon as a proxy to haul in all the smart
366 -- constructors; see the hack in RnIfaces
368 rnExpr (HsSplice n e)
369 = checkGHCI (thErr "splice") `thenM_`
370 getSrcLocM `thenM` \ loc ->
371 newLocalsRn [(n,loc)] `thenM` \ [n'] ->
372 rnExpr e `thenM` \ (e', fvs_e) ->
373 returnM (HsSplice n' e', fvs_e)
375 rnExpr section@(SectionL expr op)
376 = rnExpr expr `thenM` \ (expr', fvs_expr) ->
377 rnExpr op `thenM` \ (op', fvs_op) ->
378 checkSectionPrec InfixL section op' expr' `thenM_`
379 returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
381 rnExpr section@(SectionR op expr)
382 = rnExpr op `thenM` \ (op', fvs_op) ->
383 rnExpr expr `thenM` \ (expr', fvs_expr) ->
384 checkSectionPrec InfixR section op' expr' `thenM_`
385 returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
387 rnExpr (HsCCall fun args may_gc is_casm _)
388 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
389 = rnExprs args `thenM` \ (args', fvs_args) ->
390 returnM (HsCCall fun args' may_gc is_casm placeHolderType,
391 fvs_args `plusFV` mkFVs [cCallableClassName,
392 cReturnableClassName,
395 rnExpr (HsSCC lbl expr)
396 = rnExpr expr `thenM` \ (expr', fvs_expr) ->
397 returnM (HsSCC lbl expr', fvs_expr)
399 rnExpr (HsCase expr ms src_loc)
400 = addSrcLoc src_loc $
401 rnExpr expr `thenM` \ (new_expr, e_fvs) ->
402 mapFvRn (rnMatch CaseAlt) ms `thenM` \ (new_ms, ms_fvs) ->
403 returnM (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
405 rnExpr (HsLet binds expr)
406 = rnBinds binds $ \ binds' ->
407 rnExpr expr `thenM` \ (expr',fvExpr) ->
408 returnM (HsLet binds' expr', fvExpr)
410 rnExpr (HsWith expr binds is_with)
411 = warnIf is_with withWarning `thenM_`
412 rnExpr expr `thenM` \ (expr',fvExpr) ->
413 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
414 returnM (HsWith expr' binds' is_with, fvExpr `plusFV` fvBinds)
416 rnExpr e@(HsDo do_or_lc stmts _ ty src_loc)
417 = addSrcLoc src_loc $
418 rnStmts stmts `thenM` \ ((_, stmts'), fvs) ->
420 -- Check the statement list ends in an expression
421 case last stmts' of {
422 ResultStmt _ _ -> returnM () ;
423 _ -> addErr (doStmtListErr e)
426 -- Generate the rebindable syntax for the monad
428 DoExpr -> mapAndUnzipM lookupSyntaxName monadNames
429 other -> returnM ([], [])
430 ) `thenM` \ (monad_names', monad_fvs) ->
432 returnM (HsDo do_or_lc stmts' monad_names' placeHolderType src_loc,
433 fvs `plusFV` implicit_fvs `plusFV` plusFVs monad_fvs)
435 implicit_fvs = case do_or_lc of
436 PArrComp -> mkFVs [replicatePName, mapPName, filterPName,
437 crossPName, zipPName]
438 ListComp -> mkFVs [foldrName, buildName]
441 rnExpr (ExplicitList _ exps)
442 = rnExprs exps `thenM` \ (exps', fvs) ->
443 returnM (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
445 rnExpr (ExplicitPArr _ exps)
446 = rnExprs exps `thenM` \ (exps', fvs) ->
447 returnM (ExplicitPArr placeHolderType exps',
448 fvs `addOneFV` toPName `addOneFV` parrTyCon_name)
450 rnExpr (ExplicitTuple exps boxity)
451 = rnExprs exps `thenM` \ (exps', fvs) ->
452 returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
454 tycon_name = tupleTyCon_name boxity (length exps)
456 rnExpr (RecordCon con_id rbinds)
457 = lookupOccRn con_id `thenM` \ conname ->
458 rnRbinds "construction" rbinds `thenM` \ (rbinds', fvRbinds) ->
459 returnM (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
461 rnExpr (RecordUpd expr rbinds)
462 = rnExpr expr `thenM` \ (expr', fvExpr) ->
463 rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) ->
464 returnM (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
466 rnExpr (ExprWithTySig expr pty)
467 = rnExpr expr `thenM` \ (expr', fvExpr) ->
468 rnHsTypeFVs doc pty `thenM` \ (pty', fvTy) ->
469 returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
471 doc = text "In an expression type signature"
473 rnExpr (HsIf p b1 b2 src_loc)
474 = addSrcLoc src_loc $
475 rnExpr p `thenM` \ (p', fvP) ->
476 rnExpr b1 `thenM` \ (b1', fvB1) ->
477 rnExpr b2 `thenM` \ (b2', fvB2) ->
478 returnM (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
481 = rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
482 returnM (HsType t, fvT)
484 doc = text "In a type argument"
486 rnExpr (ArithSeqIn seq)
487 = rn_seq seq `thenM` \ (new_seq, fvs) ->
488 returnM (ArithSeqIn new_seq, fvs `addOneFV` enumClassName)
491 = rnExpr expr `thenM` \ (expr', fvExpr) ->
492 returnM (From expr', fvExpr)
494 rn_seq (FromThen expr1 expr2)
495 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
496 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
497 returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
499 rn_seq (FromTo expr1 expr2)
500 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
501 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
502 returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
504 rn_seq (FromThenTo expr1 expr2 expr3)
505 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
506 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
507 rnExpr expr3 `thenM` \ (expr3', fvExpr3) ->
508 returnM (FromThenTo expr1' expr2' expr3',
509 plusFVs [fvExpr1, fvExpr2, fvExpr3])
511 rnExpr (PArrSeqIn seq)
512 = rn_seq seq `thenM` \ (new_seq, fvs) ->
513 returnM (PArrSeqIn new_seq,
514 fvs `plusFV` mkFVs [enumFromToPName, enumFromThenToPName])
517 -- the parser shouldn't generate these two
519 rn_seq (From _ ) = panic "RnExpr.rnExpr: Infinite parallel array!"
520 rn_seq (FromThen _ _) = panic "RnExpr.rnExpr: Infinite parallel array!"
522 rn_seq (FromTo expr1 expr2)
523 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
524 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
525 returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
526 rn_seq (FromThenTo expr1 expr2 expr3)
527 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
528 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
529 rnExpr expr3 `thenM` \ (expr3', fvExpr3) ->
530 returnM (FromThenTo expr1' expr2' expr3',
531 plusFVs [fvExpr1, fvExpr2, fvExpr3])
534 These three are pattern syntax appearing in expressions.
535 Since all the symbols are reservedops we can simply reject them.
536 We return a (bogus) EWildPat in each case.
539 rnExpr e@EWildPat = addErr (patSynErr e) `thenM_`
540 returnM (EWildPat, emptyFVs)
542 rnExpr e@(EAsPat _ _) = addErr (patSynErr e) `thenM_`
543 returnM (EWildPat, emptyFVs)
545 rnExpr e@(ELazyPat _) = addErr (patSynErr e) `thenM_`
546 returnM (EWildPat, emptyFVs)
551 %************************************************************************
553 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
555 %************************************************************************
559 = mappM_ field_dup_err dup_fields `thenM_`
560 mapFvRn rn_rbind rbinds `thenM` \ (rbinds', fvRbind) ->
561 returnM (rbinds', fvRbind)
563 (_, dup_fields) = removeDups compare [ f | (f,_) <- rbinds ]
565 field_dup_err dups = addErr (dupFieldErr str dups)
567 rn_rbind (field, expr)
568 = lookupGlobalOccRn field `thenM` \ fieldname ->
569 rnExpr expr `thenM` \ (expr', fvExpr) ->
570 returnM ((fieldname, expr'), fvExpr `addOneFV` fieldname)
573 = mappM_ field_dup_err dup_fields `thenM_`
574 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
575 returnM (rpats', fvs)
577 (_, dup_fields) = removeDups compare [ f | (f,_) <- rpats ]
579 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
582 = lookupGlobalOccRn field `thenM` \ fieldname ->
583 rnPat pat `thenM` \ (pat', fvs) ->
584 returnM ((fieldname, pat'), fvs `addOneFV` fieldname)
587 %************************************************************************
589 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
591 %************************************************************************
594 rnIPBinds [] = returnM ([], emptyFVs)
595 rnIPBinds ((n, expr) : binds)
596 = newIPName n `thenM` \ name ->
597 rnExpr expr `thenM` \ (expr',fvExpr) ->
598 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
599 returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
603 %************************************************************************
605 Template Haskell brackets
607 %************************************************************************
610 rnBracket (ExpBr e) = rnExpr e `thenM` \ (e', fvs) ->
611 returnM (ExpBr e', fvs)
612 rnBracket (PatBr p) = rnPat p `thenM` \ (p', fvs) ->
613 returnM (PatBr p', fvs)
614 rnBracket (TypBr t) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
615 returnM (TypBr t', fvs)
617 doc = ptext SLIT("In a Template-Haskell quoted type")
618 rnBracket (DecBr ds) = rnSrcDecls ds `thenM` \ (tcg_env, ds', fvs) ->
619 -- Discard the tcg_env; it contains the extended global RdrEnv
620 -- because there is no scope that these decls cover (yet!)
621 returnM (DecBr ds', fvs)
624 %************************************************************************
626 \subsubsection{@Stmt@s: in @do@ expressions}
628 %************************************************************************
630 Note that although some bound vars may appear in the free var set for
631 the first qual, these will eventually be removed by the caller. For
632 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
633 @[q <- r, p <- q]@, the free var set for @q <- r@ will
634 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
635 @r@ will be removed only when we finally return from examining all the
639 rnStmts :: [RdrNameStmt]
640 -> RnM (([Name], [RenamedStmt]), FreeVars)
643 = returnM (([], []), emptyFVs)
646 = getLocalRdrEnv `thenM` \ name_env ->
647 rnStmt stmt $ \ stmt' ->
648 rnStmts stmts `thenM` \ ((binders, stmts'), fvs) ->
649 returnM ((binders, stmt' : stmts'), fvs)
651 rnStmt :: RdrNameStmt
652 -> (RenamedStmt -> RnM (([Name], a), FreeVars))
653 -> RnM (([Name], a), FreeVars)
654 -- The thing list of names returned is the list returned by the
655 -- thing_inside, plus the binders of the arguments stmt
657 rnStmt (ParStmt stmtss) thing_inside
658 = mapFvRn rnStmts stmtss `thenM` \ (bndrstmtss, fv_stmtss) ->
659 let binderss = map fst bndrstmtss
660 checkBndrs all_bndrs bndrs
661 = checkErr (null (intersectBy eqOcc all_bndrs bndrs)) err `thenM_`
662 returnM (bndrs ++ all_bndrs)
663 eqOcc n1 n2 = nameOccName n1 == nameOccName n2
664 err = text "duplicate binding in parallel list comprehension"
666 foldlM checkBndrs [] binderss `thenM` \ new_binders ->
667 bindLocalNamesFV new_binders $
668 thing_inside (ParStmtOut bndrstmtss)`thenM` \ ((rest_bndrs, result), fv_rest) ->
669 returnM ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
671 rnStmt (BindStmt pat expr src_loc) thing_inside
672 = addSrcLoc src_loc $
673 rnExpr expr `thenM` \ (expr', fv_expr) ->
674 bindPatSigTyVars (collectSigTysFromPat pat) $
675 bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
676 rnPat pat `thenM` \ (pat', fv_pat) ->
677 thing_inside (BindStmt pat' expr' src_loc) `thenM` \ ((rest_binders, result), fvs) ->
678 returnM ((new_binders ++ rest_binders, result),
679 fv_expr `plusFV` fvs `plusFV` fv_pat)
681 doc = text "In a pattern in 'do' binding"
683 rnStmt (ExprStmt expr _ src_loc) thing_inside
684 = addSrcLoc src_loc $
685 rnExpr expr `thenM` \ (expr', fv_expr) ->
686 thing_inside (ExprStmt expr' placeHolderType src_loc) `thenM` \ (result, fvs) ->
687 returnM (result, fv_expr `plusFV` fvs)
689 rnStmt (ResultStmt expr src_loc) thing_inside
690 = addSrcLoc src_loc $
691 rnExpr expr `thenM` \ (expr', fv_expr) ->
692 thing_inside (ResultStmt expr' src_loc) `thenM` \ (result, fvs) ->
693 returnM (result, fv_expr `plusFV` fvs)
695 rnStmt (LetStmt binds) thing_inside
696 = rnBinds binds $ \ binds' ->
697 let new_binders = collectHsBinders binds' in
698 thing_inside (LetStmt binds') `thenM` \ ((rest_binders, result), fvs) ->
699 returnM ((new_binders ++ rest_binders, result), fvs )
702 %************************************************************************
704 \subsubsection{Precedence Parsing}
706 %************************************************************************
708 @mkOpAppRn@ deals with operator fixities. The argument expressions
709 are assumed to be already correctly arranged. It needs the fixities
710 recorded in the OpApp nodes, because fixity info applies to the things
711 the programmer actually wrote, so you can't find it out from the Name.
713 Furthermore, the second argument is guaranteed not to be another
714 operator application. Why? Because the parser parses all
715 operator appications left-associatively, EXCEPT negation, which
716 we need to handle specially.
719 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
720 -> RenamedHsExpr -> Fixity -- Operator and fixity
721 -> RenamedHsExpr -- Right operand (not an OpApp, but might
725 ---------------------------
726 -- (e11 `op1` e12) `op2` e2
727 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
729 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
730 returnM (OpApp e1 op2 fix2 e2)
733 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
734 returnM (OpApp e11 op1 fix1 new_e)
736 (nofix_error, associate_right) = compareFixity fix1 fix2
738 ---------------------------
739 -- (- neg_arg) `op` e2
740 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
742 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
743 returnM (OpApp e1 op2 fix2 e2)
746 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
747 returnM (NegApp new_e neg_name)
749 (nofix_error, associate_right) = compareFixity negateFixity fix2
751 ---------------------------
753 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
754 | not associate_right -- We *want* right association
755 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
756 returnM (OpApp e1 op1 fix1 e2)
758 (_, associate_right) = compareFixity fix1 negateFixity
760 ---------------------------
762 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
763 = ASSERT2( right_op_ok fix e2,
764 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
766 returnM (OpApp e1 op fix e2)
768 -- Parser left-associates everything, but
769 -- derived instances may have correctly-associated things to
770 -- in the right operarand. So we just check that the right operand is OK
771 right_op_ok fix1 (OpApp _ _ fix2 _)
772 = not error_please && associate_right
774 (error_please, associate_right) = compareFixity fix1 fix2
775 right_op_ok fix1 other
778 -- Parser initially makes negation bind more tightly than any other operator
779 mkNegAppRn neg_arg neg_name
782 getModeRn `thenM` \ mode ->
783 ASSERT( not_op_app mode neg_arg )
785 returnM (NegApp neg_arg neg_name)
787 not_op_app SourceMode (OpApp _ _ _ _) = False
788 not_op_app mode other = True
792 mkConOpPatRn :: Name -> Fixity -> RenamedPat -> RenamedPat
795 mkConOpPatRn op2 fix2 p1@(ConPatIn op1 (InfixCon p11 p12)) p2
796 = lookupFixityRn op1 `thenM` \ fix1 ->
798 (nofix_error, associate_right) = compareFixity fix1 fix2
801 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
802 returnM (ConPatIn op2 (InfixCon p1 p2))
804 if associate_right then
805 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
806 returnM (ConPatIn op1 (InfixCon p11 new_p))
808 returnM (ConPatIn op2 (InfixCon p1 p2))
810 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
811 = ASSERT( not_op_pat p2 )
812 returnM (ConPatIn op (InfixCon p1 p2))
814 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
815 not_op_pat other = True
819 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnM ()
821 checkPrecMatch False fn match
824 checkPrecMatch True op (Match (p1:p2:_) _ _)
825 -- True indicates an infix lhs
826 = getModeRn `thenM` \ mode ->
827 -- See comments with rnExpr (OpApp ...)
828 if isInterfaceMode mode
830 else checkPrec op p1 False `thenM_`
833 checkPrecMatch True op _ = panic "checkPrecMatch"
835 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
836 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
837 lookupFixityRn op1 `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
839 inf_ok = op1_prec > op_prec ||
840 (op1_prec == op_prec &&
841 (op1_dir == InfixR && op_dir == InfixR && right ||
842 op1_dir == InfixL && op_dir == InfixL && not right))
844 info = (ppr_op op, op_fix)
845 info1 = (ppr_op op1, op1_fix)
846 (infol, infor) = if right then (info, info1) else (info1, info)
848 checkErr inf_ok (precParseErr infol infor)
850 checkPrec op pat right
853 -- Check precedence of (arg op) or (op arg) respectively
854 -- If arg is itself an operator application, then either
855 -- (a) its precedence must be higher than that of op
856 -- (b) its precedency & associativity must be the same as that of op
857 checkSectionPrec direction section op arg
859 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
860 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
864 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
865 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
866 checkErr (op_prec < arg_prec
867 || op_prec == arg_prec && direction == assoc)
868 (sectionPrecErr (ppr_op op_name, op_fix)
869 (pp_arg_op, arg_fix) section)
873 %************************************************************************
875 \subsubsection{Literals}
877 %************************************************************************
879 When literals occur we have to make sure
880 that the types and classes they involve
885 = checkErr (inCharRange c) (bogusCharError c) `thenM_`
886 returnM (unitFV charTyCon_name)
888 litFVs (HsCharPrim c) = returnM (unitFV (getName charPrimTyCon))
889 litFVs (HsString s) = returnM (mkFVs [listTyCon_name, charTyCon_name])
890 litFVs (HsStringPrim s) = returnM (unitFV (getName addrPrimTyCon))
891 litFVs (HsInt i) = returnM (unitFV (getName intTyCon))
892 litFVs (HsIntPrim i) = returnM (unitFV (getName intPrimTyCon))
893 litFVs (HsFloatPrim f) = returnM (unitFV (getName floatPrimTyCon))
894 litFVs (HsDoublePrim d) = returnM (unitFV (getName doublePrimTyCon))
895 litFVs (HsLitLit l bogus_ty) = returnM (unitFV cCallableClassName)
896 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
897 -- in post-typechecker translations
899 rnOverLit (HsIntegral i _)
900 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
902 returnM (HsIntegral i from_integer_name, fvs)
904 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
905 -- Big integer literals are built, using + and *,
906 -- out of small integers (DsUtils.mkIntegerLit)
907 -- [NB: plusInteger, timesInteger aren't rebindable...
908 -- they are used to construct the argument to fromInteger,
909 -- which is the rebindable one.]
911 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
913 rnOverLit (HsFractional i _)
914 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
916 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
917 -- We have to make sure that the Ratio type is imported with
918 -- its constructor, because literals of type Ratio t are
919 -- built with that constructor.
920 -- The Rational type is needed too, but that will come in
921 -- as part of the type for fromRational.
922 -- The plus/times integer operations may be needed to construct the numerator
923 -- and denominator (see DsUtils.mkIntegerLit)
925 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
928 %************************************************************************
930 \subsubsection{Assertion utils}
932 %************************************************************************
935 mkAssertErrorExpr :: RnM (RenamedHsExpr, FreeVars)
936 -- Return an expression for (assertError "Foo.hs:27")
938 = getSrcLocM `thenM` \ sloc ->
940 expr = HsApp (HsVar assertErrorName) (HsLit msg)
941 msg = HsStringPrim (mkFastString (stringToUtf8 (showSDoc (ppr sloc))))
943 returnM (expr, unitFV assertErrorName)
946 %************************************************************************
948 \subsubsection{Errors}
950 %************************************************************************
953 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
954 pp_prefix_minus = ptext SLIT("prefix `-'")
956 dupFieldErr str (dup:rest)
957 = hsep [ptext SLIT("duplicate field name"),
959 ptext SLIT("in record"), text str]
963 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
967 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
968 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
971 = sep [ptext SLIT("Pattern syntax in expression context:"),
975 = ptext SLIT("Template Haskell") <+> text what <+>
976 ptext SLIT("illegal in a stage-1 compiler")
979 = sep [ptext SLIT("`do' statements must end in expression:"),
983 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
986 = sep [quotes (ptext SLIT("with")),
987 ptext SLIT("is deprecated, use"),
988 quotes (ptext SLIT("let")),
989 ptext SLIT("instead")]