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,
18 #include "HsVersions.h"
20 import {-# SOURCE #-} RnBinds ( rnBinds )
21 import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
28 import RnIfaces ( lookupFixityRn )
29 import CmdLineOpts ( dopt_GlasgowExts, opt_IgnoreAsserts )
30 import Literal ( inIntRange )
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, negate_RDR, assertErr_RDR,
37 ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR
39 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
40 floatPrimTyCon, doublePrimTyCon
42 import TysWiredIn ( intTyCon, integerTyCon )
43 import Name ( NamedThing(..), mkSysLocalName, nameSrcLoc )
45 import UniqFM ( isNullUFM )
46 import FiniteMap ( elemFM )
47 import UniqSet ( emptyUniqSet )
48 import ListSetOps ( unionLists, removeDups )
49 import Maybes ( maybeToBool )
54 *********************************************************
58 *********************************************************
61 rnPat :: RdrNamePat -> RnMS (RenamedPat, FreeVars)
63 rnPat WildPatIn = returnRn (WildPatIn, emptyFVs)
66 = lookupBndrRn name `thenRn` \ vname ->
67 returnRn (VarPatIn vname, emptyFVs)
69 rnPat (SigPatIn pat ty)
70 = doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
73 then rnPat pat `thenRn` \ (pat', fvs1) ->
74 rnHsType doc ty `thenRn` \ (ty', fvs2) ->
75 returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
77 else addErrRn (patSigErr ty) `thenRn_`
80 doc = text "a pattern type-signature"
82 rnPat (LitPatIn s@(HsString _))
83 = lookupOrigName eqString_RDR `thenRn` \ eq ->
84 returnRn (LitPatIn s, unitFV eq)
87 = litFVs lit `thenRn` \ fvs ->
88 returnRn (LitPatIn lit, fvs)
91 = rnOverLit lit `thenRn` \ (lit', fvs1) ->
92 lookupOrigName eqClass_RDR `thenRn` \ eq -> -- Needed to find equality on pattern
93 returnRn (NPatIn lit', fvs1 `addOneFV` eq)
95 rnPat (NPlusKPatIn name lit minus)
96 = rnOverLit lit `thenRn` \ (lit', fvs) ->
97 lookupOrigName ordClass_RDR `thenRn` \ ord ->
98 lookupBndrRn name `thenRn` \ name' ->
99 lookupOccRn minus `thenRn` \ minus' ->
100 returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
102 rnPat (LazyPatIn pat)
103 = rnPat pat `thenRn` \ (pat', fvs) ->
104 returnRn (LazyPatIn pat', fvs)
106 rnPat (AsPatIn name pat)
107 = rnPat pat `thenRn` \ (pat', fvs) ->
108 lookupBndrRn name `thenRn` \ vname ->
109 returnRn (AsPatIn vname pat', fvs)
111 rnPat (ConPatIn con pats)
112 = lookupOccRn con `thenRn` \ con' ->
113 mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
114 returnRn (ConPatIn con' patslist, fvs `addOneFV` con')
116 rnPat (ConOpPatIn pat1 con _ pat2)
117 = rnPat pat1 `thenRn` \ (pat1', fvs1) ->
118 lookupOccRn con `thenRn` \ con' ->
119 rnPat pat2 `thenRn` \ (pat2', fvs2) ->
121 getModeRn `thenRn` \ mode ->
122 -- See comments with rnExpr (OpApp ...)
124 InterfaceMode -> returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
125 SourceMode -> lookupFixityRn con' `thenRn` \ fixity ->
126 mkConOpPatRn pat1' con' fixity pat2'
128 returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
131 = rnPat pat `thenRn` \ (pat', fvs) ->
132 returnRn (ParPatIn pat', fvs)
134 rnPat (ListPatIn pats)
135 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
136 returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
138 rnPat (TuplePatIn pats boxed)
139 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
140 returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
142 tycon_name = tupleTyCon_name boxed (length pats)
144 rnPat (RecPatIn con rpats)
145 = lookupOccRn con `thenRn` \ con' ->
146 rnRpats rpats `thenRn` \ (rpats', fvs) ->
147 returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
148 rnPat (TypePatIn name) =
149 (rnHsType (text "type pattern") name) `thenRn` \ (name', fvs) ->
150 returnRn (TypePatIn name', fvs)
153 ************************************************************************
157 ************************************************************************
160 rnMatch :: RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
162 rnMatch match@(Match _ pats maybe_rhs_sig grhss)
163 = pushSrcLocRn (getMatchLoc match) $
165 -- Find the universally quantified type variables
166 -- in the pattern type signatures
167 getLocalNameEnv `thenRn` \ name_env ->
169 tyvars_in_sigs = rhs_sig_tyvars `unionLists` tyvars_in_pats
170 rhs_sig_tyvars = case maybe_rhs_sig of
172 Just ty -> extractHsTyRdrTyVars ty
173 tyvars_in_pats = extractPatsTyVars pats
174 forall_tyvars = filter (not . (`elemFM` name_env)) tyvars_in_sigs
175 doc_sig = text "a pattern type-signature"
176 doc_pats = text "in a pattern match"
178 bindNakedTyVarsFVRn doc_sig forall_tyvars $ \ sig_tyvars ->
180 -- Note that we do a single bindLocalsRn for all the
181 -- matches together, so that we spot the repeated variable in
183 bindLocalsFVRn doc_pats (collectPatsBinders pats) $ \ new_binders ->
185 mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) ->
186 rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) ->
187 doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
188 (case maybe_rhs_sig of
189 Nothing -> returnRn (Nothing, emptyFVs)
190 Just ty | opt_GlasgowExts -> rnHsType doc_sig ty `thenRn` \ (ty', ty_fvs) ->
191 returnRn (Just ty', ty_fvs)
192 | otherwise -> addErrRn (patSigErr ty) `thenRn_`
193 returnRn (Nothing, emptyFVs)
194 ) `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
197 binder_set = mkNameSet new_binders
198 unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
199 all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
201 warnUnusedMatches unused_binders `thenRn_`
203 returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
204 -- The bindLocals and bindTyVars will remove the bound FVs
207 %************************************************************************
209 \subsubsection{Guarded right-hand sides (GRHSs)}
211 %************************************************************************
214 rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
216 rnGRHSs (GRHSs grhss binds maybe_ty)
217 = ASSERT( not (maybeToBool maybe_ty) )
218 rnBinds binds $ \ binds' ->
219 mapFvRn rnGRHS grhss `thenRn` \ (grhss', fvGRHSs) ->
220 returnRn (GRHSs grhss' binds' Nothing, fvGRHSs)
222 rnGRHS (GRHS guarded locn)
223 = doptsRn dopt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
225 (if not (opt_GlasgowExts || is_standard_guard guarded) then
226 addWarnRn (nonStdGuardErr guarded)
231 rnStmts rnExpr guarded `thenRn` \ (guarded', fvs) ->
232 returnRn (GRHS guarded' locn, fvs)
234 -- Standard Haskell 1.4 guards are just a single boolean
235 -- expression, rather than a list of qualifiers as in the
237 is_standard_guard [ExprStmt _ _] = True
238 is_standard_guard [GuardStmt _ _, ExprStmt _ _] = True
239 is_standard_guard other = False
242 %************************************************************************
244 \subsubsection{Expressions}
246 %************************************************************************
249 rnExprs :: [RdrNameHsExpr] -> RnMS ([RenamedHsExpr], FreeVars)
250 rnExprs ls = rnExprs' ls emptyUniqSet
252 rnExprs' [] acc = returnRn ([], acc)
253 rnExprs' (expr:exprs) acc
254 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
256 -- Now we do a "seq" on the free vars because typically it's small
257 -- or empty, especially in very long lists of constants
259 acc' = acc `plusFV` fvExpr
261 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenRn` \ (exprs', fvExprs) ->
262 returnRn (expr':exprs', fvExprs)
264 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
265 grubby_seqNameSet ns result | isNullUFM ns = result
269 Variables. We look up the variable and return the resulting name.
272 rnExpr :: RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
275 = lookupOccRn v `thenRn` \ name ->
276 if name `hasKey` assertIdKey then
277 -- We expand it to (GHCerr.assert__ location)
281 returnRn (HsVar name, unitFV name)
284 = newIPName v `thenRn` \ name ->
285 returnRn (HsIPVar name, emptyFVs)
288 = litFVs lit `thenRn` \ fvs ->
289 returnRn (HsLit lit, fvs)
291 rnExpr (HsOverLit lit)
292 = rnOverLit lit `thenRn` \ (lit', fvs) ->
293 returnRn (HsOverLit lit', fvs)
296 = rnMatch match `thenRn` \ (match', fvMatch) ->
297 returnRn (HsLam match', fvMatch)
299 rnExpr (HsApp fun arg)
300 = rnExpr fun `thenRn` \ (fun',fvFun) ->
301 rnExpr arg `thenRn` \ (arg',fvArg) ->
302 returnRn (HsApp fun' arg', fvFun `plusFV` fvArg)
304 rnExpr (OpApp e1 op _ e2)
305 = rnExpr e1 `thenRn` \ (e1', fv_e1) ->
306 rnExpr e2 `thenRn` \ (e2', fv_e2) ->
307 rnExpr op `thenRn` \ (op'@(HsVar op_name), fv_op) ->
310 -- When renaming code synthesised from "deriving" declarations
311 -- we're in Interface mode, and we should ignore fixity; assume
312 -- that the deriving code generator got the association correct
313 -- Don't even look up the fixity when in interface mode
314 getModeRn `thenRn` \ mode ->
316 SourceMode -> lookupFixityRn op_name `thenRn` \ fixity ->
317 mkOpAppRn e1' op' fixity e2'
318 InterfaceMode -> returnRn (OpApp e1' op' defaultFixity e2')
319 ) `thenRn` \ final_e ->
322 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
325 = rnExpr e `thenRn` \ (e', fv_e) ->
326 lookupOrigName negate_RDR `thenRn` \ neg ->
327 mkNegAppRn e' neg `thenRn` \ final_e ->
328 returnRn (final_e, fv_e `addOneFV` neg)
331 = rnExpr e `thenRn` \ (e', fvs_e) ->
332 returnRn (HsPar e', fvs_e)
334 rnExpr section@(SectionL expr op)
335 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
336 rnExpr op `thenRn` \ (op', fvs_op) ->
337 checkSectionPrec "left" section op' expr' `thenRn_`
338 returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
340 rnExpr section@(SectionR op expr)
341 = rnExpr op `thenRn` \ (op', fvs_op) ->
342 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
343 checkSectionPrec "right" section op' expr' `thenRn_`
344 returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
346 rnExpr (HsCCall fun args may_gc is_casm fake_result_ty)
347 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
348 = lookupOrigNames [ccallableClass_RDR,
349 creturnableClass_RDR,
350 ioDataCon_RDR] `thenRn` \ implicit_fvs ->
351 rnExprs args `thenRn` \ (args', fvs_args) ->
352 returnRn (HsCCall fun args' may_gc is_casm fake_result_ty,
353 fvs_args `plusFV` implicit_fvs)
355 rnExpr (HsSCC lbl expr)
356 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
357 returnRn (HsSCC lbl expr', fvs_expr)
359 rnExpr (HsCase expr ms src_loc)
360 = pushSrcLocRn src_loc $
361 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
362 mapFvRn rnMatch ms `thenRn` \ (new_ms, ms_fvs) ->
363 returnRn (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
365 rnExpr (HsLet binds expr)
366 = rnBinds binds $ \ binds' ->
367 rnExpr expr `thenRn` \ (expr',fvExpr) ->
368 returnRn (HsLet binds' expr', fvExpr)
370 rnExpr (HsWith expr binds)
371 = rnExpr expr `thenRn` \ (expr',fvExpr) ->
372 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
373 returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
375 rnExpr e@(HsDo do_or_lc stmts src_loc)
376 = pushSrcLocRn src_loc $
377 lookupOrigNames implicit_rdr_names `thenRn` \ implicit_fvs ->
378 rnStmts rnExpr stmts `thenRn` \ (stmts', fvs) ->
379 -- check the statement list ends in an expression
380 case last stmts' of {
381 ExprStmt _ _ -> returnRn () ;
382 ReturnStmt _ -> returnRn () ; -- for list comprehensions
383 _ -> addErrRn (doStmtListErr e)
385 returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
387 implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
388 -- Monad stuff should not be necessary for a list comprehension
389 -- but the typechecker looks up the bind and return Ids anyway
393 rnExpr (ExplicitList exps)
394 = rnExprs exps `thenRn` \ (exps', fvs) ->
395 returnRn (ExplicitList exps', fvs `addOneFV` listTyCon_name)
397 rnExpr (ExplicitTuple exps boxity)
398 = rnExprs exps `thenRn` \ (exps', fvs) ->
399 returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
401 tycon_name = tupleTyCon_name boxity (length exps)
403 rnExpr (RecordCon con_id rbinds)
404 = lookupOccRn con_id `thenRn` \ conname ->
405 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
406 returnRn (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
408 rnExpr (RecordUpd expr rbinds)
409 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
410 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
411 returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
413 rnExpr (ExprWithTySig expr pty)
414 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
415 rnHsSigType (text "an expression") pty `thenRn` \ (pty', fvTy) ->
416 returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
418 rnExpr (HsIf p b1 b2 src_loc)
419 = pushSrcLocRn src_loc $
420 rnExpr p `thenRn` \ (p', fvP) ->
421 rnExpr b1 `thenRn` \ (b1', fvB1) ->
422 rnExpr b2 `thenRn` \ (b2', fvB2) ->
423 returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
426 (rnHsType doc a) `thenRn` \ (t, fvT) -> returnRn (HsType t, fvT)
427 where doc = text "renaming a type pattern"
430 rnExpr (ArithSeqIn seq)
431 = lookupOrigName enumClass_RDR `thenRn` \ enum ->
432 rn_seq seq `thenRn` \ (new_seq, fvs) ->
433 returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
436 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
437 returnRn (From expr', fvExpr)
439 rn_seq (FromThen expr1 expr2)
440 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
441 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
442 returnRn (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
444 rn_seq (FromTo expr1 expr2)
445 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
446 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
447 returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
449 rn_seq (FromThenTo expr1 expr2 expr3)
450 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
451 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
452 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
453 returnRn (FromThenTo expr1' expr2' expr3',
454 plusFVs [fvExpr1, fvExpr2, fvExpr3])
457 These three are pattern syntax appearing in expressions.
458 Since all the symbols are reservedops we can simply reject them.
459 We return a (bogus) EWildPat in each case.
462 rnExpr e@EWildPat = addErrRn (patSynErr e) `thenRn_`
463 returnRn (EWildPat, emptyFVs)
465 rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e) `thenRn_`
466 returnRn (EWildPat, emptyFVs)
468 rnExpr e@(ELazyPat _) = addErrRn (patSynErr e) `thenRn_`
469 returnRn (EWildPat, emptyFVs)
474 %************************************************************************
476 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
478 %************************************************************************
482 = mapRn_ field_dup_err dup_fields `thenRn_`
483 mapFvRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind) ->
484 returnRn (rbinds', fvRbind)
486 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rbinds ]
488 field_dup_err dups = addErrRn (dupFieldErr str dups)
490 rn_rbind (field, expr, pun)
491 = lookupGlobalOccRn field `thenRn` \ fieldname ->
492 rnExpr expr `thenRn` \ (expr', fvExpr) ->
493 returnRn ((fieldname, expr', pun), fvExpr `addOneFV` fieldname)
496 = mapRn_ field_dup_err dup_fields `thenRn_`
497 mapFvRn rn_rpat rpats `thenRn` \ (rpats', fvs) ->
498 returnRn (rpats', fvs)
500 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rpats ]
502 field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
504 rn_rpat (field, pat, pun)
505 = lookupGlobalOccRn field `thenRn` \ fieldname ->
506 rnPat pat `thenRn` \ (pat', fvs) ->
507 returnRn ((fieldname, pat', pun), fvs `addOneFV` fieldname)
510 %************************************************************************
512 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
514 %************************************************************************
517 rnIPBinds [] = returnRn ([], emptyFVs)
518 rnIPBinds ((n, expr) : binds)
519 = newIPName n `thenRn` \ name ->
520 rnExpr expr `thenRn` \ (expr',fvExpr) ->
521 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
522 returnRn ((name, expr') : binds', fvExpr `plusFV` fvBinds)
526 %************************************************************************
528 \subsubsection{@Stmt@s: in @do@ expressions}
530 %************************************************************************
532 Note that although some bound vars may appear in the free var set for
533 the first qual, these will eventually be removed by the caller. For
534 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
535 @[q <- r, p <- q]@, the free var set for @q <- r@ will
536 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
537 @r@ will be removed only when we finally return from examining all the
541 type RnExprTy = RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
545 -> RnMS ([RenamedStmt], FreeVars)
548 = returnRn ([], emptyFVs)
550 rnStmts rn_expr (stmt:stmts)
551 = rnStmt rn_expr stmt $ \ stmt' ->
552 rnStmts rn_expr stmts `thenRn` \ (stmts', fvs) ->
553 returnRn (stmt' : stmts', fvs)
555 rnStmt :: RnExprTy -> RdrNameStmt
556 -> (RenamedStmt -> RnMS (a, FreeVars))
557 -> RnMS (a, FreeVars)
558 -- Because of mutual recursion we have to pass in rnExpr.
560 rnStmt rn_expr (BindStmt pat expr src_loc) thing_inside
561 = pushSrcLocRn src_loc $
562 rn_expr expr `thenRn` \ (expr', fv_expr) ->
563 bindLocalsFVRn doc binders $ \ new_binders ->
564 rnPat pat `thenRn` \ (pat', fv_pat) ->
565 thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ (result, fvs) ->
566 returnRn (result, fv_expr `plusFV` fvs `plusFV` fv_pat)
568 binders = collectPatBinders pat
569 doc = text "a pattern in do binding"
571 rnStmt rn_expr (ExprStmt expr src_loc) thing_inside
572 = pushSrcLocRn src_loc $
573 rn_expr expr `thenRn` \ (expr', fv_expr) ->
574 thing_inside (ExprStmt expr' src_loc) `thenRn` \ (result, fvs) ->
575 returnRn (result, fv_expr `plusFV` fvs)
577 rnStmt rn_expr (GuardStmt expr src_loc) thing_inside
578 = pushSrcLocRn src_loc $
579 rn_expr expr `thenRn` \ (expr', fv_expr) ->
580 thing_inside (GuardStmt expr' src_loc) `thenRn` \ (result, fvs) ->
581 returnRn (result, fv_expr `plusFV` fvs)
583 rnStmt rn_expr (ReturnStmt expr) thing_inside
584 = rn_expr expr `thenRn` \ (expr', fv_expr) ->
585 thing_inside (ReturnStmt expr') `thenRn` \ (result, fvs) ->
586 returnRn (result, fv_expr `plusFV` fvs)
588 rnStmt rn_expr (LetStmt binds) thing_inside
589 = rnBinds binds $ \ binds' ->
590 thing_inside (LetStmt binds')
593 %************************************************************************
595 \subsubsection{Precedence Parsing}
597 %************************************************************************
599 @mkOpAppRn@ deals with operator fixities. The argument expressions
600 are assumed to be already correctly arranged. It needs the fixities
601 recorded in the OpApp nodes, because fixity info applies to the things
602 the programmer actually wrote, so you can't find it out from the Name.
604 Furthermore, the second argument is guaranteed not to be another
605 operator application. Why? Because the parser parses all
606 operator appications left-associatively, EXCEPT negation, which
607 we need to handle specially.
610 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
611 -> RenamedHsExpr -> Fixity -- Operator and fixity
612 -> RenamedHsExpr -- Right operand (not an OpApp, but might
614 -> RnMS RenamedHsExpr
616 ---------------------------
617 -- (e11 `op1` e12) `op2` e2
618 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
620 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
621 returnRn (OpApp e1 op2 fix2 e2)
624 = mkOpAppRn e12 op2 fix2 e2 `thenRn` \ new_e ->
625 returnRn (OpApp e11 op1 fix1 new_e)
627 (nofix_error, associate_right) = compareFixity fix1 fix2
629 ---------------------------
630 -- (- neg_arg) `op` e2
631 mkOpAppRn e1@(NegApp neg_arg neg_op) op2 fix2 e2
633 = addErrRn (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenRn_`
634 returnRn (OpApp e1 op2 fix2 e2)
637 = mkOpAppRn neg_arg op2 fix2 e2 `thenRn` \ new_e ->
638 returnRn (NegApp new_e neg_op)
640 (nofix_error, associate_right) = compareFixity negateFixity fix2
642 ---------------------------
644 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg neg_op) -- NegApp can occur on the right
645 | not associate_right -- We *want* right association
646 = addErrRn (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenRn_`
647 returnRn (OpApp e1 op1 fix1 e2)
649 (_, associate_right) = compareFixity fix1 negateFixity
651 ---------------------------
653 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
654 = ASSERT2( right_op_ok fix e2,
655 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
657 returnRn (OpApp e1 op fix e2)
659 -- Parser left-associates everything, but
660 -- derived instances may have correctly-associated things to
661 -- in the right operarand. So we just check that the right operand is OK
662 right_op_ok fix1 (OpApp _ _ fix2 _)
663 = not error_please && associate_right
665 (error_please, associate_right) = compareFixity fix1 fix2
666 right_op_ok fix1 other
669 -- Parser initially makes negation bind more tightly than any other operator
670 mkNegAppRn neg_arg neg_op
673 getModeRn `thenRn` \ mode ->
674 ASSERT( not_op_app mode neg_arg )
676 returnRn (NegApp neg_arg neg_op)
678 not_op_app SourceMode (OpApp _ _ _ _) = False
679 not_op_app mode other = True
683 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
686 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
689 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
690 returnRn (ConOpPatIn p1 op2 fix2 p2)
693 = mkConOpPatRn p12 op2 fix2 p2 `thenRn` \ new_p ->
694 returnRn (ConOpPatIn p11 op1 fix1 new_p)
697 (nofix_error, associate_right) = compareFixity fix1 fix2
699 mkConOpPatRn p1 op fix p2 -- Default case, no rearrangment
700 = ASSERT( not_op_pat p2 )
701 returnRn (ConOpPatIn p1 op fix p2)
703 not_op_pat (ConOpPatIn _ _ _ _) = False
704 not_op_pat other = True
708 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
710 checkPrecMatch False fn match
713 checkPrecMatch True op (Match _ (p1:p2:_) _ _)
714 -- True indicates an infix lhs
715 = getModeRn `thenRn` \ mode ->
716 -- See comments with rnExpr (OpApp ...)
718 InterfaceMode -> returnRn ()
719 SourceMode -> checkPrec op p1 False `thenRn_`
722 checkPrecMatch True op _ = panic "checkPrecMatch"
724 checkPrec op (ConOpPatIn _ op1 _ _) right
725 = lookupFixityRn op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
726 lookupFixityRn op1 `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
728 inf_ok = op1_prec > op_prec ||
729 (op1_prec == op_prec &&
730 (op1_dir == InfixR && op_dir == InfixR && right ||
731 op1_dir == InfixL && op_dir == InfixL && not right))
733 info = (ppr_op op, op_fix)
734 info1 = (ppr_op op1, op1_fix)
735 (infol, infor) = if right then (info, info1) else (info1, info)
737 checkRn inf_ok (precParseErr infol infor)
739 checkPrec op pat right
742 -- Check precedence of (arg op) or (op arg) respectively
743 -- If arg is itself an operator application, its precedence should
744 -- be higher than that of op
745 checkSectionPrec left_or_right section op arg
747 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
748 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
752 go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
753 = lookupFixityRn op_name `thenRn` \ op_fix@(Fixity op_prec _) ->
754 checkRn (op_prec < arg_prec)
755 (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
762 @(compareFixity op1 op2)@ tells which way to arrange appication, or
763 whether there's an error.
766 compareFixity :: Fixity -> Fixity
767 -> (Bool, -- Error please
768 Bool) -- Associate to the right: a op1 (b op2 c)
769 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
770 = case prec1 `compare` prec2 of
773 EQ -> case (dir1, dir2) of
774 (InfixR, InfixR) -> right
775 (InfixL, InfixL) -> left
778 right = (False, True)
779 left = (False, False)
780 error_please = (True, False)
783 %************************************************************************
785 \subsubsection{Literals}
787 %************************************************************************
789 When literals occur we have to make sure
790 that the types and classes they involve
794 litFVs (HsChar c) = returnRn (unitFV charTyCon_name)
795 litFVs (HsCharPrim c) = returnRn (unitFV (getName charPrimTyCon))
796 litFVs (HsString s) = returnRn (mkFVs [listTyCon_name, charTyCon_name])
797 litFVs (HsStringPrim s) = returnRn (unitFV (getName addrPrimTyCon))
798 litFVs (HsInt i) = returnRn (unitFV (getName intTyCon))
799 litFVs (HsIntPrim i) = returnRn (unitFV (getName intPrimTyCon))
800 litFVs (HsFloatPrim f) = returnRn (unitFV (getName floatPrimTyCon))
801 litFVs (HsDoublePrim d) = returnRn (unitFV (getName doublePrimTyCon))
802 litFVs (HsLitLit l bogus_ty) = lookupOrigName ccallableClass_RDR `thenRn` \ cc ->
804 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
805 -- in post-typechecker translations
807 rnOverLit (HsIntegral i from_integer)
808 = lookupOccRn from_integer `thenRn` \ from_integer' ->
809 (if inIntRange i then
812 lookupOrigNames [plusInteger_RDR, timesInteger_RDR]
814 returnRn (HsIntegral i from_integer', ns `addOneFV` from_integer')
816 rnOverLit (HsFractional i n)
817 = lookupOccRn n `thenRn` \ n' ->
818 lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns' ->
819 -- We have to make sure that the Ratio type is imported with
820 -- its constructor, because literals of type Ratio t are
821 -- built with that constructor.
822 -- The Rational type is needed too, but that will come in
823 -- when fractionalClass does.
824 -- The plus/times integer operations may be needed to construct the numerator
825 -- and denominator (see DsUtils.mkIntegerLit)
826 returnRn (HsFractional i n', ns' `addOneFV` n')
829 %************************************************************************
831 \subsubsection{Assertion utils}
833 %************************************************************************
836 mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
838 lookupOrigName assertErr_RDR `thenRn` \ name ->
839 getSrcLocRn `thenRn` \ sloc ->
841 -- if we're ignoring asserts, return (\ _ e -> e)
842 -- if not, return (assertError "src-loc")
844 if opt_IgnoreAsserts then
845 getUniqRn `thenRn` \ uniq ->
847 vname = mkSysLocalName uniq SLIT("v")
848 expr = HsLam ignorePredMatch
849 loc = nameSrcLoc vname
850 ignorePredMatch = Match [] [WildPatIn, VarPatIn vname] Nothing
851 (GRHSs [GRHS [ExprStmt (HsVar vname) loc] loc]
854 returnRn (expr, unitFV name)
859 (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
862 returnRn (expr, unitFV name)
866 %************************************************************************
868 \subsubsection{Errors}
870 %************************************************************************
873 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
874 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
875 pp_prefix_minus = ptext SLIT("prefix `-'")
877 dupFieldErr str (dup:rest)
878 = hsep [ptext SLIT("duplicate field name"),
880 ptext SLIT("in record"), text str]
883 = hang (ptext SLIT("precedence parsing error"))
884 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
886 ptext SLIT("in the same infix expression")])
888 sectionPrecErr op arg_op section
889 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
890 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
891 nest 4 (ptext SLIT("In the section:") <+> quotes (ppr section))]
895 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
899 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
900 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
903 = sep [ptext SLIT("Pattern syntax in expression context:"),
907 = sep [ptext SLIT("`do' statements must end in expression:"),