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, minusName, negateName, fromIntegerName,
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,
38 fromInteger_RDR, fromRational_RDR,
40 import TysPrim ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
41 floatPrimTyCon, doublePrimTyCon
43 import TysWiredIn ( intTyCon )
44 import Name ( NamedThing(..), mkSysLocalName, nameSrcLoc )
46 import UniqFM ( isNullUFM )
47 import FiniteMap ( elemFM )
48 import UniqSet ( emptyUniqSet )
49 import List ( intersectBy )
50 import ListSetOps ( unionLists, removeDups )
51 import Maybes ( maybeToBool )
56 *********************************************************
60 *********************************************************
63 rnPat :: RdrNamePat -> RnMS (RenamedPat, FreeVars)
65 rnPat WildPatIn = returnRn (WildPatIn, emptyFVs)
68 = lookupBndrRn name `thenRn` \ vname ->
69 returnRn (VarPatIn vname, emptyFVs)
71 rnPat (SigPatIn pat ty)
72 = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
75 then rnPat pat `thenRn` \ (pat', fvs1) ->
76 rnHsTypeFVs doc ty `thenRn` \ (ty', fvs2) ->
77 returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
79 else addErrRn (patSigErr ty) `thenRn_`
82 doc = text "a pattern type-signature"
84 rnPat (LitPatIn s@(HsString _))
85 = lookupOrigName eqString_RDR `thenRn` \ eq ->
86 returnRn (LitPatIn s, unitFV eq)
89 = litFVs lit `thenRn` \ fvs ->
90 returnRn (LitPatIn lit, fvs)
93 = rnOverLit lit `thenRn` \ (lit', fvs1) ->
94 lookupOrigName eqClass_RDR `thenRn` \ eq -> -- Needed to find equality on pattern
95 returnRn (NPatIn lit', fvs1 `addOneFV` eq)
97 rnPat (NPlusKPatIn name lit minus)
98 = rnOverLit lit `thenRn` \ (lit', fvs) ->
99 lookupOrigName ordClass_RDR `thenRn` \ ord ->
100 lookupBndrRn name `thenRn` \ name' ->
101 lookupSyntaxName minus `thenRn` \ minus' ->
102 returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
104 rnPat (LazyPatIn pat)
105 = rnPat pat `thenRn` \ (pat', fvs) ->
106 returnRn (LazyPatIn pat', fvs)
108 rnPat (AsPatIn name pat)
109 = rnPat pat `thenRn` \ (pat', fvs) ->
110 lookupBndrRn name `thenRn` \ vname ->
111 returnRn (AsPatIn vname pat', fvs)
113 rnPat (ConPatIn con pats)
114 = lookupOccRn con `thenRn` \ con' ->
115 mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
116 returnRn (ConPatIn con' patslist, fvs `addOneFV` con')
118 rnPat (ConOpPatIn pat1 con _ pat2)
119 = rnPat pat1 `thenRn` \ (pat1', fvs1) ->
120 lookupOccRn con `thenRn` \ con' ->
121 rnPat pat2 `thenRn` \ (pat2', fvs2) ->
123 getModeRn `thenRn` \ mode ->
124 -- See comments with rnExpr (OpApp ...)
125 (if isInterfaceMode mode
126 then returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
127 else lookupFixityRn con' `thenRn` \ fixity ->
128 mkConOpPatRn pat1' con' fixity pat2'
130 returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
133 = rnPat pat `thenRn` \ (pat', fvs) ->
134 returnRn (ParPatIn pat', fvs)
136 rnPat (ListPatIn pats)
137 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
138 returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
140 rnPat (TuplePatIn pats boxed)
141 = mapFvRn rnPat pats `thenRn` \ (patslist, fvs) ->
142 returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
144 tycon_name = tupleTyCon_name boxed (length pats)
146 rnPat (RecPatIn con rpats)
147 = lookupOccRn con `thenRn` \ con' ->
148 rnRpats rpats `thenRn` \ (rpats', fvs) ->
149 returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
151 rnPat (TypePatIn name) =
152 rnHsTypeFVs (text "type pattern") name `thenRn` \ (name', fvs) ->
153 returnRn (TypePatIn name', fvs)
156 ************************************************************************
160 ************************************************************************
163 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
165 rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
166 = pushSrcLocRn (getMatchLoc match) $
168 -- Bind pattern-bound type variables
170 rhs_sig_tys = case maybe_rhs_sig of
173 pat_sig_tys = collectSigTysFromPats pats
174 doc_sig = text "In a result type-signature"
175 doc_pat = pprMatchContext ctxt
177 bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys) $ \ sig_tyvars ->
179 -- Note that we do a single bindLocalsRn for all the
180 -- matches together, so that we spot the repeated variable in
182 bindLocalsFVRn doc_pat (collectPatsBinders pats) $ \ new_binders ->
184 mapFvRn rnPat pats `thenRn` \ (pats', pat_fvs) ->
185 rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) ->
186 doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
187 (case maybe_rhs_sig of
188 Nothing -> returnRn (Nothing, emptyFVs)
189 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenRn` \ (ty', ty_fvs) ->
190 returnRn (Just ty', ty_fvs)
191 | otherwise -> addErrRn (patSigErr ty) `thenRn_`
192 returnRn (Nothing, emptyFVs)
193 ) `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
196 binder_set = mkNameSet new_binders
197 unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
198 all_fvs = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
200 warnUnusedMatches unused_binders `thenRn_`
202 returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
203 -- The bindLocals and bindTyVars will remove the bound FVs
206 bindPatSigTyVars :: [RdrNameHsType]
207 -> ([Name] -> RnMS (a, FreeVars))
208 -> RnMS (a, FreeVars)
209 -- Find the type variables in the pattern type
210 -- signatures that must be brought into scope
211 bindPatSigTyVars tys thing_inside
212 = getLocalNameEnv `thenRn` \ name_env ->
214 tyvars_in_sigs = extractHsTysRdrTyVars tys
215 forall_tyvars = filter (not . (`elemFM` name_env)) tyvars_in_sigs
216 doc_sig = text "In a pattern type-signature"
218 bindNakedTyVarsFVRn doc_sig forall_tyvars thing_inside
221 %************************************************************************
223 \subsubsection{Guarded right-hand sides (GRHSs)}
225 %************************************************************************
228 rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
230 rnGRHSs (GRHSs grhss binds _)
231 = rnBinds binds $ \ binds' ->
232 mapFvRn rnGRHS grhss `thenRn` \ (grhss', fvGRHSs) ->
233 returnRn (GRHSs grhss' binds' placeHolderType, fvGRHSs)
235 rnGRHS (GRHS guarded locn)
236 = doptRn Opt_GlasgowExts `thenRn` \ opt_GlasgowExts ->
238 (if not (opt_GlasgowExts || is_standard_guard guarded) then
239 addWarnRn (nonStdGuardErr guarded)
244 rnStmts guarded `thenRn` \ ((_, guarded'), fvs) ->
245 returnRn (GRHS guarded' locn, fvs)
247 -- Standard Haskell 1.4 guards are just a single boolean
248 -- expression, rather than a list of qualifiers as in the
250 is_standard_guard [ResultStmt _ _] = True
251 is_standard_guard [ExprStmt _ _ _, ResultStmt _ _] = True
252 is_standard_guard other = False
255 %************************************************************************
257 \subsubsection{Expressions}
259 %************************************************************************
262 rnExprs :: [RdrNameHsExpr] -> RnMS ([RenamedHsExpr], FreeVars)
263 rnExprs ls = rnExprs' ls emptyUniqSet
265 rnExprs' [] acc = returnRn ([], acc)
266 rnExprs' (expr:exprs) acc
267 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
269 -- Now we do a "seq" on the free vars because typically it's small
270 -- or empty, especially in very long lists of constants
272 acc' = acc `plusFV` fvExpr
274 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenRn` \ (exprs', fvExprs) ->
275 returnRn (expr':exprs', fvExprs)
277 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
278 grubby_seqNameSet ns result | isNullUFM ns = result
282 Variables. We look up the variable and return the resulting name.
285 rnExpr :: RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
288 = lookupOccRn v `thenRn` \ name ->
289 if name `hasKey` assertIdKey then
290 -- We expand it to (GHCerr.assert__ location)
294 returnRn (HsVar name, unitFV name)
297 = newIPName v `thenRn` \ name ->
298 returnRn (HsIPVar name, emptyFVs)
301 = litFVs lit `thenRn` \ fvs ->
302 returnRn (HsLit lit, fvs)
304 rnExpr (HsOverLit lit)
305 = rnOverLit lit `thenRn` \ (lit', fvs) ->
306 returnRn (HsOverLit lit', fvs)
309 = rnMatch LambdaExpr match `thenRn` \ (match', fvMatch) ->
310 returnRn (HsLam match', fvMatch)
312 rnExpr (HsApp fun arg)
313 = rnExpr fun `thenRn` \ (fun',fvFun) ->
314 rnExpr arg `thenRn` \ (arg',fvArg) ->
315 returnRn (HsApp fun' arg', fvFun `plusFV` fvArg)
317 rnExpr (OpApp e1 op _ e2)
318 = rnExpr e1 `thenRn` \ (e1', fv_e1) ->
319 rnExpr e2 `thenRn` \ (e2', fv_e2) ->
320 rnExpr op `thenRn` \ (op'@(HsVar op_name), fv_op) ->
323 -- When renaming code synthesised from "deriving" declarations
324 -- we're in Interface mode, and we should ignore fixity; assume
325 -- that the deriving code generator got the association correct
326 -- Don't even look up the fixity when in interface mode
327 getModeRn `thenRn` \ mode ->
328 (if isInterfaceMode mode
329 then returnRn (OpApp e1' op' defaultFixity e2')
330 else lookupFixityRn op_name `thenRn` \ fixity ->
331 mkOpAppRn e1' op' fixity e2'
332 ) `thenRn` \ final_e ->
335 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
337 rnExpr (NegApp e neg_name)
338 = rnExpr e `thenRn` \ (e', fv_e) ->
339 lookupSyntaxName neg_name `thenRn` \ neg_name' ->
340 mkNegAppRn e' neg_name' `thenRn` \ final_e ->
341 returnRn (final_e, fv_e `addOneFV` neg_name')
344 = rnExpr e `thenRn` \ (e', fvs_e) ->
345 returnRn (HsPar e', fvs_e)
347 rnExpr section@(SectionL expr op)
348 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
349 rnExpr op `thenRn` \ (op', fvs_op) ->
350 checkSectionPrec "left" section op' expr' `thenRn_`
351 returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
353 rnExpr section@(SectionR op expr)
354 = rnExpr op `thenRn` \ (op', fvs_op) ->
355 rnExpr expr `thenRn` \ (expr', fvs_expr) ->
356 checkSectionPrec "right" section op' expr' `thenRn_`
357 returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
359 rnExpr (HsCCall fun args may_gc is_casm _)
360 -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
361 = lookupOrigNames [cCallableClass_RDR,
362 cReturnableClass_RDR,
363 ioDataCon_RDR] `thenRn` \ implicit_fvs ->
364 rnExprs args `thenRn` \ (args', fvs_args) ->
365 returnRn (HsCCall fun args' may_gc is_casm placeHolderType,
366 fvs_args `plusFV` implicit_fvs)
368 rnExpr (HsSCC lbl expr)
369 = rnExpr expr `thenRn` \ (expr', fvs_expr) ->
370 returnRn (HsSCC lbl expr', fvs_expr)
372 rnExpr (HsCase expr ms src_loc)
373 = pushSrcLocRn src_loc $
374 rnExpr expr `thenRn` \ (new_expr, e_fvs) ->
375 mapFvRn (rnMatch CaseAlt) ms `thenRn` \ (new_ms, ms_fvs) ->
376 returnRn (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
378 rnExpr (HsLet binds expr)
379 = rnBinds binds $ \ binds' ->
380 rnExpr expr `thenRn` \ (expr',fvExpr) ->
381 returnRn (HsLet binds' expr', fvExpr)
383 rnExpr (HsWith expr binds)
384 = rnExpr expr `thenRn` \ (expr',fvExpr) ->
385 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
386 returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
388 rnExpr e@(HsDo do_or_lc stmts src_loc)
389 = pushSrcLocRn src_loc $
390 lookupOrigNames implicit_rdr_names `thenRn` \ implicit_fvs ->
391 rnStmts stmts `thenRn` \ ((_, stmts'), fvs) ->
392 -- check the statement list ends in an expression
393 case last stmts' of {
394 ResultStmt _ _ -> returnRn () ;
395 _ -> addErrRn (doStmtListErr e)
397 returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
399 implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
400 -- Monad stuff should not be necessary for a list comprehension
401 -- but the typechecker looks up the bind and return Ids anyway
405 rnExpr (ExplicitList _ exps)
406 = rnExprs exps `thenRn` \ (exps', fvs) ->
407 returnRn (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
409 rnExpr (ExplicitTuple exps boxity)
410 = rnExprs exps `thenRn` \ (exps', fvs) ->
411 returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
413 tycon_name = tupleTyCon_name boxity (length exps)
415 rnExpr (RecordCon con_id rbinds)
416 = lookupOccRn con_id `thenRn` \ conname ->
417 rnRbinds "construction" rbinds `thenRn` \ (rbinds', fvRbinds) ->
418 returnRn (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
420 rnExpr (RecordUpd expr rbinds)
421 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
422 rnRbinds "update" rbinds `thenRn` \ (rbinds', fvRbinds) ->
423 returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
425 rnExpr (ExprWithTySig expr pty)
426 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
427 rnHsTypeFVs (text "an expression type signature") pty `thenRn` \ (pty', fvTy) ->
428 returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
430 rnExpr (HsIf p b1 b2 src_loc)
431 = pushSrcLocRn src_loc $
432 rnExpr p `thenRn` \ (p', fvP) ->
433 rnExpr b1 `thenRn` \ (b1', fvB1) ->
434 rnExpr b2 `thenRn` \ (b2', fvB2) ->
435 returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
438 = rnHsTypeFVs doc a `thenRn` \ (t, fvT) ->
439 returnRn (HsType t, fvT)
441 doc = text "renaming a type pattern"
443 rnExpr (ArithSeqIn seq)
444 = lookupOrigName enumClass_RDR `thenRn` \ enum ->
445 rn_seq seq `thenRn` \ (new_seq, fvs) ->
446 returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
449 = rnExpr expr `thenRn` \ (expr', fvExpr) ->
450 returnRn (From expr', fvExpr)
452 rn_seq (FromThen expr1 expr2)
453 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
454 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
455 returnRn (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
457 rn_seq (FromTo expr1 expr2)
458 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
459 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
460 returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
462 rn_seq (FromThenTo expr1 expr2 expr3)
463 = rnExpr expr1 `thenRn` \ (expr1', fvExpr1) ->
464 rnExpr expr2 `thenRn` \ (expr2', fvExpr2) ->
465 rnExpr expr3 `thenRn` \ (expr3', fvExpr3) ->
466 returnRn (FromThenTo expr1' expr2' expr3',
467 plusFVs [fvExpr1, fvExpr2, fvExpr3])
470 These three are pattern syntax appearing in expressions.
471 Since all the symbols are reservedops we can simply reject them.
472 We return a (bogus) EWildPat in each case.
475 rnExpr e@EWildPat = addErrRn (patSynErr e) `thenRn_`
476 returnRn (EWildPat, emptyFVs)
478 rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e) `thenRn_`
479 returnRn (EWildPat, emptyFVs)
481 rnExpr e@(ELazyPat _) = addErrRn (patSynErr e) `thenRn_`
482 returnRn (EWildPat, emptyFVs)
487 %************************************************************************
489 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
491 %************************************************************************
495 = mapRn_ field_dup_err dup_fields `thenRn_`
496 mapFvRn rn_rbind rbinds `thenRn` \ (rbinds', fvRbind) ->
497 returnRn (rbinds', fvRbind)
499 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rbinds ]
501 field_dup_err dups = addErrRn (dupFieldErr str dups)
503 rn_rbind (field, expr, pun)
504 = lookupGlobalOccRn field `thenRn` \ fieldname ->
505 rnExpr expr `thenRn` \ (expr', fvExpr) ->
506 returnRn ((fieldname, expr', pun), fvExpr `addOneFV` fieldname)
509 = mapRn_ field_dup_err dup_fields `thenRn_`
510 mapFvRn rn_rpat rpats `thenRn` \ (rpats', fvs) ->
511 returnRn (rpats', fvs)
513 (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rpats ]
515 field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
517 rn_rpat (field, pat, pun)
518 = lookupGlobalOccRn field `thenRn` \ fieldname ->
519 rnPat pat `thenRn` \ (pat', fvs) ->
520 returnRn ((fieldname, pat', pun), fvs `addOneFV` fieldname)
523 %************************************************************************
525 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
527 %************************************************************************
530 rnIPBinds [] = returnRn ([], emptyFVs)
531 rnIPBinds ((n, expr) : binds)
532 = newIPName n `thenRn` \ name ->
533 rnExpr expr `thenRn` \ (expr',fvExpr) ->
534 rnIPBinds binds `thenRn` \ (binds',fvBinds) ->
535 returnRn ((name, expr') : binds', fvExpr `plusFV` fvBinds)
539 %************************************************************************
541 \subsubsection{@Stmt@s: in @do@ expressions}
543 %************************************************************************
545 Note that although some bound vars may appear in the free var set for
546 the first qual, these will eventually be removed by the caller. For
547 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
548 @[q <- r, p <- q]@, the free var set for @q <- r@ will
549 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
550 @r@ will be removed only when we finally return from examining all the
554 rnStmts :: [RdrNameStmt]
555 -> RnMS (([Name], [RenamedStmt]), FreeVars)
558 = returnRn (([], []), emptyFVs)
561 = getLocalNameEnv `thenRn` \ name_env ->
562 rnStmt stmt $ \ stmt' ->
563 rnStmts stmts `thenRn` \ ((binders, stmts'), fvs) ->
564 returnRn ((binders, stmt' : stmts'), fvs)
566 rnStmt :: RdrNameStmt
567 -> (RenamedStmt -> RnMS (([Name], a), FreeVars))
568 -> RnMS (([Name], a), FreeVars)
569 -- The thing list of names returned is the list returned by the
570 -- thing_inside, plus the binders of the arguments stmt
572 -- Because of mutual recursion we have to pass in rnExpr.
574 rnStmt (ParStmt stmtss) thing_inside
575 = mapFvRn rnStmts stmtss `thenRn` \ (bndrstmtss, fv_stmtss) ->
576 let binderss = map fst bndrstmtss
577 checkBndrs all_bndrs bndrs
578 = checkRn (null (intersectBy eqOcc all_bndrs bndrs)) err `thenRn_`
579 returnRn (bndrs ++ all_bndrs)
580 eqOcc n1 n2 = nameOccName n1 == nameOccName n2
581 err = text "duplicate binding in parallel list comprehension"
583 foldlRn checkBndrs [] binderss `thenRn` \ new_binders ->
584 bindLocalNamesFV new_binders $
585 thing_inside (ParStmtOut bndrstmtss)`thenRn` \ ((rest_bndrs, result), fv_rest) ->
586 returnRn ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
588 rnStmt (BindStmt pat expr src_loc) thing_inside
589 = pushSrcLocRn src_loc $
590 rnExpr expr `thenRn` \ (expr', fv_expr) ->
591 bindPatSigTyVars (collectSigTysFromPat pat) $ \ sig_tyvars ->
592 bindLocalsFVRn doc (collectPatBinders pat) $ \ new_binders ->
593 rnPat pat `thenRn` \ (pat', fv_pat) ->
594 thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ ((rest_binders, result), fvs) ->
595 returnRn ((new_binders ++ rest_binders, result),
596 fv_expr `plusFV` fvs `plusFV` fv_pat)
598 doc = text "In a pattern in 'do' binding"
600 rnStmt (ExprStmt expr _ src_loc) thing_inside
601 = pushSrcLocRn src_loc $
602 rnExpr expr `thenRn` \ (expr', fv_expr) ->
603 thing_inside (ExprStmt expr' placeHolderType src_loc) `thenRn` \ (result, fvs) ->
604 returnRn (result, fv_expr `plusFV` fvs)
606 rnStmt (ResultStmt expr src_loc) thing_inside
607 = pushSrcLocRn src_loc $
608 rnExpr expr `thenRn` \ (expr', fv_expr) ->
609 thing_inside (ResultStmt expr' src_loc) `thenRn` \ (result, fvs) ->
610 returnRn (result, fv_expr `plusFV` fvs)
612 rnStmt (LetStmt binds) thing_inside
613 = rnBinds binds $ \ binds' ->
614 let new_binders = collectHsBinders binds' in
615 thing_inside (LetStmt binds') `thenRn` \ ((rest_binders, result), fvs) ->
616 returnRn ((new_binders ++ rest_binders, result), fvs )
619 %************************************************************************
621 \subsubsection{Precedence Parsing}
623 %************************************************************************
625 @mkOpAppRn@ deals with operator fixities. The argument expressions
626 are assumed to be already correctly arranged. It needs the fixities
627 recorded in the OpApp nodes, because fixity info applies to the things
628 the programmer actually wrote, so you can't find it out from the Name.
630 Furthermore, the second argument is guaranteed not to be another
631 operator application. Why? Because the parser parses all
632 operator appications left-associatively, EXCEPT negation, which
633 we need to handle specially.
636 mkOpAppRn :: RenamedHsExpr -- Left operand; already rearranged
637 -> RenamedHsExpr -> Fixity -- Operator and fixity
638 -> RenamedHsExpr -- Right operand (not an OpApp, but might
640 -> RnMS RenamedHsExpr
642 ---------------------------
643 -- (e11 `op1` e12) `op2` e2
644 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
646 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
647 returnRn (OpApp e1 op2 fix2 e2)
650 = mkOpAppRn e12 op2 fix2 e2 `thenRn` \ new_e ->
651 returnRn (OpApp e11 op1 fix1 new_e)
653 (nofix_error, associate_right) = compareFixity fix1 fix2
655 ---------------------------
656 -- (- neg_arg) `op` e2
657 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
659 = addErrRn (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenRn_`
660 returnRn (OpApp e1 op2 fix2 e2)
663 = mkOpAppRn neg_arg op2 fix2 e2 `thenRn` \ new_e ->
664 returnRn (NegApp new_e neg_name)
666 (nofix_error, associate_right) = compareFixity negateFixity fix2
668 ---------------------------
670 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _) -- NegApp can occur on the right
671 | not associate_right -- We *want* right association
672 = addErrRn (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenRn_`
673 returnRn (OpApp e1 op1 fix1 e2)
675 (_, associate_right) = compareFixity fix1 negateFixity
677 ---------------------------
679 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
680 = ASSERT2( right_op_ok fix e2,
681 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
683 returnRn (OpApp e1 op fix e2)
685 -- Parser left-associates everything, but
686 -- derived instances may have correctly-associated things to
687 -- in the right operarand. So we just check that the right operand is OK
688 right_op_ok fix1 (OpApp _ _ fix2 _)
689 = not error_please && associate_right
691 (error_please, associate_right) = compareFixity fix1 fix2
692 right_op_ok fix1 other
695 -- Parser initially makes negation bind more tightly than any other operator
696 mkNegAppRn neg_arg neg_name
699 getModeRn `thenRn` \ mode ->
700 ASSERT( not_op_app mode neg_arg )
702 returnRn (NegApp neg_arg neg_name)
704 not_op_app SourceMode (OpApp _ _ _ _) = False
705 not_op_app mode other = True
709 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
712 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
715 = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
716 returnRn (ConOpPatIn p1 op2 fix2 p2)
719 = mkConOpPatRn p12 op2 fix2 p2 `thenRn` \ new_p ->
720 returnRn (ConOpPatIn p11 op1 fix1 new_p)
723 (nofix_error, associate_right) = compareFixity fix1 fix2
725 mkConOpPatRn p1 op fix p2 -- Default case, no rearrangment
726 = ASSERT( not_op_pat p2 )
727 returnRn (ConOpPatIn p1 op fix p2)
729 not_op_pat (ConOpPatIn _ _ _ _) = False
730 not_op_pat other = True
734 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
736 checkPrecMatch False fn match
739 checkPrecMatch True op (Match _ (p1:p2:_) _ _)
740 -- True indicates an infix lhs
741 = getModeRn `thenRn` \ mode ->
742 -- See comments with rnExpr (OpApp ...)
743 if isInterfaceMode mode
745 else checkPrec op p1 False `thenRn_`
748 checkPrecMatch True op _ = panic "checkPrecMatch"
750 checkPrec op (ConOpPatIn _ op1 _ _) right
751 = lookupFixityRn op `thenRn` \ op_fix@(Fixity op_prec op_dir) ->
752 lookupFixityRn op1 `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
754 inf_ok = op1_prec > op_prec ||
755 (op1_prec == op_prec &&
756 (op1_dir == InfixR && op_dir == InfixR && right ||
757 op1_dir == InfixL && op_dir == InfixL && not right))
759 info = (ppr_op op, op_fix)
760 info1 = (ppr_op op1, op1_fix)
761 (infol, infor) = if right then (info, info1) else (info1, info)
763 checkRn inf_ok (precParseErr infol infor)
765 checkPrec op pat right
768 -- Check precedence of (arg op) or (op arg) respectively
769 -- If arg is itself an operator application, its precedence should
770 -- be higher than that of op
771 checkSectionPrec left_or_right section op arg
773 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
774 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
778 go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
779 = lookupFixityRn op_name `thenRn` \ op_fix@(Fixity op_prec _) ->
780 checkRn (op_prec < arg_prec)
781 (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
788 @(compareFixity op1 op2)@ tells which way to arrange appication, or
789 whether there's an error.
792 compareFixity :: Fixity -> Fixity
793 -> (Bool, -- Error please
794 Bool) -- Associate to the right: a op1 (b op2 c)
795 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
796 = case prec1 `compare` prec2 of
799 EQ -> case (dir1, dir2) of
800 (InfixR, InfixR) -> right
801 (InfixL, InfixL) -> left
804 right = (False, True)
805 left = (False, False)
806 error_please = (True, False)
809 %************************************************************************
811 \subsubsection{Literals}
813 %************************************************************************
815 When literals occur we have to make sure
816 that the types and classes they involve
821 = checkRn (inCharRange c) (bogusCharError c) `thenRn_`
822 returnRn (unitFV charTyCon_name)
824 litFVs (HsCharPrim c) = returnRn (unitFV (getName charPrimTyCon))
825 litFVs (HsString s) = returnRn (mkFVs [listTyCon_name, charTyCon_name])
826 litFVs (HsStringPrim s) = returnRn (unitFV (getName addrPrimTyCon))
827 litFVs (HsInt i) = returnRn (unitFV (getName intTyCon))
828 litFVs (HsIntPrim i) = returnRn (unitFV (getName intPrimTyCon))
829 litFVs (HsFloatPrim f) = returnRn (unitFV (getName floatPrimTyCon))
830 litFVs (HsDoublePrim d) = returnRn (unitFV (getName doublePrimTyCon))
831 litFVs (HsLitLit l bogus_ty) = lookupOrigName cCallableClass_RDR `thenRn` \ cc ->
833 litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat only appear
834 -- in post-typechecker translations
836 rnOverLit (HsIntegral i from_integer_name)
837 = lookupSyntaxName from_integer_name `thenRn` \ from_integer_name' ->
839 returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
841 lookupOrigNames [plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
842 -- Big integer literals are built, using + and *,
843 -- out of small integers (DsUtils.mkIntegerLit)
844 -- [NB: plusInteger, timesInteger aren't rebindable...
845 -- they are used to construct the argument to fromInteger,
846 -- which is the rebindable one.]
847 returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
849 rnOverLit (HsFractional i from_rat_name)
850 = lookupSyntaxName from_rat_name `thenRn` \ from_rat_name' ->
851 lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns ->
852 -- We have to make sure that the Ratio type is imported with
853 -- its constructor, because literals of type Ratio t are
854 -- built with that constructor.
855 -- The Rational type is needed too, but that will come in
856 -- when fractionalClass does.
857 -- The plus/times integer operations may be needed to construct the numerator
858 -- and denominator (see DsUtils.mkIntegerLit)
859 returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
862 %************************************************************************
864 \subsubsection{Assertion utils}
866 %************************************************************************
869 mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
871 lookupOrigName assertErr_RDR `thenRn` \ name ->
872 getSrcLocRn `thenRn` \ sloc ->
874 -- if we're ignoring asserts, return (\ _ e -> e)
875 -- if not, return (assertError "src-loc")
877 if opt_IgnoreAsserts then
878 getUniqRn `thenRn` \ uniq ->
880 vname = mkSysLocalName uniq SLIT("v")
881 expr = HsLam ignorePredMatch
882 loc = nameSrcLoc vname
883 ignorePredMatch = mkSimpleMatch [WildPatIn, VarPatIn vname] (HsVar vname) placeHolderType loc
885 returnRn (expr, unitFV name)
890 (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
893 returnRn (expr, unitFV name)
897 %************************************************************************
899 \subsubsection{Errors}
901 %************************************************************************
904 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
905 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
906 pp_prefix_minus = ptext SLIT("prefix `-'")
908 dupFieldErr str (dup:rest)
909 = hsep [ptext SLIT("duplicate field name"),
911 ptext SLIT("in record"), text str]
914 = hang (ptext SLIT("precedence parsing error"))
915 4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
917 ptext SLIT("in the same infix expression")])
919 sectionPrecErr op arg_op section
920 = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
921 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
922 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
926 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
930 = (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
931 $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
934 = sep [ptext SLIT("Pattern syntax in expression context:"),
938 = sep [ptext SLIT("`do' statements must end in expression:"),
942 = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''