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, rnStmt,
18 #include "HsVersions.h"
20 import {-# SOURCE #-} RnBinds ( rnBinds )
27 import RnTypes ( rnHsTypeFVs )
28 import RnHiFiles ( lookupFixityRn )
29 import CmdLineOpts ( DynFlag(..), opt_IgnoreAsserts )
30 import Literal ( inIntRange, inCharRange )
31 import BasicTypes ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
32 import PrelNames ( hasKey, assertIdKey,
33 eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
34 cCallableClass_RDR, cReturnableClass_RDR,
35 monadClass_RDR, enumClass_RDR, ordClass_RDR,
36 ratioDataCon_RDR, assertErr_RDR,
37 ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR,
39 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
40 floatPrimTyCon, doublePrimTyCon
42 import TysWiredIn ( intTyCon )
43 import Name ( NamedThing(..), mkSysLocalName, nameSrcLoc )
45 import UniqFM ( isNullUFM )
46 import UniqSet ( emptyUniqSet )
47 import List ( intersectBy )
48 import ListSetOps ( removeDups )
53 *********************************************************
57 *********************************************************
60 rnPat :: RdrNamePat -> RnMS (RenamedPat, FreeVars)
62 rnPat WildPatIn = returnRn (WildPatIn, emptyFVs)
65 = lookupBndrRn name `thenRn` \ vname ->
66 returnRn (VarPatIn vname, emptyFVs)
68 rnPat (SigPatIn pat ty)
69 = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
72 then rnPat pat `thenRn` \ (pat', fvs1) ->
73 rnHsTypeFVs doc ty `thenRn` \ (ty', fvs2) ->
74 returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
76 else addErrRn (patSigErr ty) `thenRn_`
79 doc = text "a pattern type-signature"
81 rnPat (LitPatIn s@(HsString _))
82 = lookupOrigName eqString_RDR `thenRn` \ eq ->
83 returnRn (LitPatIn s, unitFV eq)
86 = litFVs lit `thenRn` \ fvs ->
87 returnRn (LitPatIn lit, fvs)
90 = rnOverLit lit `thenRn` \ (lit', fvs1) ->
91 lookupOrigName eqClass_RDR `thenRn` \ eq -> -- Needed to find equality on pattern
92 returnRn (NPatIn lit', fvs1 `addOneFV` eq)
94 rnPat (NPlusKPatIn name lit minus)
95 = rnOverLit lit `thenRn` \ (lit', fvs) ->
96 lookupOrigName ordClass_RDR `thenRn` \ ord ->
97 lookupBndrRn name `thenRn` \ name' ->
98 lookupSyntaxName minus `thenRn` \ minus' ->
99 returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
101 rnPat (LazyPatIn pat)
102 = rnPat pat `thenRn` \ (pat', fvs) ->
103 returnRn (LazyPatIn pat', fvs)
105 rnPat (AsPatIn name pat)
106 = rnPat pat `thenRn` \ (pat', fvs) ->
107 lookupBndrRn name `thenRn` \ vname ->
108 returnRn (AsPatIn vname pat', fvs)
110 rnPat (ConPatIn con pats)
111 = lookupOccRn con `thenRn` \ con' ->
112 mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
113 returnRn (ConPatIn con' patslist, fvs `addOneFV` con')
115 rnPat (ConOpPatIn pat1 con _ pat2)
116 = rnPat pat1 `thenRn` \ (pat1', fvs1) ->
117 lookupOccRn con `thenRn` \ con' ->
118 rnPat pat2 `thenRn` \ (pat2', fvs2) ->
120 getModeRn `thenRn` \ mode ->
121 -- See comments with rnExpr (OpApp ...)
122 (if isInterfaceMode mode
123 then returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
124 else lookupFixityRn con' `thenRn` \ fixity ->
125 mkConOpPatRn pat1' con' fixity pat2'
127 returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
130 = rnPat pat `thenRn` \ (pat', fvs) ->
131 returnRn (ParPatIn pat', fvs)
133 rnPat (ListPatIn pats)
134 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
135 returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
137 rnPat (TuplePatIn pats boxed)
138 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
139 returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
141 tycon_name = tupleTyCon_name boxed (length pats)
143 rnPat (RecPatIn con rpats)
144 = lookupOccRn con `thenRn` \ con' ->
145 rnRpats rpats `thenRn` \ (rpats', fvs) ->
146 returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
148 rnPat (TypePatIn name) =
149 rnHsTypeFVs (text "type pattern") name `thenRn` \ (name', fvs) ->
150 returnRn (TypePatIn name', fvs)
153 ************************************************************************
157 ************************************************************************
160 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
162 rnMatch ctxt match@(Match pats maybe_rhs_sig grhss)
163 = pushSrcLocRn (getMatchLoc match) $
165 -- Bind pattern-bound type variables
167 rhs_sig_tys = case maybe_rhs_sig of
170 pat_sig_tys = collectSigTysFromPats pats
171 doc_sig = text "In a result type-signature"
172 doc_pat = pprMatchContext ctxt
174 bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys) $
176 -- Note that we do a single bindLocalsRn for all the
177 -- matches together, so that we spot the repeated variable in
179 bindLocalsFVRn doc_pat (collectPatsBinders pats) $ \ new_binders ->
181 mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) ->
182 rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) ->
183 doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
184 (case maybe_rhs_sig of
185 Nothing -> returnRn (Nothing, emptyFVs)
186 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenRn` \ (ty', ty_fvs) ->
187 returnRn (Just ty', ty_fvs)
188 | otherwise -> addErrRn (patSigErr ty) `thenRn_`
189 returnRn (Nothing, emptyFVs)
190 ) `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
193 binder_set = mkNameSet new_binders
194 unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
195 all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
197 warnUnusedMatches unused_binders `thenRn_`
199 returnRn (Match pats' maybe_rhs_sig' grhss', all_fvs)
200 -- The bindLocals and bindTyVars will remove the bound FVs
204 %************************************************************************
206 \subsubsection{Guarded right-hand sides (GRHSs)}
208 %************************************************************************
211 rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
213 rnGRHSs (GRHSs grhss binds _)
214 = rnBinds binds $ \ binds' ->
215 mapFvRn rnGRHS grhss `thenRn` \ (grhss', fvGRHSs) ->
216 returnRn (GRHSs grhss' binds' placeHolderType, fvGRHSs)
218 rnGRHS (GRHS guarded locn)
219 = doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
221 (if not (opt_GlasgowExts || is_standard_guard guarded) then
222 addWarnRn (nonStdGuardErr guarded)
227 rnStmts guarded `thenRn` \ ((_, guarded'), fvs) ->
228 returnRn (GRHS guarded' locn, fvs)
230 -- Standard Haskell 1.4 guards are just a single boolean
231 -- expression, rather than a list of qualifiers as in the
233 is_standard_guard [ResultStmt _ _] = True
234 is_standard_guard [ExprStmt _ _ _, ResultStmt _ _] = True
235 is_standard_guard other = False
238 %************************************************************************
240 \subsubsection{Expressions}
242 %************************************************************************
245 rnExprs :: [RdrNameHsExpr] -> RnMS ([RenamedHsExpr], FreeVars)
246 rnExprs ls = rnExprs' ls emptyUniqSet
248 rnExprs' [] acc = returnRn ([], acc)
249 rnExprs' (expr:exprs) acc
250 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
252 -- Now we do a "seq" on the free vars because typically it's small
253 -- or empty, especially in very long lists of constants
255 acc' = acc `plusFV` fvExpr
257 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenRn` \ (exprs', fvExprs) ->
258 returnRn (expr':exprs', fvExprs)
260 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
261 grubby_seqNameSet ns result | isNullUFM ns = result
265 Variables. We look up the variable and return the resulting name.
268 rnExpr :: RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
271 = lookupOccRn v `thenRn` \ name ->
272 if name `hasKey` assertIdKey then
273 -- We expand it to (GHCerr.assert__ location)
277 returnRn (HsVar name, unitFV name)
280 = newIPName v `thenRn` \ name ->
281 returnRn (HsIPVar name, emptyFVs)
284 = litFVs lit `thenRn` \ fvs ->
285 returnRn (HsLit lit, fvs)
287 rnExpr (HsOverLit lit)
288 = rnOverLit lit `thenRn` \ (lit', fvs) ->
289 returnRn (HsOverLit lit', fvs)
292 = rnMatch LambdaExpr match `thenRn` \ (match', fvMatch) ->
293 returnRn (HsLam match', fvMatch)
295 rnExpr (HsApp fun arg)
296 = rnExpr fun `thenRn` \ (fun',fvFun) ->
297 rnExpr arg `thenRn` \ (arg',fvArg) ->
298 returnRn (HsApp fun' arg', fvFun `plusFV` fvArg)
300 rnExpr (OpApp e1 op _ e2)
301 = rnExpr e1 `thenRn` \ (e1', fv_e1) ->
302 rnExpr e2 `thenRn` \ (e2', fv_e2) ->
303 rnExpr op `thenRn` \ (op'@(HsVar op_name), fv_op) ->
306 -- When renaming code synthesised from "deriving" declarations
307 -- we're in Interface mode, and we should ignore fixity; assume
308 -- that the deriving code generator got the association correct
309 -- Don't even look up the fixity when in interface mode
310 getModeRn `thenRn` \ mode ->
311 (if isInterfaceMode mode
312 then returnRn (OpApp e1' op' defaultFixity e2')
313 else lookupFixityRn op_name `thenRn` \ fixity ->
314 mkOpAppRn e1' op' fixity e2'
315 ) `thenRn` \ final_e ->
318 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
320 rnExpr (NegApp e neg_name)
321 = rnExpr e `thenRn` \ (e', fv_e) ->
322 lookupSyntaxName neg_name `thenRn` \ neg_name' ->
323 mkNegAppRn e' neg_name' `thenRn` \ final_e ->
324 returnRn (final_e, fv_e `addOneFV` neg_name')
327 = rnExpr e `thenRn` \ (e', fvs_e) ->
328 returnRn (HsPar e', fvs_e)
330 rnExpr section@(SectionL expr op)
331 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
332 rnExpr op `thenRn` \ (op', fvs_op) ->
333 checkSectionPrec "left" section op' expr' `thenRn_`
334 returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
336 rnExpr section@(SectionR op expr)
337 = rnExpr op `thenRn` \ (op', fvs_op) ->
338 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
339 checkSectionPrec "right" section op' expr' `thenRn_`
340 returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
342 rnExpr (HsCCall fun args may_gc is_casm _)
343 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
344 = lookupOrigNames [cCallableClass_RDR,
345 cReturnableClass_RDR,
346 ioDataCon_RDR] `thenRn` \ implicit_fvs ->
347 rnExprs args `thenRn` \ (args', fvs_args) ->
348 returnRn (HsCCall fun args' may_gc is_casm placeHolderType,
349 fvs_args `plusFV` implicit_fvs)
351 rnExpr (HsSCC lbl expr)
352 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
353 returnRn (HsSCC lbl expr', fvs_expr)
355 rnExpr (HsCase expr ms src_loc)
356 = pushSrcLocRn src_loc $
357 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
358 mapFvRn (rnMatch CaseAlt) ms `thenRn` \ (new_ms, ms_fvs) ->
359 returnRn (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
361 rnExpr (HsLet binds expr)
362 = rnBinds binds $ \ binds' ->
363 rnExpr expr `thenRn` \ (expr',fvExpr) ->
364 returnRn (HsLet binds' expr', fvExpr)
366 rnExpr (HsWith expr binds)
367 = rnExpr expr `thenRn` \ (expr',fvExpr) ->
368 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
369 returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
371 rnExpr e@(HsDo do_or_lc stmts src_loc)
372 = pushSrcLocRn src_loc $
373 lookupOrigNames implicit_rdr_names `thenRn` \ implicit_fvs ->
374 rnStmts stmts `thenRn` \ ((_, stmts'), fvs) ->
375 -- check the statement list ends in an expression
376 case last stmts' of {
377 ResultStmt _ _ -> returnRn () ;
378 _ -> addErrRn (doStmtListErr e)
380 returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
382 implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
383 -- Monad stuff should not be necessary for a list comprehension
384 -- but the typechecker looks up the bind and return Ids anyway
388 rnExpr (ExplicitList _ exps)
389 = rnExprs exps `thenRn` \ (exps', fvs) ->
390 returnRn (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
392 rnExpr (ExplicitTuple exps boxity)
393 = rnExprs exps `thenRn` \ (exps', fvs) ->
394 returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
396 tycon_name = tupleTyCon_name boxity (length exps)
398 rnExpr (RecordCon con_id rbinds)
399 = lookupOccRn con_id `thenRn` \ conname ->
400 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
401 returnRn (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
403 rnExpr (RecordUpd expr rbinds)
404 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
405 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
406 returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
408 rnExpr (ExprWithTySig expr pty)
409 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
410 rnHsTypeFVs (text "an expression type signature") pty `thenRn` \ (pty', fvTy) ->
411 returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
413 rnExpr (HsIf p b1 b2 src_loc)
414 = pushSrcLocRn src_loc $
415 rnExpr p `thenRn` \ (p', fvP) ->
416 rnExpr b1 `thenRn` \ (b1', fvB1) ->
417 rnExpr b2 `thenRn` \ (b2', fvB2) ->
418 returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
421 = rnHsTypeFVs doc a `thenRn` \ (t, fvT) ->
422 returnRn (HsType t, fvT)
424 doc = text "renaming a type pattern"
426 rnExpr (ArithSeqIn seq)
427 = lookupOrigName enumClass_RDR `thenRn` \ enum ->
428 rn_seq seq `thenRn` \ (new_seq, fvs) ->
429 returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
432 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
433 returnRn (From expr', fvExpr)
435 rn_seq (FromThen expr1 expr2)
436 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
437 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
438 returnRn (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
440 rn_seq (FromTo expr1 expr2)
441 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
442 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
443 returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
445 rn_seq (FromThenTo expr1 expr2 expr3)
446 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
447 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
448 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
449 returnRn (FromThenTo expr1' expr2' expr3',
450 plusFVs [fvExpr1, fvExpr2, fvExpr3])
453 These three are pattern syntax appearing in expressions.
454 Since all the symbols are reservedops we can simply reject them.
455 We return a (bogus) EWildPat in each case.
458 rnExpr e@EWildPat = addErrRn (patSynErr e) `thenRn_`
459 returnRn (EWildPat, emptyFVs)
461 rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e) `thenRn_`
462 returnRn (EWildPat, emptyFVs)
464 rnExpr e@(ELazyPat _) = addErrRn (patSynErr e) `thenRn_`
465 returnRn (EWildPat, emptyFVs)
470 %************************************************************************
472 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
474 %************************************************************************
478 = mapRn_ field_dup_err dup_fields `thenRn_`
479 mapFvRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind) ->
480 returnRn (rbinds', fvRbind)
482 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rbinds ]
484 field_dup_err dups = addErrRn (dupFieldErr str dups)
486 rn_rbind (field, expr, pun)
487 = lookupGlobalOccRn field `thenRn` \ fieldname ->
488 rnExpr expr `thenRn` \ (expr', fvExpr) ->
489 returnRn ((fieldname, expr', pun), fvExpr `addOneFV` fieldname)
492 = mapRn_ field_dup_err dup_fields `thenRn_`
493 mapFvRn rn_rpat rpats `thenRn` \ (rpats', fvs) ->
494 returnRn (rpats', fvs)
496 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rpats ]
498 field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
500 rn_rpat (field, pat, pun)
501 = lookupGlobalOccRn field `thenRn` \ fieldname ->
502 rnPat pat `thenRn` \ (pat', fvs) ->
503 returnRn ((fieldname, pat', pun), fvs `addOneFV` fieldname)
506 %************************************************************************
508 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
510 %************************************************************************
513 rnIPBinds [] = returnRn ([], emptyFVs)
514 rnIPBinds ((n, expr) : binds)
515 = newIPName n `thenRn` \ name ->
516 rnExpr expr `thenRn` \ (expr',fvExpr) ->
517 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
518 returnRn ((name, expr') : binds', fvExpr `plusFV` fvBinds)
522 %************************************************************************
524 \subsubsection{@Stmt@s: in @do@ expressions}
526 %************************************************************************
528 Note that although some bound vars may appear in the free var set for
529 the first qual, these will eventually be removed by the caller. For
530 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
531 @[q <- r, p <- q]@, the free var set for @q <- r@ will
532 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
533 @r@ will be removed only when we finally return from examining all the
537 rnStmts :: [RdrNameStmt]
538 -> RnMS (([Name], [RenamedStmt]), FreeVars)
541 = returnRn (([], []), emptyFVs)
544 = getLocalNameEnv `thenRn` \ name_env ->
545 rnStmt stmt $ \ stmt' ->
546 rnStmts stmts `thenRn` \ ((binders, stmts'), fvs) ->
547 returnRn ((binders, stmt' : stmts'), fvs)
549 rnStmt :: RdrNameStmt
550 -> (RenamedStmt -> RnMS (([Name], a), FreeVars))
551 -> RnMS (([Name], a), FreeVars)
552 -- The thing list of names returned is the list returned by the
553 -- thing_inside, plus the binders of the arguments stmt
555 -- Because of mutual recursion we have to pass in rnExpr.
557 rnStmt (ParStmt stmtss) thing_inside
558 = mapFvRn rnStmts stmtss `thenRn` \ (bndrstmtss, fv_stmtss) ->
559 let binderss = map fst bndrstmtss
560 checkBndrs all_bndrs bndrs
561 = checkRn (null (intersectBy eqOcc all_bndrs bndrs)) err `thenRn_`
562 returnRn (bndrs ++ all_bndrs)
563 eqOcc n1 n2 = nameOccName n1 == nameOccName n2
564 err = text "duplicate binding in parallel list comprehension"
566 foldlRn checkBndrs [] binderss `thenRn` \ new_binders ->
567 bindLocalNamesFV new_binders $
568 thing_inside (ParStmtOut bndrstmtss)`thenRn` \ ((rest_bndrs, result), fv_rest) ->
569 returnRn ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
571 rnStmt (BindStmt pat expr src_loc) thing_inside
572 = pushSrcLocRn src_loc $
573 rnExpr expr `thenRn` \ (expr', fv_expr) ->
574 bindPatSigTyVars (collectSigTysFromPat pat) $
575 bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
576 rnPat pat `thenRn` \ (pat', fv_pat) ->
577 thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ ((rest_binders, result), fvs) ->
578 returnRn ((new_binders ++ rest_binders, result),
579 fv_expr `plusFV` fvs `plusFV` fv_pat)
581 doc = text "In a pattern in 'do' binding"
583 rnStmt (ExprStmt expr _ src_loc) thing_inside
584 = pushSrcLocRn src_loc $
585 rnExpr expr `thenRn` \ (expr', fv_expr) ->
586 thing_inside (ExprStmt expr' placeHolderType src_loc) `thenRn` \ (result, fvs) ->
587 returnRn (result, fv_expr `plusFV` fvs)
589 rnStmt (ResultStmt expr src_loc) thing_inside
590 = pushSrcLocRn src_loc $
591 rnExpr expr `thenRn` \ (expr', fv_expr) ->
592 thing_inside (ResultStmt expr' src_loc) `thenRn` \ (result, fvs) ->
593 returnRn (result, fv_expr `plusFV` fvs)
595 rnStmt (LetStmt binds) thing_inside
596 = rnBinds binds $ \ binds' ->
597 let new_binders = collectHsBinders binds' in
598 thing_inside (LetStmt binds') `thenRn` \ ((rest_binders, result), fvs) ->
599 returnRn ((new_binders ++ rest_binders, result), fvs )
602 %************************************************************************
604 \subsubsection{Precedence Parsing}
606 %************************************************************************
608 @mkOpAppRn@ deals with operator fixities. The argument expressions
609 are assumed to be already correctly arranged. It needs the fixities
610 recorded in the OpApp nodes, because fixity info applies to the things
611 the programmer actually wrote, so you can't find it out from the Name.
613 Furthermore, the second argument is guaranteed not to be another
614 operator application. Why? Because the parser parses all
615 operator appications left-associatively, EXCEPT negation, which
616 we need to handle specially.
619 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
620 -> RenamedHsExpr -> Fixity -- Operator and fixity
621 -> RenamedHsExpr -- Right operand (not an OpApp, but might
623 -> RnMS RenamedHsExpr
625 ---------------------------
626 -- (e11 `op1` e12) `op2` e2
627 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
629 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
630 returnRn (OpApp e1 op2 fix2 e2)
633 = mkOpAppRn e12 op2 fix2 e2 `thenRn` \ new_e ->
634 returnRn (OpApp e11 op1 fix1 new_e)
636 (nofix_error, associate_right) = compareFixity fix1 fix2
638 ---------------------------
639 -- (- neg_arg) `op` e2
640 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
642 = addErrRn (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenRn_`
643 returnRn (OpApp e1 op2 fix2 e2)
646 = mkOpAppRn neg_arg op2 fix2 e2 `thenRn` \ new_e ->
647 returnRn (NegApp new_e neg_name)
649 (nofix_error, associate_right) = compareFixity negateFixity fix2
651 ---------------------------
653 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
654 | not associate_right -- We *want* right association
655 = addErrRn (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenRn_`
656 returnRn (OpApp e1 op1 fix1 e2)
658 (_, associate_right) = compareFixity fix1 negateFixity
660 ---------------------------
662 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
663 = ASSERT2( right_op_ok fix e2,
664 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
666 returnRn (OpApp e1 op fix e2)
668 -- Parser left-associates everything, but
669 -- derived instances may have correctly-associated things to
670 -- in the right operarand. So we just check that the right operand is OK
671 right_op_ok fix1 (OpApp _ _ fix2 _)
672 = not error_please && associate_right
674 (error_please, associate_right) = compareFixity fix1 fix2
675 right_op_ok fix1 other
678 -- Parser initially makes negation bind more tightly than any other operator
679 mkNegAppRn neg_arg neg_name
682 getModeRn `thenRn` \ mode ->
683 ASSERT( not_op_app mode neg_arg )
685 returnRn (NegApp neg_arg neg_name)
687 not_op_app SourceMode (OpApp _ _ _ _) = False
688 not_op_app mode other = True
692 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
695 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
698 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
699 returnRn (ConOpPatIn p1 op2 fix2 p2)
702 = mkConOpPatRn p12 op2 fix2 p2 `thenRn` \ new_p ->
703 returnRn (ConOpPatIn p11 op1 fix1 new_p)
706 (nofix_error, associate_right) = compareFixity fix1 fix2
708 mkConOpPatRn p1 op fix p2 -- Default case, no rearrangment
709 = ASSERT( not_op_pat p2 )
710 returnRn (ConOpPatIn p1 op fix p2)
712 not_op_pat (ConOpPatIn _ _ _ _) = False
713 not_op_pat other = True
717 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
719 checkPrecMatch False fn match
722 checkPrecMatch True op (Match (p1:p2:_) _ _)
723 -- True indicates an infix lhs
724 = getModeRn `thenRn` \ mode ->
725 -- See comments with rnExpr (OpApp ...)
726 if isInterfaceMode mode
728 else checkPrec op p1 False `thenRn_`
731 checkPrecMatch True op _ = panic "checkPrecMatch"
733 checkPrec op (ConOpPatIn _ op1 _ _) right
734 = lookupFixityRn op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
735 lookupFixityRn op1 `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
737 inf_ok = op1_prec > op_prec ||
738 (op1_prec == op_prec &&
739 (op1_dir == InfixR && op_dir == InfixR && right ||
740 op1_dir == InfixL && op_dir == InfixL && not right))
742 info = (ppr_op op, op_fix)
743 info1 = (ppr_op op1, op1_fix)
744 (infol, infor) = if right then (info, info1) else (info1, info)
746 checkRn inf_ok (precParseErr infol infor)
748 checkPrec op pat right
751 -- Check precedence of (arg op) or (op arg) respectively
752 -- If arg is itself an operator application, its precedence should
753 -- be higher than that of op
754 checkSectionPrec left_or_right section op arg
756 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
757 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
761 go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
762 = lookupFixityRn op_name `thenRn` \ op_fix@(Fixity op_prec _) ->
763 checkRn (op_prec < arg_prec)
764 (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
771 @(compareFixity op1 op2)@ tells which way to arrange appication, or
772 whether there's an error.
775 compareFixity :: Fixity -> Fixity
776 -> (Bool, -- Error please
777 Bool) -- Associate to the right: a op1 (b op2 c)
778 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
779 = case prec1 `compare` prec2 of
782 EQ -> case (dir1, dir2) of
783 (InfixR, InfixR) -> right
784 (InfixL, InfixL) -> left
787 right = (False, True)
788 left = (False, False)
789 error_please = (True, False)
792 %************************************************************************
794 \subsubsection{Literals}
796 %************************************************************************
798 When literals occur we have to make sure
799 that the types and classes they involve
804 = checkRn (inCharRange c) (bogusCharError c) `thenRn_`
805 returnRn (unitFV charTyCon_name)
807 litFVs (HsCharPrim c) = returnRn (unitFV (getName charPrimTyCon))
808 litFVs (HsString s) = returnRn (mkFVs [listTyCon_name, charTyCon_name])
809 litFVs (HsStringPrim s) = returnRn (unitFV (getName addrPrimTyCon))
810 litFVs (HsInt i) = returnRn (unitFV (getName intTyCon))
811 litFVs (HsIntPrim i) = returnRn (unitFV (getName intPrimTyCon))
812 litFVs (HsFloatPrim f) = returnRn (unitFV (getName floatPrimTyCon))
813 litFVs (HsDoublePrim d) = returnRn (unitFV (getName doublePrimTyCon))
814 litFVs (HsLitLit l bogus_ty) = lookupOrigName cCallableClass_RDR `thenRn` \ cc ->
816 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
817 -- in post-typechecker translations
819 rnOverLit (HsIntegral i from_integer_name)
820 = lookupSyntaxName from_integer_name `thenRn` \ from_integer_name' ->
822 returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
824 lookupOrigNames [plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
825 -- Big integer literals are built, using + and *,
826 -- out of small integers (DsUtils.mkIntegerLit)
827 -- [NB: plusInteger, timesInteger aren't rebindable...
828 -- they are used to construct the argument to fromInteger,
829 -- which is the rebindable one.]
830 returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
832 rnOverLit (HsFractional i from_rat_name)
833 = lookupSyntaxName from_rat_name `thenRn` \ from_rat_name' ->
834 lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
835 -- We have to make sure that the Ratio type is imported with
836 -- its constructor, because literals of type Ratio t are
837 -- built with that constructor.
838 -- The Rational type is needed too, but that will come in
839 -- when fractionalClass does.
840 -- The plus/times integer operations may be needed to construct the numerator
841 -- and denominator (see DsUtils.mkIntegerLit)
842 returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
845 %************************************************************************
847 \subsubsection{Assertion utils}
849 %************************************************************************
852 mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
854 lookupOrigName assertErr_RDR `thenRn` \ name ->
855 getSrcLocRn `thenRn` \ sloc ->
857 -- if we're ignoring asserts, return (\ _ e -> e)
858 -- if not, return (assertError "src-loc")
860 if opt_IgnoreAsserts then
861 getUniqRn `thenRn` \ uniq ->
863 vname = mkSysLocalName uniq SLIT("v")
864 expr = HsLam ignorePredMatch
865 loc = nameSrcLoc vname
866 ignorePredMatch = mkSimpleMatch [WildPatIn, VarPatIn vname] (HsVar vname) placeHolderType loc
868 returnRn (expr, unitFV name)
873 (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
876 returnRn (expr, unitFV name)
880 %************************************************************************
882 \subsubsection{Errors}
884 %************************************************************************
887 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
888 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
889 pp_prefix_minus = ptext SLIT("prefix `-'")
891 dupFieldErr str (dup:rest)
892 = hsep [ptext SLIT("duplicate field name"),
894 ptext SLIT("in record"), text str]
897 = hang (ptext SLIT("precedence parsing error"))
898 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
900 ptext SLIT("in the same infix expression")])
902 sectionPrecErr op arg_op section
903 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
904 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
905 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
909 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
913 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
914 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
917 = sep [ptext SLIT("Pattern syntax in expression context:"),
921 = sep [ptext SLIT("`do' statements must end in expression:"),
925 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''