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, assertName,
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 then
296 -- We expand it to (GHCerr.assert__ location)
300 returnM (HsVar name, unitFV name)
303 = newIPName v `thenM` \ name ->
306 Linear _ -> mkFVs [splitName, fstName, sndName]
307 Dupable _ -> emptyFVs
309 returnM (HsIPVar name, fvs)
312 = litFVs lit `thenM` \ fvs ->
313 returnM (HsLit lit, fvs)
315 rnExpr (HsOverLit lit)
316 = rnOverLit lit `thenM` \ (lit', fvs) ->
317 returnM (HsOverLit lit', fvs)
320 = rnMatch LambdaExpr match `thenM` \ (match', fvMatch) ->
321 returnM (HsLam match', fvMatch)
323 rnExpr (HsApp fun arg)
324 = rnExpr fun `thenM` \ (fun',fvFun) ->
325 rnExpr arg `thenM` \ (arg',fvArg) ->
326 returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
328 rnExpr (OpApp e1 op _ e2)
329 = rnExpr e1 `thenM` \ (e1', fv_e1) ->
330 rnExpr e2 `thenM` \ (e2', fv_e2) ->
331 rnExpr op `thenM` \ (op'@(HsVar op_name), fv_op) ->
334 -- When renaming code synthesised from "deriving" declarations
335 -- we're in Interface mode, and we should ignore fixity; assume
336 -- that the deriving code generator got the association correct
337 -- Don't even look up the fixity when in interface mode
338 getModeRn `thenM` \ mode ->
339 (if isInterfaceMode mode
340 then returnM (OpApp e1' op' defaultFixity e2')
341 else lookupFixityRn op_name `thenM` \ fixity ->
342 mkOpAppRn e1' op' fixity e2'
343 ) `thenM` \ final_e ->
346 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
349 = rnExpr e `thenM` \ (e', fv_e) ->
350 lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
351 mkNegAppRn e' neg_name `thenM` \ final_e ->
352 returnM (final_e, fv_e `plusFV` fv_neg)
355 = rnExpr e `thenM` \ (e', fvs_e) ->
356 returnM (HsPar e', fvs_e)
358 -- Template Haskell extensions
359 rnExpr (HsBracket br_body)
360 = checkGHCI (thErr "bracket") `thenM_`
361 rnBracket br_body `thenM` \ (body', fvs_e) ->
362 returnM (HsBracket body', fvs_e `addOneFV` qTyConName)
363 -- We use the Q tycon as a proxy to haul in all the smart
364 -- constructors; see the hack in RnIfaces
366 rnExpr (HsSplice n e)
367 = checkGHCI (thErr "splice") `thenM_`
368 getSrcLocM `thenM` \ loc ->
369 newLocalsRn [(n,loc)] `thenM` \ [n'] ->
370 rnExpr e `thenM` \ (e', fvs_e) ->
371 returnM (HsSplice n' e', fvs_e)
373 rnExpr section@(SectionL expr op)
374 = rnExpr expr `thenM` \ (expr', fvs_expr) ->
375 rnExpr op `thenM` \ (op', fvs_op) ->
376 checkSectionPrec InfixL section op' expr' `thenM_`
377 returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
379 rnExpr section@(SectionR op expr)
380 = rnExpr op `thenM` \ (op', fvs_op) ->
381 rnExpr expr `thenM` \ (expr', fvs_expr) ->
382 checkSectionPrec InfixR section op' expr' `thenM_`
383 returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
385 rnExpr (HsCCall fun args may_gc is_casm _)
386 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
387 = rnExprs args `thenM` \ (args', fvs_args) ->
388 returnM (HsCCall fun args' may_gc is_casm placeHolderType,
389 fvs_args `plusFV` mkFVs [cCallableClassName,
390 cReturnableClassName,
393 rnExpr (HsSCC lbl expr)
394 = rnExpr expr `thenM` \ (expr', fvs_expr) ->
395 returnM (HsSCC lbl expr', fvs_expr)
397 rnExpr (HsCase expr ms src_loc)
398 = addSrcLoc src_loc $
399 rnExpr expr `thenM` \ (new_expr, e_fvs) ->
400 mapFvRn (rnMatch CaseAlt) ms `thenM` \ (new_ms, ms_fvs) ->
401 returnM (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
403 rnExpr (HsLet binds expr)
404 = rnBinds binds $ \ binds' ->
405 rnExpr expr `thenM` \ (expr',fvExpr) ->
406 returnM (HsLet binds' expr', fvExpr)
408 rnExpr (HsWith expr binds is_with)
409 = warnIf is_with withWarning `thenM_`
410 rnExpr expr `thenM` \ (expr',fvExpr) ->
411 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
412 returnM (HsWith expr' binds' is_with, fvExpr `plusFV` fvBinds)
414 rnExpr e@(HsDo do_or_lc stmts _ ty src_loc)
415 = addSrcLoc src_loc $
416 rnStmts stmts `thenM` \ ((_, stmts'), fvs) ->
418 -- Check the statement list ends in an expression
419 case last stmts' of {
420 ResultStmt _ _ -> returnM () ;
421 _ -> addErr (doStmtListErr e)
424 -- Generate the rebindable syntax for the monad
426 DoExpr -> mapAndUnzipM lookupSyntaxName monadNames
427 other -> returnM ([], [])
428 ) `thenM` \ (monad_names', monad_fvs) ->
430 returnM (HsDo do_or_lc stmts' monad_names' placeHolderType src_loc,
431 fvs `plusFV` implicit_fvs `plusFV` plusFVs monad_fvs)
433 implicit_fvs = case do_or_lc of
434 PArrComp -> mkFVs [replicatePName, mapPName, filterPName,
435 crossPName, zipPName]
436 ListComp -> mkFVs [foldrName, buildName]
439 rnExpr (ExplicitList _ exps)
440 = rnExprs exps `thenM` \ (exps', fvs) ->
441 returnM (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
443 rnExpr (ExplicitPArr _ exps)
444 = rnExprs exps `thenM` \ (exps', fvs) ->
445 returnM (ExplicitPArr placeHolderType exps',
446 fvs `addOneFV` toPName `addOneFV` parrTyCon_name)
448 rnExpr (ExplicitTuple exps boxity)
449 = rnExprs exps `thenM` \ (exps', fvs) ->
450 returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
452 tycon_name = tupleTyCon_name boxity (length exps)
454 rnExpr (RecordCon con_id rbinds)
455 = lookupOccRn con_id `thenM` \ conname ->
456 rnRbinds "construction" rbinds `thenM` \ (rbinds', fvRbinds) ->
457 returnM (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
459 rnExpr (RecordUpd expr rbinds)
460 = rnExpr expr `thenM` \ (expr', fvExpr) ->
461 rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) ->
462 returnM (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
464 rnExpr (ExprWithTySig expr pty)
465 = rnExpr expr `thenM` \ (expr', fvExpr) ->
466 rnHsTypeFVs doc pty `thenM` \ (pty', fvTy) ->
467 returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
469 doc = text "In an expression type signature"
471 rnExpr (HsIf p b1 b2 src_loc)
472 = addSrcLoc src_loc $
473 rnExpr p `thenM` \ (p', fvP) ->
474 rnExpr b1 `thenM` \ (b1', fvB1) ->
475 rnExpr b2 `thenM` \ (b2', fvB2) ->
476 returnM (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
479 = rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
480 returnM (HsType t, fvT)
482 doc = text "In a type argument"
484 rnExpr (ArithSeqIn seq)
485 = rn_seq seq `thenM` \ (new_seq, fvs) ->
486 returnM (ArithSeqIn new_seq, fvs `addOneFV` enumClassName)
489 = rnExpr expr `thenM` \ (expr', fvExpr) ->
490 returnM (From expr', fvExpr)
492 rn_seq (FromThen expr1 expr2)
493 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
494 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
495 returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
497 rn_seq (FromTo expr1 expr2)
498 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
499 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
500 returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
502 rn_seq (FromThenTo expr1 expr2 expr3)
503 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
504 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
505 rnExpr expr3 `thenM` \ (expr3', fvExpr3) ->
506 returnM (FromThenTo expr1' expr2' expr3',
507 plusFVs [fvExpr1, fvExpr2, fvExpr3])
509 rnExpr (PArrSeqIn seq)
510 = rn_seq seq `thenM` \ (new_seq, fvs) ->
511 returnM (PArrSeqIn new_seq,
512 fvs `plusFV` mkFVs [enumFromToPName, enumFromThenToPName])
515 -- the parser shouldn't generate these two
517 rn_seq (From _ ) = panic "RnExpr.rnExpr: Infinite parallel array!"
518 rn_seq (FromThen _ _) = panic "RnExpr.rnExpr: Infinite parallel array!"
520 rn_seq (FromTo expr1 expr2)
521 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
522 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
523 returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
524 rn_seq (FromThenTo expr1 expr2 expr3)
525 = rnExpr expr1 `thenM` \ (expr1', fvExpr1) ->
526 rnExpr expr2 `thenM` \ (expr2', fvExpr2) ->
527 rnExpr expr3 `thenM` \ (expr3', fvExpr3) ->
528 returnM (FromThenTo expr1' expr2' expr3',
529 plusFVs [fvExpr1, fvExpr2, fvExpr3])
532 These three are pattern syntax appearing in expressions.
533 Since all the symbols are reservedops we can simply reject them.
534 We return a (bogus) EWildPat in each case.
537 rnExpr e@EWildPat = addErr (patSynErr e) `thenM_`
538 returnM (EWildPat, emptyFVs)
540 rnExpr e@(EAsPat _ _) = addErr (patSynErr e) `thenM_`
541 returnM (EWildPat, emptyFVs)
543 rnExpr e@(ELazyPat _) = addErr (patSynErr e) `thenM_`
544 returnM (EWildPat, emptyFVs)
549 %************************************************************************
551 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
553 %************************************************************************
557 = mappM_ field_dup_err dup_fields `thenM_`
558 mapFvRn rn_rbind rbinds `thenM` \ (rbinds', fvRbind) ->
559 returnM (rbinds', fvRbind)
561 (_, dup_fields) = removeDups compare [ f | (f,_) <- rbinds ]
563 field_dup_err dups = addErr (dupFieldErr str dups)
565 rn_rbind (field, expr)
566 = lookupGlobalOccRn field `thenM` \ fieldname ->
567 rnExpr expr `thenM` \ (expr', fvExpr) ->
568 returnM ((fieldname, expr'), fvExpr `addOneFV` fieldname)
571 = mappM_ field_dup_err dup_fields `thenM_`
572 mapFvRn rn_rpat rpats `thenM` \ (rpats', fvs) ->
573 returnM (rpats', fvs)
575 (_, dup_fields) = removeDups compare [ f | (f,_) <- rpats ]
577 field_dup_err dups = addErr (dupFieldErr "pattern" dups)
580 = lookupGlobalOccRn field `thenM` \ fieldname ->
581 rnPat pat `thenM` \ (pat', fvs) ->
582 returnM ((fieldname, pat'), fvs `addOneFV` fieldname)
585 %************************************************************************
587 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
589 %************************************************************************
592 rnIPBinds [] = returnM ([], emptyFVs)
593 rnIPBinds ((n, expr) : binds)
594 = newIPName n `thenM` \ name ->
595 rnExpr expr `thenM` \ (expr',fvExpr) ->
596 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
597 returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
601 %************************************************************************
603 Template Haskell brackets
605 %************************************************************************
608 rnBracket (ExpBr e) = rnExpr e `thenM` \ (e', fvs) ->
609 returnM (ExpBr e', fvs)
610 rnBracket (PatBr p) = rnPat p `thenM` \ (p', fvs) ->
611 returnM (PatBr p', fvs)
612 rnBracket (TypBr t) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
613 returnM (TypBr t', fvs)
615 doc = ptext SLIT("In a Template-Haskell quoted type")
616 rnBracket (DecBr ds) = rnSrcDecls ds `thenM` \ (tcg_env, ds', fvs) ->
617 -- Discard the tcg_env; it contains the extended global RdrEnv
618 -- because there is no scope that these decls cover (yet!)
619 returnM (DecBr ds', fvs)
622 %************************************************************************
624 \subsubsection{@Stmt@s: in @do@ expressions}
626 %************************************************************************
628 Note that although some bound vars may appear in the free var set for
629 the first qual, these will eventually be removed by the caller. For
630 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
631 @[q <- r, p <- q]@, the free var set for @q <- r@ will
632 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
633 @r@ will be removed only when we finally return from examining all the
637 rnStmts :: [RdrNameStmt]
638 -> RnM (([Name], [RenamedStmt]), FreeVars)
641 = returnM (([], []), emptyFVs)
644 = getLocalRdrEnv `thenM` \ name_env ->
645 rnStmt stmt $ \ stmt' ->
646 rnStmts stmts `thenM` \ ((binders, stmts'), fvs) ->
647 returnM ((binders, stmt' : stmts'), fvs)
649 rnStmt :: RdrNameStmt
650 -> (RenamedStmt -> RnM (([Name], a), FreeVars))
651 -> RnM (([Name], a), FreeVars)
652 -- The thing list of names returned is the list returned by the
653 -- thing_inside, plus the binders of the arguments stmt
655 rnStmt (ParStmt stmtss) thing_inside
656 = mapFvRn rnStmts stmtss `thenM` \ (bndrstmtss, fv_stmtss) ->
657 let binderss = map fst bndrstmtss
658 checkBndrs all_bndrs bndrs
659 = checkErr (null (intersectBy eqOcc all_bndrs bndrs)) err `thenM_`
660 returnM (bndrs ++ all_bndrs)
661 eqOcc n1 n2 = nameOccName n1 == nameOccName n2
662 err = text "duplicate binding in parallel list comprehension"
664 foldlM checkBndrs [] binderss `thenM` \ new_binders ->
665 bindLocalNamesFV new_binders $
666 thing_inside (ParStmtOut bndrstmtss)`thenM` \ ((rest_bndrs, result), fv_rest) ->
667 returnM ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
669 rnStmt (BindStmt pat expr src_loc) thing_inside
670 = addSrcLoc src_loc $
671 rnExpr expr `thenM` \ (expr', fv_expr) ->
672 bindPatSigTyVars (collectSigTysFromPat pat) $
673 bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
674 rnPat pat `thenM` \ (pat', fv_pat) ->
675 thing_inside (BindStmt pat' expr' src_loc) `thenM` \ ((rest_binders, result), fvs) ->
676 returnM ((new_binders ++ rest_binders, result),
677 fv_expr `plusFV` fvs `plusFV` fv_pat)
679 doc = text "In a pattern in 'do' binding"
681 rnStmt (ExprStmt expr _ src_loc) thing_inside
682 = addSrcLoc src_loc $
683 rnExpr expr `thenM` \ (expr', fv_expr) ->
684 thing_inside (ExprStmt expr' placeHolderType src_loc) `thenM` \ (result, fvs) ->
685 returnM (result, fv_expr `plusFV` fvs)
687 rnStmt (ResultStmt expr src_loc) thing_inside
688 = addSrcLoc src_loc $
689 rnExpr expr `thenM` \ (expr', fv_expr) ->
690 thing_inside (ResultStmt expr' src_loc) `thenM` \ (result, fvs) ->
691 returnM (result, fv_expr `plusFV` fvs)
693 rnStmt (LetStmt binds) thing_inside
694 = rnBinds binds $ \ binds' ->
695 let new_binders = collectHsBinders binds' in
696 thing_inside (LetStmt binds') `thenM` \ ((rest_binders, result), fvs) ->
697 returnM ((new_binders ++ rest_binders, result), fvs )
700 %************************************************************************
702 \subsubsection{Precedence Parsing}
704 %************************************************************************
706 @mkOpAppRn@ deals with operator fixities. The argument expressions
707 are assumed to be already correctly arranged. It needs the fixities
708 recorded in the OpApp nodes, because fixity info applies to the things
709 the programmer actually wrote, so you can't find it out from the Name.
711 Furthermore, the second argument is guaranteed not to be another
712 operator application. Why? Because the parser parses all
713 operator appications left-associatively, EXCEPT negation, which
714 we need to handle specially.
717 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
718 -> RenamedHsExpr -> Fixity -- Operator and fixity
719 -> RenamedHsExpr -- Right operand (not an OpApp, but might
723 ---------------------------
724 -- (e11 `op1` e12) `op2` e2
725 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
727 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
728 returnM (OpApp e1 op2 fix2 e2)
731 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
732 returnM (OpApp e11 op1 fix1 new_e)
734 (nofix_error, associate_right) = compareFixity fix1 fix2
736 ---------------------------
737 -- (- neg_arg) `op` e2
738 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
740 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
741 returnM (OpApp e1 op2 fix2 e2)
744 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
745 returnM (NegApp new_e neg_name)
747 (nofix_error, associate_right) = compareFixity negateFixity fix2
749 ---------------------------
751 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
752 | not associate_right -- We *want* right association
753 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
754 returnM (OpApp e1 op1 fix1 e2)
756 (_, associate_right) = compareFixity fix1 negateFixity
758 ---------------------------
760 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
761 = ASSERT2( right_op_ok fix e2,
762 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
764 returnM (OpApp e1 op fix e2)
766 -- Parser left-associates everything, but
767 -- derived instances may have correctly-associated things to
768 -- in the right operarand. So we just check that the right operand is OK
769 right_op_ok fix1 (OpApp _ _ fix2 _)
770 = not error_please && associate_right
772 (error_please, associate_right) = compareFixity fix1 fix2
773 right_op_ok fix1 other
776 -- Parser initially makes negation bind more tightly than any other operator
777 mkNegAppRn neg_arg neg_name
780 getModeRn `thenM` \ mode ->
781 ASSERT( not_op_app mode neg_arg )
783 returnM (NegApp neg_arg neg_name)
785 not_op_app SourceMode (OpApp _ _ _ _) = False
786 not_op_app mode other = True
790 mkConOpPatRn :: Name -> Fixity -> RenamedPat -> RenamedPat
793 mkConOpPatRn op2 fix2 p1@(ConPatIn op1 (InfixCon p11 p12)) p2
794 = lookupFixityRn op1 `thenM` \ fix1 ->
796 (nofix_error, associate_right) = compareFixity fix1 fix2
799 addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
800 returnM (ConPatIn op2 (InfixCon p1 p2))
802 if associate_right then
803 mkConOpPatRn op2 fix2 p12 p2 `thenM` \ new_p ->
804 returnM (ConPatIn op1 (InfixCon p11 new_p))
806 returnM (ConPatIn op2 (InfixCon p1 p2))
808 mkConOpPatRn op fix p1 p2 -- Default case, no rearrangment
809 = ASSERT( not_op_pat p2 )
810 returnM (ConPatIn op (InfixCon p1 p2))
812 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
813 not_op_pat other = True
817 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnM ()
819 checkPrecMatch False fn match
822 checkPrecMatch True op (Match (p1:p2:_) _ _)
823 -- True indicates an infix lhs
824 = getModeRn `thenM` \ mode ->
825 -- See comments with rnExpr (OpApp ...)
826 if isInterfaceMode mode
828 else checkPrec op p1 False `thenM_`
831 checkPrecMatch True op _ = panic "checkPrecMatch"
833 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
834 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
835 lookupFixityRn op1 `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
837 inf_ok = op1_prec > op_prec ||
838 (op1_prec == op_prec &&
839 (op1_dir == InfixR && op_dir == InfixR && right ||
840 op1_dir == InfixL && op_dir == InfixL && not right))
842 info = (ppr_op op, op_fix)
843 info1 = (ppr_op op1, op1_fix)
844 (infol, infor) = if right then (info, info1) else (info1, info)
846 checkErr inf_ok (precParseErr infol infor)
848 checkPrec op pat right
851 -- Check precedence of (arg op) or (op arg) respectively
852 -- If arg is itself an operator application, then either
853 -- (a) its precedence must be higher than that of op
854 -- (b) its precedency & associativity must be the same as that of op
855 checkSectionPrec direction section op arg
857 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
858 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
862 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
863 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
864 checkErr (op_prec < arg_prec
865 || op_prec == arg_prec && direction == assoc)
866 (sectionPrecErr (ppr_op op_name, op_fix)
867 (pp_arg_op, arg_fix) section)
871 %************************************************************************
873 \subsubsection{Literals}
875 %************************************************************************
877 When literals occur we have to make sure
878 that the types and classes they involve
883 = checkErr (inCharRange c) (bogusCharError c) `thenM_`
884 returnM (unitFV charTyCon_name)
886 litFVs (HsCharPrim c) = returnM (unitFV (getName charPrimTyCon))
887 litFVs (HsString s) = returnM (mkFVs [listTyCon_name, charTyCon_name])
888 litFVs (HsStringPrim s) = returnM (unitFV (getName addrPrimTyCon))
889 litFVs (HsInt i) = returnM (unitFV (getName intTyCon))
890 litFVs (HsIntPrim i) = returnM (unitFV (getName intPrimTyCon))
891 litFVs (HsFloatPrim f) = returnM (unitFV (getName floatPrimTyCon))
892 litFVs (HsDoublePrim d) = returnM (unitFV (getName doublePrimTyCon))
893 litFVs (HsLitLit l bogus_ty) = returnM (unitFV cCallableClassName)
894 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
895 -- in post-typechecker translations
897 rnOverLit (HsIntegral i _)
898 = lookupSyntaxName fromIntegerName `thenM` \ (from_integer_name, fvs) ->
900 returnM (HsIntegral i from_integer_name, fvs)
902 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
903 -- Big integer literals are built, using + and *,
904 -- out of small integers (DsUtils.mkIntegerLit)
905 -- [NB: plusInteger, timesInteger aren't rebindable...
906 -- they are used to construct the argument to fromInteger,
907 -- which is the rebindable one.]
909 returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
911 rnOverLit (HsFractional i _)
912 = lookupSyntaxName fromRationalName `thenM` \ (from_rat_name, fvs) ->
914 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
915 -- We have to make sure that the Ratio type is imported with
916 -- its constructor, because literals of type Ratio t are
917 -- built with that constructor.
918 -- The Rational type is needed too, but that will come in
919 -- as part of the type for fromRational.
920 -- The plus/times integer operations may be needed to construct the numerator
921 -- and denominator (see DsUtils.mkIntegerLit)
923 returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
926 %************************************************************************
928 \subsubsection{Assertion utils}
930 %************************************************************************
933 mkAssertExpr :: RnM (RenamedHsExpr, FreeVars)
935 = getSrcLocM `thenM` \ sloc ->
937 -- if we're ignoring asserts, return (\ _ e -> e)
938 -- if not, return (assertError "src-loc")
940 if opt_IgnoreAsserts then
941 newUnique `thenM` \ uniq ->
943 vname = mkSystemName uniq FSLIT("v")
944 expr = HsLam ignorePredMatch
945 loc = nameSrcLoc vname
946 ignorePredMatch = mkSimpleMatch [WildPat placeHolderType, VarPat vname]
947 (HsVar vname) placeHolderType loc
949 returnM (expr, emptyFVs)
953 HsApp (HsVar assertName)
954 (HsLit (HsStringPrim (mkFastString (stringToUtf8 (showSDoc (ppr sloc))))))
956 returnM (expr, unitFV assertName)
959 %************************************************************************
961 \subsubsection{Errors}
963 %************************************************************************
966 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
967 pp_prefix_minus = ptext SLIT("prefix `-'")
969 dupFieldErr str (dup:rest)
970 = hsep [ptext SLIT("duplicate field name"),
972 ptext SLIT("in record"), text str]
976 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
980 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
981 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
984 = sep [ptext SLIT("Pattern syntax in expression context:"),
988 = ptext SLIT("Template Haskell") <+> text what <+>
989 ptext SLIT("illegal in a stage-1 compiler")
992 = sep [ptext SLIT("`do' statements must end in expression:"),
996 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
999 = sep [quotes (ptext SLIT("with")),
1000 ptext SLIT("is deprecated, use"),
1001 quotes (ptext SLIT("let")),
1002 ptext SLIT("instead")]