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 rnMatchGroup, rnMatch, rnGRHSs, rnLExpr, rnExpr, rnStmts,
15 checkPrecMatch, checkTH
18 #include "HsVersions.h"
20 import {-# SOURCE #-} RnSource ( rnSrcDecls, rnBindGroupsAndThen, rnBindGroups, rnSplice )
22 -- RnSource imports RnBinds.rnTopMonoBinds, RnExpr.rnExpr
23 -- RnBinds imports RnExpr.rnMatch, etc
24 -- RnExpr imports [boot] RnSource.rnSrcDecls, RnSource.rnBinds
30 import OccName ( plusOccEnv )
31 import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
32 import RnTypes ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
33 dupFieldErr, precParseErr, sectionPrecErr, patSigErr,
35 import DynFlags ( DynFlag(..) )
36 import BasicTypes ( Fixity(..), FixityDirection(..), negateFixity, compareFixity )
37 import PrelNames ( hasKey, assertIdKey, assertErrorName,
38 loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
39 negateName, thenMName, bindMName, failMName )
40 import Name ( Name, nameOccName )
42 import RdrName ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
43 import UnicodeUtil ( stringToUtf8 )
44 import UniqFM ( isNullUFM )
45 import UniqSet ( emptyUniqSet )
47 import Util ( isSingleton )
48 import ListSetOps ( removeDups )
49 import Maybes ( fromJust )
51 import SrcLoc ( Located(..), unLoc, getLoc, combineLocs, cmpLocated )
54 import List ( unzip4 )
58 ************************************************************************
62 ************************************************************************
65 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
66 rnMatchGroup ctxt (MatchGroup ms _)
67 = mapFvRn (rnMatch ctxt) ms `thenM` \ (new_ms, ms_fvs) ->
68 returnM (MatchGroup new_ms placeHolderType, ms_fvs)
70 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
71 rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)
73 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
75 -- Deal with the rhs type signature
76 bindPatSigTyVarsFV rhs_sig_tys $
77 doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
78 (case maybe_rhs_sig of
79 Nothing -> returnM (Nothing, emptyFVs)
80 Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty `thenM` \ (ty', ty_fvs) ->
81 returnM (Just ty', ty_fvs)
82 | otherwise -> addLocErr ty patSigErr `thenM_`
83 returnM (Nothing, emptyFVs)
84 ) `thenM` \ (maybe_rhs_sig', ty_fvs) ->
87 rnPatsAndThen ctxt pats $ \ pats' ->
88 rnGRHSs ctxt grhss `thenM` \ (grhss', grhss_fvs) ->
90 returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
91 -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
93 rhs_sig_tys = case maybe_rhs_sig of
96 doc_sig = text "In a result type-signature"
100 %************************************************************************
102 \subsubsection{Guarded right-hand sides (GRHSs)}
104 %************************************************************************
107 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
110 rnGRHSs ctxt (GRHSs grhss binds)
111 = rnBindGroupsAndThen binds $ \ binds' ->
112 mapFvRn (rnGRHS ctxt) grhss `thenM` \ (grhss', fvGRHSs) ->
113 returnM (GRHSs grhss' binds', fvGRHSs)
115 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
116 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
118 rnGRHS' ctxt (GRHS guards rhs)
119 = do { opt_GlasgowExts <- doptM Opt_GlasgowExts
120 ; checkM (opt_GlasgowExts || is_standard_guard guards)
121 (addWarn (nonStdGuardErr guards))
123 ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
125 ; return (GRHS guards' rhs', fvs) }
127 -- Standard Haskell 1.4 guards are just a single boolean
128 -- expression, rather than a list of qualifiers as in the
130 is_standard_guard [] = True
131 is_standard_guard [L _ (ExprStmt _ _ _)] = True
132 is_standard_guard other = False
135 %************************************************************************
137 \subsubsection{Expressions}
139 %************************************************************************
142 rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
143 rnExprs ls = rnExprs' ls emptyUniqSet
145 rnExprs' [] acc = returnM ([], acc)
146 rnExprs' (expr:exprs) acc
147 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
149 -- Now we do a "seq" on the free vars because typically it's small
150 -- or empty, especially in very long lists of constants
152 acc' = acc `plusFV` fvExpr
154 (grubby_seqNameSet acc' rnExprs') exprs acc' `thenM` \ (exprs', fvExprs) ->
155 returnM (expr':exprs', fvExprs)
157 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
158 grubby_seqNameSet ns result | isNullUFM ns = result
162 Variables. We look up the variable and return the resulting name.
165 rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
166 rnLExpr = wrapLocFstM rnExpr
168 rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
171 = lookupOccRn v `thenM` \ name ->
172 doptM Opt_IgnoreAsserts `thenM` \ ignore_asserts ->
173 if name `hasKey` assertIdKey && not ignore_asserts then
174 -- We expand it to (GHC.Err.assertError location_string)
175 mkAssertErrorExpr `thenM` \ (e, fvs) ->
176 returnM (e, fvs `addOneFV` name)
177 -- Keep 'assert' as a free var, to ensure it's not reported as unused!
179 -- The normal case. Even if the Id was 'assert', if we are
180 -- ignoring assertions we leave it as GHC.Base.assert;
181 -- this function just ignores its first arg.
182 returnM (HsVar name, unitFV name)
185 = newIPNameRn v `thenM` \ name ->
186 returnM (HsIPVar name, emptyFVs)
190 returnM (HsLit lit, emptyFVs)
192 rnExpr (HsOverLit lit)
193 = rnOverLit lit `thenM` \ (lit', fvs) ->
194 returnM (HsOverLit lit', fvs)
196 rnExpr (HsApp fun arg)
197 = rnLExpr fun `thenM` \ (fun',fvFun) ->
198 rnLExpr arg `thenM` \ (arg',fvArg) ->
199 returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
201 rnExpr (OpApp e1 op _ e2)
202 = rnLExpr e1 `thenM` \ (e1', fv_e1) ->
203 rnLExpr e2 `thenM` \ (e2', fv_e2) ->
204 rnLExpr op `thenM` \ (op'@(L _ (HsVar op_name)), fv_op) ->
207 -- When renaming code synthesised from "deriving" declarations
208 -- we used to avoid fixity stuff, but we can't easily tell any
209 -- more, so I've removed the test. Adding HsPars in TcGenDeriv
210 -- should prevent bad things happening.
211 lookupFixityRn op_name `thenM` \ fixity ->
212 mkOpAppRn e1' op' fixity e2' `thenM` \ final_e ->
215 fv_e1 `plusFV` fv_op `plusFV` fv_e2)
218 = rnLExpr e `thenM` \ (e', fv_e) ->
219 lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
220 mkNegAppRn e' neg_name `thenM` \ final_e ->
221 returnM (final_e, fv_e `plusFV` fv_neg)
224 = rnLExpr e `thenM` \ (e', fvs_e) ->
225 returnM (HsPar e', fvs_e)
227 -- Template Haskell extensions
228 -- Don't ifdef-GHCI them because we want to fail gracefully
229 -- (not with an rnExpr crash) in a stage-1 compiler.
230 rnExpr e@(HsBracket br_body)
231 = checkTH e "bracket" `thenM_`
232 rnBracket br_body `thenM` \ (body', fvs_e) ->
233 returnM (HsBracket body', fvs_e)
235 rnExpr e@(HsSpliceE splice)
236 = rnSplice splice `thenM` \ (splice', fvs) ->
237 returnM (HsSpliceE splice', fvs)
239 rnExpr section@(SectionL expr op)
240 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
241 rnLExpr op `thenM` \ (op', fvs_op) ->
242 checkSectionPrec InfixL section op' expr' `thenM_`
243 returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
245 rnExpr section@(SectionR op expr)
246 = rnLExpr op `thenM` \ (op', fvs_op) ->
247 rnLExpr expr `thenM` \ (expr', fvs_expr) ->
248 checkSectionPrec InfixR section op' expr' `thenM_`
249 returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
251 rnExpr (HsCoreAnn ann expr)
252 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
253 returnM (HsCoreAnn ann expr', fvs_expr)
255 rnExpr (HsSCC lbl expr)
256 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
257 returnM (HsSCC lbl expr', fvs_expr)
259 rnExpr (HsLam matches)
260 = rnMatchGroup LambdaExpr matches `thenM` \ (matches', fvMatch) ->
261 returnM (HsLam matches', fvMatch)
263 rnExpr (HsCase expr matches)
264 = rnLExpr expr `thenM` \ (new_expr, e_fvs) ->
265 rnMatchGroup CaseAlt matches `thenM` \ (new_matches, ms_fvs) ->
266 returnM (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
268 rnExpr (HsLet binds expr)
269 = rnBindGroupsAndThen binds $ \ binds' ->
270 rnLExpr expr `thenM` \ (expr',fvExpr) ->
271 returnM (HsLet binds' expr', fvExpr)
273 rnExpr e@(HsDo do_or_lc stmts body _)
274 = do { ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
276 ; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
278 rnExpr (ExplicitList _ exps)
279 = rnExprs exps `thenM` \ (exps', fvs) ->
280 returnM (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
282 rnExpr (ExplicitPArr _ exps)
283 = rnExprs exps `thenM` \ (exps', fvs) ->
284 returnM (ExplicitPArr placeHolderType exps', fvs)
286 rnExpr e@(ExplicitTuple exps boxity)
287 = checkTupSize tup_size `thenM_`
288 rnExprs exps `thenM` \ (exps', fvs) ->
289 returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
291 tup_size = length exps
292 tycon_name = tupleTyCon_name boxity tup_size
294 rnExpr (RecordCon con_id _ rbinds)
295 = lookupLocatedOccRn con_id `thenM` \ conname ->
296 rnRbinds "construction" rbinds `thenM` \ (rbinds', fvRbinds) ->
297 returnM (RecordCon conname noPostTcExpr rbinds',
298 fvRbinds `addOneFV` unLoc conname)
300 rnExpr (RecordUpd expr rbinds _ _)
301 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
302 rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) ->
303 returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType,
304 fvExpr `plusFV` fvRbinds)
306 rnExpr (ExprWithTySig expr pty)
307 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
308 rnHsTypeFVs doc pty `thenM` \ (pty', fvTy) ->
309 returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
311 doc = text "In an expression type signature"
313 rnExpr (HsIf p b1 b2)
314 = rnLExpr p `thenM` \ (p', fvP) ->
315 rnLExpr b1 `thenM` \ (b1', fvB1) ->
316 rnLExpr b2 `thenM` \ (b2', fvB2) ->
317 returnM (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
320 = rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
321 returnM (HsType t, fvT)
323 doc = text "In a type argument"
325 rnExpr (ArithSeq _ seq)
326 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
327 returnM (ArithSeq noPostTcExpr new_seq, fvs)
329 rnExpr (PArrSeq _ seq)
330 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
331 returnM (PArrSeq noPostTcExpr new_seq, fvs)
334 These three are pattern syntax appearing in expressions.
335 Since all the symbols are reservedops we can simply reject them.
336 We return a (bogus) EWildPat in each case.
339 rnExpr e@EWildPat = addErr (patSynErr e) `thenM_`
340 returnM (EWildPat, emptyFVs)
342 rnExpr e@(EAsPat _ _) = addErr (patSynErr e) `thenM_`
343 returnM (EWildPat, emptyFVs)
345 rnExpr e@(ELazyPat _) = addErr (patSynErr e) `thenM_`
346 returnM (EWildPat, emptyFVs)
349 %************************************************************************
353 %************************************************************************
356 rnExpr (HsProc pat body)
358 rnPatsAndThen ProcExpr [pat] $ \ [pat'] ->
359 rnCmdTop body `thenM` \ (body',fvBody) ->
360 returnM (HsProc pat' body', fvBody)
362 rnExpr (HsArrApp arrow arg _ ho rtl)
363 = select_arrow_scope (rnLExpr arrow) `thenM` \ (arrow',fvArrow) ->
364 rnLExpr arg `thenM` \ (arg',fvArg) ->
365 returnM (HsArrApp arrow' arg' placeHolderType ho rtl,
366 fvArrow `plusFV` fvArg)
368 select_arrow_scope tc = case ho of
369 HsHigherOrderApp -> tc
370 HsFirstOrderApp -> escapeArrowScope tc
373 rnExpr (HsArrForm op (Just _) [arg1, arg2])
374 = escapeArrowScope (rnLExpr op)
375 `thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
376 rnCmdTop arg1 `thenM` \ (arg1',fv_arg1) ->
377 rnCmdTop arg2 `thenM` \ (arg2',fv_arg2) ->
381 lookupFixityRn op_name `thenM` \ fixity ->
382 mkOpFormRn arg1' op' fixity arg2' `thenM` \ final_e ->
385 fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
387 rnExpr (HsArrForm op fixity cmds)
388 = escapeArrowScope (rnLExpr op) `thenM` \ (op',fvOp) ->
389 rnCmdArgs cmds `thenM` \ (cmds',fvCmds) ->
390 returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
392 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
393 -- DictApp, DictLam, TyApp, TyLam
395 ---------------------------
396 -- Deal with fixity (cf mkOpAppRn for the method)
398 mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
399 -> LHsExpr Name -> Fixity -- Operator and fixity
400 -> LHsCmdTop Name -- Right operand (not an infix)
403 ---------------------------
404 -- (e11 `op1` e12) `op2` e2
405 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
408 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
409 returnM (HsArrForm op2 (Just fix2) [a1, a2])
412 = mkOpFormRn a12 op2 fix2 a2 `thenM` \ new_c ->
413 returnM (HsArrForm op1 (Just fix1)
414 [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
415 -- TODO: locs are wrong
417 (nofix_error, associate_right) = compareFixity fix1 fix2
419 ---------------------------
421 mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
422 = returnM (HsArrForm op (Just fix) [arg1, arg2])
427 %************************************************************************
431 %************************************************************************
434 rnCmdArgs [] = returnM ([], emptyFVs)
436 = rnCmdTop arg `thenM` \ (arg',fvArg) ->
437 rnCmdArgs args `thenM` \ (args',fvArgs) ->
438 returnM (arg':args', fvArg `plusFV` fvArgs)
441 rnCmdTop = wrapLocFstM rnCmdTop'
443 rnCmdTop' (HsCmdTop cmd _ _ _)
444 = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
446 cmd_names = [arrAName, composeAName, firstAName] ++
447 nameSetToList (methodNamesCmd (unLoc cmd'))
449 -- Generate the rebindable syntax for the monad
450 lookupSyntaxTable cmd_names `thenM` \ (cmd_names', cmd_fvs) ->
452 returnM (HsCmdTop cmd' [] placeHolderType cmd_names',
453 fvCmd `plusFV` cmd_fvs)
455 ---------------------------------------------------
456 -- convert OpApp's in a command context to HsArrForm's
458 convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
459 convertOpFormsLCmd = fmap convertOpFormsCmd
461 convertOpFormsCmd :: HsCmd id -> HsCmd id
463 convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
464 convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
465 convertOpFormsCmd (OpApp c1 op fixity c2)
467 arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
468 arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
470 HsArrForm op (Just fixity) [arg1, arg2]
472 convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
475 convertOpFormsCmd (HsCase exp matches)
476 = HsCase exp (convertOpFormsMatch matches)
478 convertOpFormsCmd (HsIf exp c1 c2)
479 = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
481 convertOpFormsCmd (HsLet binds cmd)
482 = HsLet binds (convertOpFormsLCmd cmd)
484 convertOpFormsCmd (HsDo ctxt stmts body ty)
485 = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
486 (convertOpFormsLCmd body) ty
488 -- Anything else is unchanged. This includes HsArrForm (already done),
489 -- things with no sub-commands, and illegal commands (which will be
490 -- caught by the type checker)
491 convertOpFormsCmd c = c
493 convertOpFormsStmt (BindStmt pat cmd _ _)
494 = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
495 convertOpFormsStmt (ExprStmt cmd _ _)
496 = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
497 convertOpFormsStmt (RecStmt stmts lvs rvs es binds)
498 = RecStmt (map (fmap convertOpFormsStmt) stmts) lvs rvs es binds
499 convertOpFormsStmt stmt = stmt
501 convertOpFormsMatch (MatchGroup ms ty)
502 = MatchGroup (map (fmap convert) ms) ty
503 where convert (Match pat mty grhss)
504 = Match pat mty (convertOpFormsGRHSs grhss)
506 convertOpFormsGRHSs (GRHSs grhss binds)
507 = GRHSs (map convertOpFormsGRHS grhss) binds
509 convertOpFormsGRHS = fmap convert
511 convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
513 ---------------------------------------------------
514 type CmdNeeds = FreeVars -- Only inhabitants are
515 -- appAName, choiceAName, loopAName
517 -- find what methods the Cmd needs (loop, choice, apply)
518 methodNamesLCmd :: LHsCmd Name -> CmdNeeds
519 methodNamesLCmd = methodNamesCmd . unLoc
521 methodNamesCmd :: HsCmd Name -> CmdNeeds
523 methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
525 methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
527 methodNamesCmd cmd@(HsArrForm {}) = emptyFVs
529 methodNamesCmd (HsPar c) = methodNamesLCmd c
531 methodNamesCmd (HsIf p c1 c2)
532 = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
534 methodNamesCmd (HsLet b c) = methodNamesLCmd c
536 methodNamesCmd (HsDo sc stmts body ty)
537 = methodNamesStmts stmts `plusFV` methodNamesLCmd body
539 methodNamesCmd (HsApp c e) = methodNamesLCmd c
541 methodNamesCmd (HsLam match) = methodNamesMatch match
543 methodNamesCmd (HsCase scrut matches)
544 = methodNamesMatch matches `addOneFV` choiceAName
546 methodNamesCmd other = emptyFVs
547 -- Other forms can't occur in commands, but it's not convenient
548 -- to error here so we just do what's convenient.
549 -- The type checker will complain later
551 ---------------------------------------------------
552 methodNamesMatch (MatchGroup ms ty)
553 = plusFVs (map do_one ms)
555 do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss
557 -------------------------------------------------
559 methodNamesGRHSs (GRHSs grhss binds) = plusFVs (map methodNamesGRHS grhss)
561 -------------------------------------------------
562 methodNamesGRHS (L _ (GRHS stmts rhs)) = methodNamesLCmd rhs
564 ---------------------------------------------------
565 methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
567 ---------------------------------------------------
568 methodNamesLStmt = methodNamesStmt . unLoc
570 methodNamesStmt (ExprStmt cmd _ _) = methodNamesLCmd cmd
571 methodNamesStmt (BindStmt pat cmd _ _) = methodNamesLCmd cmd
572 methodNamesStmt (RecStmt stmts _ _ _ _)
573 = methodNamesStmts stmts `addOneFV` loopAName
574 methodNamesStmt (LetStmt b) = emptyFVs
575 methodNamesStmt (ParStmt ss) = emptyFVs
576 -- ParStmt can't occur in commands, but it's not convenient to error
577 -- here so we just do what's convenient
581 %************************************************************************
585 %************************************************************************
588 rnArithSeq (From expr)
589 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
590 returnM (From expr', fvExpr)
592 rnArithSeq (FromThen expr1 expr2)
593 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
594 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
595 returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
597 rnArithSeq (FromTo expr1 expr2)
598 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
599 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
600 returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
602 rnArithSeq (FromThenTo expr1 expr2 expr3)
603 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
604 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
605 rnLExpr expr3 `thenM` \ (expr3', fvExpr3) ->
606 returnM (FromThenTo expr1' expr2' expr3',
607 plusFVs [fvExpr1, fvExpr2, fvExpr3])
611 %************************************************************************
613 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
615 %************************************************************************
619 = mappM_ field_dup_err dup_fields `thenM_`
620 mapFvRn rn_rbind rbinds `thenM` \ (rbinds', fvRbind) ->
621 returnM (rbinds', fvRbind)
623 (_, dup_fields) = removeDups cmpLocated [ f | (f,_) <- rbinds ]
625 field_dup_err dups = mappM_ (\f -> addLocErr f (dupFieldErr str)) dups
627 rn_rbind (field, expr)
628 = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
629 rnLExpr expr `thenM` \ (expr', fvExpr) ->
630 returnM ((fieldname, expr'), fvExpr `addOneFV` unLoc fieldname)
633 %************************************************************************
635 Template Haskell brackets
637 %************************************************************************
640 rnBracket (VarBr n) = lookupOccRn n `thenM` \ name ->
641 returnM (VarBr name, unitFV name)
642 rnBracket (ExpBr e) = rnLExpr e `thenM` \ (e', fvs) ->
643 returnM (ExpBr e', fvs)
644 rnBracket (PatBr p) = rnLPat p `thenM` \ (p', fvs) ->
645 returnM (PatBr p', fvs)
646 rnBracket (TypBr t) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
647 returnM (TypBr t', fvs)
649 doc = ptext SLIT("In a Template-Haskell quoted type")
650 rnBracket (DecBr group)
651 = do { gbl_env <- getGblEnv
652 ; names <- getLocalDeclBinders gbl_env group
653 ; rdr_env' <- extendRdrEnvRn (tcg_mod gbl_env) emptyGlobalRdrEnv names
655 ; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env `plusOccEnv` rdr_env',
656 tcg_dus = emptyDUs }) $ do
657 -- Notice plusOccEnv, not plusGlobalRdrEnv. In this situation we want
658 -- to *shadow* top-level bindings. E.g.
660 -- bar = [d| foo = 1|]
661 -- So we drop down to plusOccEnv. (Perhaps there should be a fn in RdrName.)
663 -- The emptyDUs is so that we just collect uses for this group alone
665 { (tcg_env, group') <- rnSrcDecls group
666 -- Discard the tcg_env; it contains only extra info about fixity
667 ; return (DecBr group', allUses (tcg_dus tcg_env)) } }
670 %************************************************************************
672 \subsubsection{@Stmt@s: in @do@ expressions}
674 %************************************************************************
677 rnStmts :: HsStmtContext Name -> [LStmt RdrName]
678 -> RnM (thing, FreeVars)
679 -> RnM (([LStmt Name], thing), FreeVars)
681 rnStmts (MDoExpr _) = rnMDoStmts
682 rnStmts ctxt = rnNormalStmts ctxt
684 rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
685 -> RnM (thing, FreeVars)
686 -> RnM (([LStmt Name], thing), FreeVars)
687 -- Used for cases *other* than recursive mdo
688 -- Implements nested scopes
690 rnNormalStmts ctxt [] thing_inside
691 = do { (thing, fvs) <- thing_inside
692 ; return (([],thing), fvs) }
694 rnNormalStmts ctxt (L loc stmt : stmts) thing_inside
695 = do { ((stmt', (stmts', thing)), fvs)
696 <- rnStmt ctxt stmt $
697 rnNormalStmts ctxt stmts thing_inside
698 ; return (((L loc stmt' : stmts'), thing), fvs) }
700 rnStmt :: HsStmtContext Name -> Stmt RdrName
701 -> RnM (thing, FreeVars)
702 -> RnM ((Stmt Name, thing), FreeVars)
704 rnStmt ctxt (ExprStmt expr _ _) thing_inside
705 = do { (expr', fv_expr) <- rnLExpr expr
706 ; (then_op, fvs1) <- lookupSyntaxName thenMName
707 ; (thing, fvs2) <- thing_inside
708 ; return ((ExprStmt expr' then_op placeHolderType, thing),
709 fv_expr `plusFV` fvs1 `plusFV` fvs2) }
711 rnStmt ctxt (BindStmt pat expr _ _) thing_inside
712 = do { (expr', fv_expr) <- rnLExpr expr
713 -- The binders do not scope over the expression
714 ; (bind_op, fvs1) <- lookupSyntaxName bindMName
715 ; (fail_op, fvs2) <- lookupSyntaxName failMName
716 ; rnPatsAndThen (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
717 { (thing, fvs3) <- thing_inside
718 ; return ((BindStmt pat' expr' bind_op fail_op, thing),
719 fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
720 -- fv_expr shouldn't really be filtered by the rnPatsAndThen
721 -- but it does not matter because the names are unique
723 rnStmt ctxt (LetStmt binds) thing_inside
724 = do { checkErr (ok ctxt binds) (badIpBinds binds)
725 ; rnBindGroupsAndThen binds $ \ binds' -> do
726 { (thing, fvs) <- thing_inside
727 ; return ((LetStmt binds', thing), fvs) }}
729 -- We do not allow implicit-parameter bindings in a parallel
730 -- list comprehension. I'm not sure what it might mean.
731 ok (ParStmtCtxt _) binds = not (any is_ip_bind binds)
734 is_ip_bind (HsIPBinds _) = True
737 rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
738 = bindLocatedLocalsRn doc (collectLStmtsBinders rec_stmts) $ \ _ ->
739 rn_rec_stmts rec_stmts `thenM` \ segs ->
740 thing_inside `thenM` \ (thing, fvs) ->
742 segs_w_fwd_refs = addFwdRefs segs
743 (ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
744 later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
745 fwd_vars = nameSetToList (plusFVs fs)
747 rec_stmt = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
749 returnM ((rec_stmt, thing), uses `plusFV` fvs)
751 doc = text "In a recursive do statement"
753 rnStmt ctxt (ParStmt segs) thing_inside
754 = do { opt_GlasgowExts <- doptM Opt_GlasgowExts
755 ; checkM opt_GlasgowExts parStmtErr
756 ; orig_lcl_env <- getLocalRdrEnv
757 ; ((segs',thing), fvs) <- go orig_lcl_env [] segs
758 ; return ((ParStmt segs', thing), fvs) }
760 -- type ParSeg id = [([LStmt id], [id])]
761 -- go :: NameSet -> [ParSeg RdrName]
762 -- -> RnM (([ParSeg Name], thing), FreeVars)
764 go orig_lcl_env bndrs []
765 = do { let { (bndrs', dups) = removeDups cmpByOcc bndrs
766 ; inner_env = extendLocalRdrEnv orig_lcl_env bndrs' }
768 ; (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
769 ; return (([], thing), fvs) }
771 go orig_lcl_env bndrs_so_far ((stmts, _) : segs)
772 = do { ((stmts', (bndrs, segs', thing)), fvs)
773 <- rnNormalStmts par_ctxt stmts $ do
774 { -- Find the Names that are bound by stmts
775 lcl_env <- getLocalRdrEnv
776 ; let { rdr_bndrs = collectLStmtsBinders stmts
777 ; bndrs = map ( fromJust
778 . lookupLocalRdrEnv lcl_env
780 ; new_bndrs = nub bndrs ++ bndrs_so_far
781 -- The nub is because there might be shadowing
783 -- So we'll look up (Unqual x) twice, getting
784 -- the second binding both times, which is the
787 -- Typecheck the thing inside, passing on all
788 -- the Names bound, but separately; revert the envt
789 ; ((segs', thing), fvs) <- setLocalRdrEnv orig_lcl_env $
790 go orig_lcl_env new_bndrs segs
792 -- Figure out which of the bound names are used
793 ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
794 ; return ((used_bndrs, segs', thing), fvs) }
796 ; let seg' = (stmts', bndrs)
797 ; return (((seg':segs'), thing),
798 delListFromNameSet fvs bndrs) }
800 par_ctxt = ParStmtCtxt ctxt
802 cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
803 dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
804 <+> quotes (ppr (head vs)))
808 %************************************************************************
810 \subsubsection{mdo expressions}
812 %************************************************************************
815 type FwdRefs = NameSet
816 type Segment stmts = (Defs,
817 Uses, -- May include defs
818 FwdRefs, -- A subset of uses that are
819 -- (a) used before they are bound in this segment, or
820 -- (b) used here, and bound in subsequent segments
821 stmts) -- Either Stmt or [Stmt]
824 ----------------------------------------------------
825 rnMDoStmts :: [LStmt RdrName]
826 -> RnM (thing, FreeVars)
827 -> RnM (([LStmt Name], thing), FreeVars)
828 rnMDoStmts stmts thing_inside
829 = -- Step1: bring all the binders of the mdo into scope
830 -- Remember that this also removes the binders from the
831 -- finally-returned free-vars
832 bindLocatedLocalsRn doc (collectLStmtsBinders stmts) $ \ _ ->
834 -- Step 2: Rename each individual stmt, making a
835 -- singleton segment. At this stage the FwdRefs field
836 -- isn't finished: it's empty for all except a BindStmt
837 -- for which it's the fwd refs within the bind itself
838 -- (This set may not be empty, because we're in a recursive
840 segs <- rn_rec_stmts stmts
842 ; (thing, fvs_later) <- thing_inside
845 -- Step 3: Fill in the fwd refs.
846 -- The segments are all singletons, but their fwd-ref
847 -- field mentions all the things used by the segment
848 -- that are bound after their use
849 segs_w_fwd_refs = addFwdRefs segs
851 -- Step 4: Group together the segments to make bigger segments
852 -- Invariant: in the result, no segment uses a variable
853 -- bound in a later segment
854 grouped_segs = glomSegments segs_w_fwd_refs
856 -- Step 5: Turn the segments into Stmts
857 -- Use RecStmt when and only when there are fwd refs
858 -- Also gather up the uses from the end towards the
859 -- start, so we can tell the RecStmt which things are
860 -- used 'after' the RecStmt
861 (stmts', fvs) = segsToStmts grouped_segs fvs_later
863 ; return ((stmts', thing), fvs) }
865 doc = text "In a recursive mdo-expression"
868 ----------------------------------------------------
869 rn_rec_stmt :: LStmt RdrName -> RnM [Segment (LStmt Name)]
870 -- Rename a Stmt that is inside a RecStmt (or mdo)
871 -- Assumes all binders are already in scope
872 -- Turns each stmt into a singleton Stmt
874 rn_rec_stmt (L loc (ExprStmt expr _ _))
875 = rnLExpr expr `thenM` \ (expr', fvs) ->
876 lookupSyntaxName thenMName `thenM` \ (then_op, fvs1) ->
877 returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
878 L loc (ExprStmt expr' then_op placeHolderType))]
880 rn_rec_stmt (L loc (BindStmt pat expr _ _))
881 = rnLExpr expr `thenM` \ (expr', fv_expr) ->
882 rnLPat pat `thenM` \ (pat', fv_pat) ->
883 lookupSyntaxName bindMName `thenM` \ (bind_op, fvs1) ->
884 lookupSyntaxName failMName `thenM` \ (fail_op, fvs2) ->
886 bndrs = mkNameSet (collectPatBinders pat')
887 fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
889 returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
890 L loc (BindStmt pat' expr' bind_op fail_op))]
892 rn_rec_stmt (L loc (LetStmt binds))
893 = rnBindGroups binds `thenM` \ (binds', du_binds) ->
894 returnM [(duDefs du_binds, duUses du_binds,
895 emptyNameSet, L loc (LetStmt binds'))]
897 rn_rec_stmt (L loc (RecStmt stmts _ _ _ _)) -- Flatten Rec inside Rec
900 rn_rec_stmt stmt@(L _ (ParStmt _)) -- Syntactically illegal in mdo
901 = pprPanic "rn_rec_stmt" (ppr stmt)
903 ---------------------------------------------
904 rn_rec_stmts :: [LStmt RdrName] -> RnM [Segment (LStmt Name)]
905 rn_rec_stmts stmts = mappM rn_rec_stmt stmts `thenM` \ segs_s ->
906 returnM (concat segs_s)
909 ---------------------------------------------
910 addFwdRefs :: [Segment a] -> [Segment a]
911 -- So far the segments only have forward refs *within* the Stmt
912 -- (which happens for bind: x <- ...x...)
913 -- This function adds the cross-seg fwd ref info
916 = fst (foldr mk_seg ([], emptyNameSet) pairs)
918 mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
919 = (new_seg : segs, all_defs)
921 new_seg = (defs, uses, new_fwds, stmts)
922 all_defs = later_defs `unionNameSets` defs
923 new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
924 -- Add the downstream fwd refs here
926 ----------------------------------------------------
927 -- Glomming the singleton segments of an mdo into
928 -- minimal recursive groups.
930 -- At first I thought this was just strongly connected components, but
931 -- there's an important constraint: the order of the stmts must not change.
934 -- mdo { x <- ...y...
941 -- Here, the first stmt mention 'y', which is bound in the third.
942 -- But that means that the innocent second stmt (p <- z) gets caught
943 -- up in the recursion. And that in turn means that the binding for
944 -- 'z' has to be included... and so on.
946 -- Start at the tail { r <- x }
947 -- Now add the next one { z <- y ; r <- x }
948 -- Now add one more { q <- x ; z <- y ; r <- x }
949 -- Now one more... but this time we have to group a bunch into rec
950 -- { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
951 -- Now one more, which we can add on without a rec
953 -- rec { y <- ...x... ; q <- x ; z <- y } ;
955 -- Finally we add the last one; since it mentions y we have to
956 -- glom it togeher with the first two groups
957 -- { rec { x <- ...y...; p <- z ; y <- ...x... ;
958 -- q <- x ; z <- y } ;
961 glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
964 glomSegments ((defs,uses,fwds,stmt) : segs)
965 -- Actually stmts will always be a singleton
966 = (seg_defs, seg_uses, seg_fwds, seg_stmts) : others
968 segs' = glomSegments segs
969 (extras, others) = grab uses segs'
970 (ds, us, fs, ss) = unzip4 extras
972 seg_defs = plusFVs ds `plusFV` defs
973 seg_uses = plusFVs us `plusFV` uses
974 seg_fwds = plusFVs fs `plusFV` fwds
975 seg_stmts = stmt : concat ss
977 grab :: NameSet -- The client
979 -> ([Segment a], -- Needed by the 'client'
980 [Segment a]) -- Not needed by the client
981 -- The result is simply a split of the input
983 = (reverse yeses, reverse noes)
985 (noes, yeses) = span not_needed (reverse dus)
986 not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
989 ----------------------------------------------------
990 segsToStmts :: [Segment [LStmt Name]]
991 -> FreeVars -- Free vars used 'later'
992 -> ([LStmt Name], FreeVars)
994 segsToStmts [] fvs_later = ([], fvs_later)
995 segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
996 = ASSERT( not (null ss) )
997 (new_stmt : later_stmts, later_uses `plusFV` uses)
999 (later_stmts, later_uses) = segsToStmts segs fvs_later
1000 new_stmt | non_rec = head ss
1001 | otherwise = L (getLoc (head ss)) $
1002 RecStmt ss (nameSetToList used_later) (nameSetToList fwds)
1005 non_rec = isSingleton ss && isEmptyNameSet fwds
1006 used_later = defs `intersectNameSet` later_uses
1007 -- The ones needed after the RecStmt
1010 %************************************************************************
1012 \subsubsection{Precedence Parsing}
1014 %************************************************************************
1016 @mkOpAppRn@ deals with operator fixities. The argument expressions
1017 are assumed to be already correctly arranged. It needs the fixities
1018 recorded in the OpApp nodes, because fixity info applies to the things
1019 the programmer actually wrote, so you can't find it out from the Name.
1021 Furthermore, the second argument is guaranteed not to be another
1022 operator application. Why? Because the parser parses all
1023 operator appications left-associatively, EXCEPT negation, which
1024 we need to handle specially.
1027 mkOpAppRn :: LHsExpr Name -- Left operand; already rearranged
1028 -> LHsExpr Name -> Fixity -- Operator and fixity
1029 -> LHsExpr Name -- Right operand (not an OpApp, but might
1031 -> RnM (HsExpr Name)
1033 ---------------------------
1034 -- (e11 `op1` e12) `op2` e2
1035 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
1037 = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenM_`
1038 returnM (OpApp e1 op2 fix2 e2)
1041 = mkOpAppRn e12 op2 fix2 e2 `thenM` \ new_e ->
1042 returnM (OpApp e11 op1 fix1 (L loc' new_e))
1044 loc'= combineLocs e12 e2
1045 (nofix_error, associate_right) = compareFixity fix1 fix2
1047 ---------------------------
1048 -- (- neg_arg) `op` e2
1049 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
1051 = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2)) `thenM_`
1052 returnM (OpApp e1 op2 fix2 e2)
1055 = mkOpAppRn neg_arg op2 fix2 e2 `thenM` \ new_e ->
1056 returnM (NegApp (L loc' new_e) neg_name)
1058 loc' = combineLocs neg_arg e2
1059 (nofix_error, associate_right) = compareFixity negateFixity fix2
1061 ---------------------------
1062 -- e1 `op` - neg_arg
1063 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _)) -- NegApp can occur on the right
1064 | not associate_right -- We *want* right association
1065 = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity)) `thenM_`
1066 returnM (OpApp e1 op1 fix1 e2)
1068 (_, associate_right) = compareFixity fix1 negateFixity
1070 ---------------------------
1072 mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
1073 = ASSERT2( right_op_ok fix (unLoc e2),
1074 ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
1076 returnM (OpApp e1 op fix e2)
1078 -- Parser left-associates everything, but
1079 -- derived instances may have correctly-associated things to
1080 -- in the right operarand. So we just check that the right operand is OK
1081 right_op_ok fix1 (OpApp _ _ fix2 _)
1082 = not error_please && associate_right
1084 (error_please, associate_right) = compareFixity fix1 fix2
1085 right_op_ok fix1 other
1088 -- Parser initially makes negation bind more tightly than any other operator
1089 -- And "deriving" code should respect this (use HsPar if not)
1090 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
1091 mkNegAppRn neg_arg neg_name
1092 = ASSERT( not_op_app (unLoc neg_arg) )
1093 returnM (NegApp neg_arg neg_name)
1095 not_op_app (OpApp _ _ _ _) = False
1096 not_op_app other = True
1100 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
1101 -- True indicates an infix lhs
1102 -- See comments with rnExpr (OpApp ...) about "deriving"
1104 checkPrecMatch False fn match
1106 checkPrecMatch True op (MatchGroup ms _)
1109 check (L _ (Match (p1:p2:_) _ _))
1110 = checkPrec op (unLoc p1) False `thenM_`
1111 checkPrec op (unLoc p2) True
1113 check _ = panic "checkPrecMatch"
1115 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
1116 = lookupFixityRn op `thenM` \ op_fix@(Fixity op_prec op_dir) ->
1117 lookupFixityRn (unLoc op1) `thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
1119 inf_ok = op1_prec > op_prec ||
1120 (op1_prec == op_prec &&
1121 (op1_dir == InfixR && op_dir == InfixR && right ||
1122 op1_dir == InfixL && op_dir == InfixL && not right))
1124 info = (ppr_op op, op_fix)
1125 info1 = (ppr_op op1, op1_fix)
1126 (infol, infor) = if right then (info, info1) else (info1, info)
1128 checkErr inf_ok (precParseErr infol infor)
1130 checkPrec op pat right
1133 -- Check precedence of (arg op) or (op arg) respectively
1134 -- If arg is itself an operator application, then either
1135 -- (a) its precedence must be higher than that of op
1136 -- (b) its precedency & associativity must be the same as that of op
1137 checkSectionPrec :: FixityDirection -> HsExpr RdrName
1138 -> LHsExpr Name -> LHsExpr Name -> RnM ()
1139 checkSectionPrec direction section op arg
1141 OpApp _ op fix _ -> go_for_it (ppr_op op) fix
1142 NegApp _ _ -> go_for_it pp_prefix_minus negateFixity
1145 L _ (HsVar op_name) = op
1146 go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
1147 = lookupFixityRn op_name `thenM` \ op_fix@(Fixity op_prec _) ->
1148 checkErr (op_prec < arg_prec
1149 || op_prec == arg_prec && direction == assoc)
1150 (sectionPrecErr (ppr_op op_name, op_fix)
1151 (pp_arg_op, arg_fix) section)
1155 %************************************************************************
1157 \subsubsection{Assertion utils}
1159 %************************************************************************
1162 mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars)
1163 -- Return an expression for (assertError "Foo.hs:27")
1165 = getSrcSpanM `thenM` \ sloc ->
1167 expr = HsApp (L sloc (HsVar assertErrorName)) (L sloc (HsLit msg))
1168 msg = HsStringPrim (mkFastString (stringToUtf8 (showSDoc (ppr sloc))))
1170 returnM (expr, emptyFVs)
1173 %************************************************************************
1175 \subsubsection{Errors}
1177 %************************************************************************
1180 ppr_op op = quotes (ppr op) -- Here, op can be a Name or a (Var n), where n is a Name
1181 pp_prefix_minus = ptext SLIT("prefix `-'")
1183 nonStdGuardErr guard
1185 SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
1189 = sep [ptext SLIT("Pattern syntax in expression context:"),
1193 checkTH e what = returnM () -- OK
1195 checkTH e what -- Raise an error in a stage-1 compiler
1196 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1197 ptext SLIT("illegal in a stage-1 compiler"),
1201 parStmtErr = addErr (ptext SLIT("Illegal parallel list comprehension: use -fglasgow-exts"))
1204 = hang (ptext SLIT("Implicit-parameter bindings illegal in a parallel list comprehension:")) 4