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 )
21 import {-# SOURCE #-} RnSource ( 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 FiniteMap ( elemFM )
47 import UniqSet ( emptyUniqSet )
48 import List ( intersectBy )
49 import ListSetOps ( removeDups )
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 = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
73 then rnPat pat `thenRn` \ (pat', fvs1) ->
74 rnHsTypeFVs 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 lookupSyntaxName 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 ...)
123 (if isInterfaceMode mode
124 then returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
125 else 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')
149 rnPat (TypePatIn name) =
150 rnHsTypeFVs (text "type pattern") name `thenRn` \ (name', fvs) ->
151 returnRn (TypePatIn name', fvs)
154 ************************************************************************
158 ************************************************************************
161 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
163 rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
164 = pushSrcLocRn (getMatchLoc match) $
166 -- Bind pattern-bound type variables
168 rhs_sig_tys = case maybe_rhs_sig of
171 pat_sig_tys = collectSigTysFromPats pats
172 doc_sig = text "In a result type-signature"
173 doc_pat = pprMatchContext ctxt
175 bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys) $ \ sig_tyvars ->
177 -- Note that we do a single bindLocalsRn for all the
178 -- matches together, so that we spot the repeated variable in
180 bindLocalsFVRn doc_pat (collectPatsBinders pats) $ \ new_binders ->
182 mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) ->
183 rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) ->
184 doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
185 (case maybe_rhs_sig of
186 Nothing -> returnRn (Nothing, emptyFVs)
187 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenRn` \ (ty', ty_fvs) ->
188 returnRn (Just ty', ty_fvs)
189 | otherwise -> addErrRn (patSigErr ty) `thenRn_`
190 returnRn (Nothing, emptyFVs)
191 ) `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
194 binder_set = mkNameSet new_binders
195 unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
196 all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
198 warnUnusedMatches unused_binders `thenRn_`
200 returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
201 -- The bindLocals and bindTyVars will remove the bound FVs
204 bindPatSigTyVars :: [RdrNameHsType]
205 -> ([Name] -> RnMS (a, FreeVars))
206 -> RnMS (a, FreeVars)
207 -- Find the type variables in the pattern type
208 -- signatures that must be brought into scope
209 bindPatSigTyVars tys thing_inside
210 = getLocalNameEnv `thenRn` \ name_env ->
212 tyvars_in_sigs = extractHsTysRdrTyVars tys
213 forall_tyvars = filter (not . (`elemFM` name_env)) tyvars_in_sigs
214 doc_sig = text "In a pattern type-signature"
216 bindNakedTyVarsFVRn doc_sig forall_tyvars thing_inside
219 %************************************************************************
221 \subsubsection{Guarded right-hand sides (GRHSs)}
223 %************************************************************************
226 rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
228 rnGRHSs (GRHSs grhss binds _)
229 = rnBinds binds $ \ binds' ->
230 mapFvRn rnGRHS grhss `thenRn` \ (grhss', fvGRHSs) ->
231 returnRn (GRHSs grhss' binds' placeHolderType, fvGRHSs)
233 rnGRHS (GRHS guarded locn)
234 = doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
236 (if not (opt_GlasgowExts || is_standard_guard guarded) then
237 addWarnRn (nonStdGuardErr guarded)
242 rnStmts guarded `thenRn` \ ((_, guarded'), fvs) ->
243 returnRn (GRHS guarded' locn, fvs)
245 -- Standard Haskell 1.4 guards are just a single boolean
246 -- expression, rather than a list of qualifiers as in the
248 is_standard_guard [ResultStmt _ _] = True
249 is_standard_guard [ExprStmt _ _ _, ResultStmt _ _] = True
250 is_standard_guard other = False
253 %************************************************************************
255 \subsubsection{Expressions}
257 %************************************************************************
260 rnExprs :: [RdrNameHsExpr] -> RnMS ([RenamedHsExpr], FreeVars)
261 rnExprs ls = rnExprs' ls emptyUniqSet
263 rnExprs' [] acc = returnRn ([], acc)
264 rnExprs' (expr:exprs) acc
265 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
267 -- Now we do a "seq" on the free vars because typically it's small
268 -- or empty, especially in very long lists of constants
270 acc' = acc `plusFV` fvExpr
272 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenRn` \ (exprs', fvExprs) ->
273 returnRn (expr':exprs', fvExprs)
275 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
276 grubby_seqNameSet ns result | isNullUFM ns = result
280 Variables. We look up the variable and return the resulting name.
283 rnExpr :: RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
286 = lookupOccRn v `thenRn` \ name ->
287 if name `hasKey` assertIdKey then
288 -- We expand it to (GHCerr.assert__ location)
292 returnRn (HsVar name, unitFV name)
295 = newIPName v `thenRn` \ name ->
296 returnRn (HsIPVar name, emptyFVs)
299 = litFVs lit `thenRn` \ fvs ->
300 returnRn (HsLit lit, fvs)
302 rnExpr (HsOverLit lit)
303 = rnOverLit lit `thenRn` \ (lit', fvs) ->
304 returnRn (HsOverLit lit', fvs)
307 = rnMatch LambdaExpr match `thenRn` \ (match', fvMatch) ->
308 returnRn (HsLam match', fvMatch)
310 rnExpr (HsApp fun arg)
311 = rnExpr fun `thenRn` \ (fun',fvFun) ->
312 rnExpr arg `thenRn` \ (arg',fvArg) ->
313 returnRn (HsApp fun' arg', fvFun `plusFV` fvArg)
315 rnExpr (OpApp e1 op _ e2)
316 = rnExpr e1 `thenRn` \ (e1', fv_e1) ->
317 rnExpr e2 `thenRn` \ (e2', fv_e2) ->
318 rnExpr op `thenRn` \ (op'@(HsVar op_name), fv_op) ->
321 -- When renaming code synthesised from "deriving" declarations
322 -- we're in Interface mode, and we should ignore fixity; assume
323 -- that the deriving code generator got the association correct
324 -- Don't even look up the fixity when in interface mode
325 getModeRn `thenRn` \ mode ->
326 (if isInterfaceMode mode
327 then returnRn (OpApp e1' op' defaultFixity e2')
328 else lookupFixityRn op_name `thenRn` \ fixity ->
329 mkOpAppRn e1' op' fixity e2'
330 ) `thenRn` \ final_e ->
333 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
335 rnExpr (NegApp e neg_name)
336 = rnExpr e `thenRn` \ (e', fv_e) ->
337 lookupSyntaxName neg_name `thenRn` \ neg_name' ->
338 mkNegAppRn e' neg_name' `thenRn` \ final_e ->
339 returnRn (final_e, fv_e `addOneFV` neg_name')
342 = rnExpr e `thenRn` \ (e', fvs_e) ->
343 returnRn (HsPar e', fvs_e)
345 rnExpr section@(SectionL expr op)
346 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
347 rnExpr op `thenRn` \ (op', fvs_op) ->
348 checkSectionPrec "left" section op' expr' `thenRn_`
349 returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
351 rnExpr section@(SectionR op expr)
352 = rnExpr op `thenRn` \ (op', fvs_op) ->
353 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
354 checkSectionPrec "right" section op' expr' `thenRn_`
355 returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
357 rnExpr (HsCCall fun args may_gc is_casm _)
358 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
359 = lookupOrigNames [cCallableClass_RDR,
360 cReturnableClass_RDR,
361 ioDataCon_RDR] `thenRn` \ implicit_fvs ->
362 rnExprs args `thenRn` \ (args', fvs_args) ->
363 returnRn (HsCCall fun args' may_gc is_casm placeHolderType,
364 fvs_args `plusFV` implicit_fvs)
366 rnExpr (HsSCC lbl expr)
367 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
368 returnRn (HsSCC lbl expr', fvs_expr)
370 rnExpr (HsCase expr ms src_loc)
371 = pushSrcLocRn src_loc $
372 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
373 mapFvRn (rnMatch CaseAlt) ms `thenRn` \ (new_ms, ms_fvs) ->
374 returnRn (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
376 rnExpr (HsLet binds expr)
377 = rnBinds binds $ \ binds' ->
378 rnExpr expr `thenRn` \ (expr',fvExpr) ->
379 returnRn (HsLet binds' expr', fvExpr)
381 rnExpr (HsWith expr binds)
382 = rnExpr expr `thenRn` \ (expr',fvExpr) ->
383 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
384 returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
386 rnExpr e@(HsDo do_or_lc stmts src_loc)
387 = pushSrcLocRn src_loc $
388 lookupOrigNames implicit_rdr_names `thenRn` \ implicit_fvs ->
389 rnStmts stmts `thenRn` \ ((_, stmts'), fvs) ->
390 -- check the statement list ends in an expression
391 case last stmts' of {
392 ResultStmt _ _ -> returnRn () ;
393 _ -> addErrRn (doStmtListErr e)
395 returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
397 implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
398 -- Monad stuff should not be necessary for a list comprehension
399 -- but the typechecker looks up the bind and return Ids anyway
403 rnExpr (ExplicitList _ exps)
404 = rnExprs exps `thenRn` \ (exps', fvs) ->
405 returnRn (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
407 rnExpr (ExplicitTuple exps boxity)
408 = rnExprs exps `thenRn` \ (exps', fvs) ->
409 returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
411 tycon_name = tupleTyCon_name boxity (length exps)
413 rnExpr (RecordCon con_id rbinds)
414 = lookupOccRn con_id `thenRn` \ conname ->
415 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
416 returnRn (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
418 rnExpr (RecordUpd expr rbinds)
419 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
420 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
421 returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
423 rnExpr (ExprWithTySig expr pty)
424 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
425 rnHsTypeFVs (text "an expression type signature") pty `thenRn` \ (pty', fvTy) ->
426 returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
428 rnExpr (HsIf p b1 b2 src_loc)
429 = pushSrcLocRn src_loc $
430 rnExpr p `thenRn` \ (p', fvP) ->
431 rnExpr b1 `thenRn` \ (b1', fvB1) ->
432 rnExpr b2 `thenRn` \ (b2', fvB2) ->
433 returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
436 = rnHsTypeFVs doc a `thenRn` \ (t, fvT) ->
437 returnRn (HsType t, fvT)
439 doc = text "renaming a type pattern"
441 rnExpr (ArithSeqIn seq)
442 = lookupOrigName enumClass_RDR `thenRn` \ enum ->
443 rn_seq seq `thenRn` \ (new_seq, fvs) ->
444 returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
447 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
448 returnRn (From expr', fvExpr)
450 rn_seq (FromThen expr1 expr2)
451 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
452 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
453 returnRn (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
455 rn_seq (FromTo expr1 expr2)
456 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
457 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
458 returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
460 rn_seq (FromThenTo expr1 expr2 expr3)
461 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
462 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
463 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
464 returnRn (FromThenTo expr1' expr2' expr3',
465 plusFVs [fvExpr1, fvExpr2, fvExpr3])
468 These three are pattern syntax appearing in expressions.
469 Since all the symbols are reservedops we can simply reject them.
470 We return a (bogus) EWildPat in each case.
473 rnExpr e@EWildPat = addErrRn (patSynErr e) `thenRn_`
474 returnRn (EWildPat, emptyFVs)
476 rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e) `thenRn_`
477 returnRn (EWildPat, emptyFVs)
479 rnExpr e@(ELazyPat _) = addErrRn (patSynErr e) `thenRn_`
480 returnRn (EWildPat, emptyFVs)
485 %************************************************************************
487 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
489 %************************************************************************
493 = mapRn_ field_dup_err dup_fields `thenRn_`
494 mapFvRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind) ->
495 returnRn (rbinds', fvRbind)
497 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rbinds ]
499 field_dup_err dups = addErrRn (dupFieldErr str dups)
501 rn_rbind (field, expr, pun)
502 = lookupGlobalOccRn field `thenRn` \ fieldname ->
503 rnExpr expr `thenRn` \ (expr', fvExpr) ->
504 returnRn ((fieldname, expr', pun), fvExpr `addOneFV` fieldname)
507 = mapRn_ field_dup_err dup_fields `thenRn_`
508 mapFvRn rn_rpat rpats `thenRn` \ (rpats', fvs) ->
509 returnRn (rpats', fvs)
511 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rpats ]
513 field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
515 rn_rpat (field, pat, pun)
516 = lookupGlobalOccRn field `thenRn` \ fieldname ->
517 rnPat pat `thenRn` \ (pat', fvs) ->
518 returnRn ((fieldname, pat', pun), fvs `addOneFV` fieldname)
521 %************************************************************************
523 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
525 %************************************************************************
528 rnIPBinds [] = returnRn ([], emptyFVs)
529 rnIPBinds ((n, expr) : binds)
530 = newIPName n `thenRn` \ name ->
531 rnExpr expr `thenRn` \ (expr',fvExpr) ->
532 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
533 returnRn ((name, expr') : binds', fvExpr `plusFV` fvBinds)
537 %************************************************************************
539 \subsubsection{@Stmt@s: in @do@ expressions}
541 %************************************************************************
543 Note that although some bound vars may appear in the free var set for
544 the first qual, these will eventually be removed by the caller. For
545 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
546 @[q <- r, p <- q]@, the free var set for @q <- r@ will
547 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
548 @r@ will be removed only when we finally return from examining all the
552 rnStmts :: [RdrNameStmt]
553 -> RnMS (([Name], [RenamedStmt]), FreeVars)
556 = returnRn (([], []), emptyFVs)
559 = getLocalNameEnv `thenRn` \ name_env ->
560 rnStmt stmt $ \ stmt' ->
561 rnStmts stmts `thenRn` \ ((binders, stmts'), fvs) ->
562 returnRn ((binders, stmt' : stmts'), fvs)
564 rnStmt :: RdrNameStmt
565 -> (RenamedStmt -> RnMS (([Name], a), FreeVars))
566 -> RnMS (([Name], a), FreeVars)
567 -- The thing list of names returned is the list returned by the
568 -- thing_inside, plus the binders of the arguments stmt
570 -- Because of mutual recursion we have to pass in rnExpr.
572 rnStmt (ParStmt stmtss) thing_inside
573 = mapFvRn rnStmts stmtss `thenRn` \ (bndrstmtss, fv_stmtss) ->
574 let binderss = map fst bndrstmtss
575 checkBndrs all_bndrs bndrs
576 = checkRn (null (intersectBy eqOcc all_bndrs bndrs)) err `thenRn_`
577 returnRn (bndrs ++ all_bndrs)
578 eqOcc n1 n2 = nameOccName n1 == nameOccName n2
579 err = text "duplicate binding in parallel list comprehension"
581 foldlRn checkBndrs [] binderss `thenRn` \ new_binders ->
582 bindLocalNamesFV new_binders $
583 thing_inside (ParStmtOut bndrstmtss)`thenRn` \ ((rest_bndrs, result), fv_rest) ->
584 returnRn ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
586 rnStmt (BindStmt pat expr src_loc) thing_inside
587 = pushSrcLocRn src_loc $
588 rnExpr expr `thenRn` \ (expr', fv_expr) ->
589 bindPatSigTyVars (collectSigTysFromPat pat) $ \ sig_tyvars ->
590 bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
591 rnPat pat `thenRn` \ (pat', fv_pat) ->
592 thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ ((rest_binders, result), fvs) ->
593 returnRn ((new_binders ++ rest_binders, result),
594 fv_expr `plusFV` fvs `plusFV` fv_pat)
596 doc = text "In a pattern in 'do' binding"
598 rnStmt (ExprStmt expr _ src_loc) thing_inside
599 = pushSrcLocRn src_loc $
600 rnExpr expr `thenRn` \ (expr', fv_expr) ->
601 thing_inside (ExprStmt expr' placeHolderType src_loc) `thenRn` \ (result, fvs) ->
602 returnRn (result, fv_expr `plusFV` fvs)
604 rnStmt (ResultStmt expr src_loc) thing_inside
605 = pushSrcLocRn src_loc $
606 rnExpr expr `thenRn` \ (expr', fv_expr) ->
607 thing_inside (ResultStmt expr' src_loc) `thenRn` \ (result, fvs) ->
608 returnRn (result, fv_expr `plusFV` fvs)
610 rnStmt (LetStmt binds) thing_inside
611 = rnBinds binds $ \ binds' ->
612 let new_binders = collectHsBinders binds' in
613 thing_inside (LetStmt binds') `thenRn` \ ((rest_binders, result), fvs) ->
614 returnRn ((new_binders ++ rest_binders, result), fvs )
617 %************************************************************************
619 \subsubsection{Precedence Parsing}
621 %************************************************************************
623 @mkOpAppRn@ deals with operator fixities. The argument expressions
624 are assumed to be already correctly arranged. It needs the fixities
625 recorded in the OpApp nodes, because fixity info applies to the things
626 the programmer actually wrote, so you can't find it out from the Name.
628 Furthermore, the second argument is guaranteed not to be another
629 operator application. Why? Because the parser parses all
630 operator appications left-associatively, EXCEPT negation, which
631 we need to handle specially.
634 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
635 -> RenamedHsExpr -> Fixity -- Operator and fixity
636 -> RenamedHsExpr -- Right operand (not an OpApp, but might
638 -> RnMS RenamedHsExpr
640 ---------------------------
641 -- (e11 `op1` e12) `op2` e2
642 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
644 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
645 returnRn (OpApp e1 op2 fix2 e2)
648 = mkOpAppRn e12 op2 fix2 e2 `thenRn` \ new_e ->
649 returnRn (OpApp e11 op1 fix1 new_e)
651 (nofix_error, associate_right) = compareFixity fix1 fix2
653 ---------------------------
654 -- (- neg_arg) `op` e2
655 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
657 = addErrRn (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenRn_`
658 returnRn (OpApp e1 op2 fix2 e2)
661 = mkOpAppRn neg_arg op2 fix2 e2 `thenRn` \ new_e ->
662 returnRn (NegApp new_e neg_name)
664 (nofix_error, associate_right) = compareFixity negateFixity fix2
666 ---------------------------
668 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
669 | not associate_right -- We *want* right association
670 = addErrRn (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenRn_`
671 returnRn (OpApp e1 op1 fix1 e2)
673 (_, associate_right) = compareFixity fix1 negateFixity
675 ---------------------------
677 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
678 = ASSERT2( right_op_ok fix e2,
679 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
681 returnRn (OpApp e1 op fix e2)
683 -- Parser left-associates everything, but
684 -- derived instances may have correctly-associated things to
685 -- in the right operarand. So we just check that the right operand is OK
686 right_op_ok fix1 (OpApp _ _ fix2 _)
687 = not error_please && associate_right
689 (error_please, associate_right) = compareFixity fix1 fix2
690 right_op_ok fix1 other
693 -- Parser initially makes negation bind more tightly than any other operator
694 mkNegAppRn neg_arg neg_name
697 getModeRn `thenRn` \ mode ->
698 ASSERT( not_op_app mode neg_arg )
700 returnRn (NegApp neg_arg neg_name)
702 not_op_app SourceMode (OpApp _ _ _ _) = False
703 not_op_app mode other = True
707 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
710 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
713 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
714 returnRn (ConOpPatIn p1 op2 fix2 p2)
717 = mkConOpPatRn p12 op2 fix2 p2 `thenRn` \ new_p ->
718 returnRn (ConOpPatIn p11 op1 fix1 new_p)
721 (nofix_error, associate_right) = compareFixity fix1 fix2
723 mkConOpPatRn p1 op fix p2 -- Default case, no rearrangment
724 = ASSERT( not_op_pat p2 )
725 returnRn (ConOpPatIn p1 op fix p2)
727 not_op_pat (ConOpPatIn _ _ _ _) = False
728 not_op_pat other = True
732 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
734 checkPrecMatch False fn match
737 checkPrecMatch True op (Match _ (p1:p2:_) _ _)
738 -- True indicates an infix lhs
739 = getModeRn `thenRn` \ mode ->
740 -- See comments with rnExpr (OpApp ...)
741 if isInterfaceMode mode
743 else checkPrec op p1 False `thenRn_`
746 checkPrecMatch True op _ = panic "checkPrecMatch"
748 checkPrec op (ConOpPatIn _ op1 _ _) right
749 = lookupFixityRn op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
750 lookupFixityRn op1 `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
752 inf_ok = op1_prec > op_prec ||
753 (op1_prec == op_prec &&
754 (op1_dir == InfixR && op_dir == InfixR && right ||
755 op1_dir == InfixL && op_dir == InfixL && not right))
757 info = (ppr_op op, op_fix)
758 info1 = (ppr_op op1, op1_fix)
759 (infol, infor) = if right then (info, info1) else (info1, info)
761 checkRn inf_ok (precParseErr infol infor)
763 checkPrec op pat right
766 -- Check precedence of (arg op) or (op arg) respectively
767 -- If arg is itself an operator application, its precedence should
768 -- be higher than that of op
769 checkSectionPrec left_or_right section op arg
771 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
772 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
776 go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
777 = lookupFixityRn op_name `thenRn` \ op_fix@(Fixity op_prec _) ->
778 checkRn (op_prec < arg_prec)
779 (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
786 @(compareFixity op1 op2)@ tells which way to arrange appication, or
787 whether there's an error.
790 compareFixity :: Fixity -> Fixity
791 -> (Bool, -- Error please
792 Bool) -- Associate to the right: a op1 (b op2 c)
793 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
794 = case prec1 `compare` prec2 of
797 EQ -> case (dir1, dir2) of
798 (InfixR, InfixR) -> right
799 (InfixL, InfixL) -> left
802 right = (False, True)
803 left = (False, False)
804 error_please = (True, False)
807 %************************************************************************
809 \subsubsection{Literals}
811 %************************************************************************
813 When literals occur we have to make sure
814 that the types and classes they involve
819 = checkRn (inCharRange c) (bogusCharError c) `thenRn_`
820 returnRn (unitFV charTyCon_name)
822 litFVs (HsCharPrim c) = returnRn (unitFV (getName charPrimTyCon))
823 litFVs (HsString s) = returnRn (mkFVs [listTyCon_name, charTyCon_name])
824 litFVs (HsStringPrim s) = returnRn (unitFV (getName addrPrimTyCon))
825 litFVs (HsInt i) = returnRn (unitFV (getName intTyCon))
826 litFVs (HsIntPrim i) = returnRn (unitFV (getName intPrimTyCon))
827 litFVs (HsFloatPrim f) = returnRn (unitFV (getName floatPrimTyCon))
828 litFVs (HsDoublePrim d) = returnRn (unitFV (getName doublePrimTyCon))
829 litFVs (HsLitLit l bogus_ty) = lookupOrigName cCallableClass_RDR `thenRn` \ cc ->
831 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
832 -- in post-typechecker translations
834 rnOverLit (HsIntegral i from_integer_name)
835 = lookupSyntaxName from_integer_name `thenRn` \ from_integer_name' ->
837 returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
839 lookupOrigNames [plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
840 -- Big integer literals are built, using + and *,
841 -- out of small integers (DsUtils.mkIntegerLit)
842 -- [NB: plusInteger, timesInteger aren't rebindable...
843 -- they are used to construct the argument to fromInteger,
844 -- which is the rebindable one.]
845 returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
847 rnOverLit (HsFractional i from_rat_name)
848 = lookupSyntaxName from_rat_name `thenRn` \ from_rat_name' ->
849 lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
850 -- We have to make sure that the Ratio type is imported with
851 -- its constructor, because literals of type Ratio t are
852 -- built with that constructor.
853 -- The Rational type is needed too, but that will come in
854 -- when fractionalClass does.
855 -- The plus/times integer operations may be needed to construct the numerator
856 -- and denominator (see DsUtils.mkIntegerLit)
857 returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
860 %************************************************************************
862 \subsubsection{Assertion utils}
864 %************************************************************************
867 mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
869 lookupOrigName assertErr_RDR `thenRn` \ name ->
870 getSrcLocRn `thenRn` \ sloc ->
872 -- if we're ignoring asserts, return (\ _ e -> e)
873 -- if not, return (assertError "src-loc")
875 if opt_IgnoreAsserts then
876 getUniqRn `thenRn` \ uniq ->
878 vname = mkSysLocalName uniq SLIT("v")
879 expr = HsLam ignorePredMatch
880 loc = nameSrcLoc vname
881 ignorePredMatch = mkSimpleMatch [WildPatIn, VarPatIn vname] (HsVar vname) placeHolderType loc
883 returnRn (expr, unitFV name)
888 (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
891 returnRn (expr, unitFV name)
895 %************************************************************************
897 \subsubsection{Errors}
899 %************************************************************************
902 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
903 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
904 pp_prefix_minus = ptext SLIT("prefix `-'")
906 dupFieldErr str (dup:rest)
907 = hsep [ptext SLIT("duplicate field name"),
909 ptext SLIT("in record"), text str]
912 = hang (ptext SLIT("precedence parsing error"))
913 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
915 ptext SLIT("in the same infix expression")])
917 sectionPrecErr op arg_op section
918 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
919 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
920 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
924 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
928 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
929 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
932 = sep [ptext SLIT("Pattern syntax in expression context:"),
936 = sep [ptext SLIT("`do' statements must end in expression:"),
940 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''