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 rnLExpr, rnExpr, rnStmts
17 #include "HsVersions.h"
20 import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
23 import RnSource ( rnSrcDecls, findSplice )
24 import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
25 rnMatchGroup, makeMiniFixityEnv)
28 import TcEnv ( thRnBrack )
30 import RnTypes ( rnHsTypeFVs, rnSplice, checkTH,
31 mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
34 import BasicTypes ( FixityDirection(..) )
40 import LoadIface ( loadInterfaceForName )
43 import Util ( isSingleton )
44 import ListSetOps ( removeDups )
54 thenM :: Monad a => a b -> (b -> a c) -> a c
57 thenM_ :: Monad a => a b -> a c -> a c
61 %************************************************************************
63 \subsubsection{Expressions}
65 %************************************************************************
68 rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
69 rnExprs ls = rnExprs' ls emptyUniqSet
71 rnExprs' [] acc = return ([], acc)
72 rnExprs' (expr:exprs) acc
73 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
75 -- Now we do a "seq" on the free vars because typically it's small
76 -- or empty, especially in very long lists of constants
78 acc' = acc `plusFV` fvExpr
80 acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) ->
81 return (expr':exprs', fvExprs)
84 Variables. We look up the variable and return the resulting name.
87 rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
88 rnLExpr = wrapLocFstM rnExpr
90 rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
92 finishHsVar :: Name -> RnM (HsExpr Name, FreeVars)
93 -- Separated from rnExpr because it's also used
94 -- when renaming infix expressions
95 -- See Note [Adding the implicit parameter to 'assert']
97 = do { ignore_asserts <- doptM Opt_IgnoreAsserts
98 ; if ignore_asserts || not (name `hasKey` assertIdKey)
99 then return (HsVar name, unitFV name)
100 else do { e <- mkAssertErrorExpr
101 ; return (e, unitFV name) } }
104 = do name <- lookupOccRn v
108 = newIPNameRn v `thenM` \ name ->
109 return (HsIPVar name, emptyFVs)
111 rnExpr (HsLit lit@(HsString s))
113 opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
114 ; if opt_OverloadedStrings then
115 rnExpr (HsOverLit (mkHsIsString s placeHolderType))
116 else -- Same as below
118 return (HsLit lit, emptyFVs)
123 return (HsLit lit, emptyFVs)
125 rnExpr (HsOverLit lit)
126 = rnOverLit lit `thenM` \ (lit', fvs) ->
127 return (HsOverLit lit', fvs)
129 rnExpr (HsApp fun arg)
130 = rnLExpr fun `thenM` \ (fun',fvFun) ->
131 rnLExpr arg `thenM` \ (arg',fvArg) ->
132 return (HsApp fun' arg', fvFun `plusFV` fvArg)
134 rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2)
135 = do { (e1', fv_e1) <- rnLExpr e1
136 ; (e2', fv_e2) <- rnLExpr e2
137 ; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr)
138 ; (op', fv_op) <- finishHsVar op_name
139 -- NB: op' is usually just a variable, but might be
140 -- an applicatoin (assert "Foo.hs:47")
142 -- When renaming code synthesised from "deriving" declarations
143 -- we used to avoid fixity stuff, but we can't easily tell any
144 -- more, so I've removed the test. Adding HsPars in TcGenDeriv
145 -- should prevent bad things happening.
146 ; fixity <- lookupFixityRn op_name
147 ; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2'
148 ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
151 = rnLExpr e `thenM` \ (e', fv_e) ->
152 lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
153 mkNegAppRn e' neg_name `thenM` \ final_e ->
154 return (final_e, fv_e `plusFV` fv_neg)
156 ------------------------------------------
157 -- Template Haskell extensions
158 -- Don't ifdef-GHCI them because we want to fail gracefully
159 -- (not with an rnExpr crash) in a stage-1 compiler.
160 rnExpr e@(HsBracket br_body)
161 = checkTH e "bracket" `thenM_`
162 rnBracket br_body `thenM` \ (body', fvs_e) ->
163 return (HsBracket body', fvs_e)
165 rnExpr (HsSpliceE splice)
166 = rnSplice splice `thenM` \ (splice', fvs) ->
167 return (HsSpliceE splice', fvs)
170 rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
172 rnExpr (HsQuasiQuoteE qq)
173 = runQuasiQuoteExpr qq `thenM` \ (L _ expr') ->
177 ---------------------------------------------
179 -- See Note [Parsing sections] in Parser.y.pp
180 rnExpr (HsPar (L loc (section@(SectionL {}))))
181 = do { (section', fvs) <- rnSection section
182 ; return (HsPar (L loc section'), fvs) }
184 rnExpr (HsPar (L loc (section@(SectionR {}))))
185 = do { (section', fvs) <- rnSection section
186 ; return (HsPar (L loc section'), fvs) }
189 = do { (e', fvs_e) <- rnLExpr e
190 ; return (HsPar e', fvs_e) }
192 rnExpr expr@(SectionL {})
193 = do { addErr (sectionErr expr); rnSection expr }
194 rnExpr expr@(SectionR {})
195 = do { addErr (sectionErr expr); rnSection expr }
197 ---------------------------------------------
198 rnExpr (HsCoreAnn ann expr)
199 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
200 return (HsCoreAnn ann expr', fvs_expr)
202 rnExpr (HsSCC lbl expr)
203 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
204 return (HsSCC lbl expr', fvs_expr)
205 rnExpr (HsTickPragma info expr)
206 = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
207 return (HsTickPragma info expr', fvs_expr)
209 rnExpr (HsLam matches)
210 = rnMatchGroup LambdaExpr matches `thenM` \ (matches', fvMatch) ->
211 return (HsLam matches', fvMatch)
213 rnExpr (HsCase expr matches)
214 = rnLExpr expr `thenM` \ (new_expr, e_fvs) ->
215 rnMatchGroup CaseAlt matches `thenM` \ (new_matches, ms_fvs) ->
216 return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
218 rnExpr (HsLet binds expr)
219 = rnLocalBindsAndThen binds $ \ binds' ->
220 rnLExpr expr `thenM` \ (expr',fvExpr) ->
221 return (HsLet binds' expr', fvExpr)
223 rnExpr (HsDo do_or_lc stmts body _)
224 = do { ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
226 ; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
228 rnExpr (ExplicitList _ exps)
229 = rnExprs exps `thenM` \ (exps', fvs) ->
230 return (ExplicitList placeHolderType exps', fvs)
232 rnExpr (ExplicitPArr _ exps)
233 = rnExprs exps `thenM` \ (exps', fvs) ->
234 return (ExplicitPArr placeHolderType exps', fvs)
236 rnExpr (ExplicitTuple tup_args boxity)
237 = do { checkTupleSection tup_args
238 ; checkTupSize (length tup_args)
239 ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args
240 ; return (ExplicitTuple tup_args' boxity, plusFVs fvs) }
242 rnTupArg (Present e) = do { (e',fvs) <- rnLExpr e; return (Present e', fvs) }
243 rnTupArg (Missing _) = return (Missing placeHolderType, emptyFVs)
245 rnExpr (RecordCon con_id _ rbinds)
246 = do { conname <- lookupLocatedOccRn con_id
247 ; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds
248 ; return (RecordCon conname noPostTcExpr rbinds',
249 fvRbinds `addOneFV` unLoc conname) }
251 rnExpr (RecordUpd expr rbinds _ _ _)
252 = do { (expr', fvExpr) <- rnLExpr expr
253 ; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds
254 ; return (RecordUpd expr' rbinds' [] [] [],
255 fvExpr `plusFV` fvRbinds) }
257 rnExpr (ExprWithTySig expr pty)
258 = do { (pty', fvTy) <- rnHsTypeFVs doc pty
259 ; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
261 ; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
263 doc = text "In an expression type signature"
265 rnExpr (HsIf _ p b1 b2)
266 = do { (p', fvP) <- rnLExpr p
267 ; (b1', fvB1) <- rnLExpr b1
268 ; (b2', fvB2) <- rnLExpr b2
269 ; rebind <- xoptM Opt_RebindableSyntax
271 then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2])
272 else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse")))
273 ; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }}
276 = rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
277 return (HsType t, fvT)
279 doc = text "In a type argument"
281 rnExpr (ArithSeq _ seq)
282 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
283 return (ArithSeq noPostTcExpr new_seq, fvs)
285 rnExpr (PArrSeq _ seq)
286 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
287 return (PArrSeq noPostTcExpr new_seq, fvs)
290 These three are pattern syntax appearing in expressions.
291 Since all the symbols are reservedops we can simply reject them.
292 We return a (bogus) EWildPat in each case.
295 rnExpr e@EWildPat = patSynErr e
296 rnExpr e@(EAsPat {}) = patSynErr e
297 rnExpr e@(EViewPat {}) = patSynErr e
298 rnExpr e@(ELazyPat {}) = patSynErr e
301 %************************************************************************
305 %************************************************************************
308 rnExpr (HsProc pat body)
310 rnPat ProcExpr pat $ \ pat' ->
311 rnCmdTop body `thenM` \ (body',fvBody) ->
312 return (HsProc pat' body', fvBody)
314 rnExpr (HsArrApp arrow arg _ ho rtl)
315 = select_arrow_scope (rnLExpr arrow) `thenM` \ (arrow',fvArrow) ->
316 rnLExpr arg `thenM` \ (arg',fvArg) ->
317 return (HsArrApp arrow' arg' placeHolderType ho rtl,
318 fvArrow `plusFV` fvArg)
320 select_arrow_scope tc = case ho of
321 HsHigherOrderApp -> tc
322 HsFirstOrderApp -> escapeArrowScope tc
325 rnExpr (HsArrForm op (Just _) [arg1, arg2])
326 = escapeArrowScope (rnLExpr op)
327 `thenM` \ (op',fv_op) ->
328 let L _ (HsVar op_name) = op' in
329 rnCmdTop arg1 `thenM` \ (arg1',fv_arg1) ->
330 rnCmdTop arg2 `thenM` \ (arg2',fv_arg2) ->
334 lookupFixityRn op_name `thenM` \ fixity ->
335 mkOpFormRn arg1' op' fixity arg2' `thenM` \ final_e ->
338 fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
340 rnExpr (HsArrForm op fixity cmds)
341 = escapeArrowScope (rnLExpr op) `thenM` \ (op',fvOp) ->
342 rnCmdArgs cmds `thenM` \ (cmds',fvCmds) ->
343 return (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
345 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
348 ----------------------
349 -- See Note [Parsing sections] in Parser.y.pp
350 rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
351 rnSection section@(SectionR op expr)
352 = do { (op', fvs_op) <- rnLExpr op
353 ; (expr', fvs_expr) <- rnLExpr expr
354 ; checkSectionPrec InfixR section op' expr'
355 ; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
357 rnSection section@(SectionL expr op)
358 = do { (expr', fvs_expr) <- rnLExpr expr
359 ; (op', fvs_op) <- rnLExpr op
360 ; checkSectionPrec InfixL section op' expr'
361 ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
363 rnSection other = pprPanic "rnSection" (ppr other)
366 %************************************************************************
370 %************************************************************************
373 rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
374 -> RnM (HsRecordBinds Name, FreeVars)
375 rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
376 = do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
377 ; (flds', fvss) <- mapAndUnzipM rn_field flds
378 ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd },
379 fvs `plusFV` plusFVs fvss) }
381 rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
382 ; return (fld { hsRecFieldArg = arg' }, fvs) }
386 %************************************************************************
390 %************************************************************************
393 rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
394 rnCmdArgs [] = return ([], emptyFVs)
396 = rnCmdTop arg `thenM` \ (arg',fvArg) ->
397 rnCmdArgs args `thenM` \ (args',fvArgs) ->
398 return (arg':args', fvArg `plusFV` fvArgs)
400 rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
401 rnCmdTop = wrapLocFstM rnCmdTop'
403 rnCmdTop' (HsCmdTop cmd _ _ _)
404 = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
406 cmd_names = [arrAName, composeAName, firstAName] ++
407 nameSetToList (methodNamesCmd (unLoc cmd'))
409 -- Generate the rebindable syntax for the monad
410 lookupSyntaxTable cmd_names `thenM` \ (cmd_names', cmd_fvs) ->
412 return (HsCmdTop cmd' [] placeHolderType cmd_names',
413 fvCmd `plusFV` cmd_fvs)
415 ---------------------------------------------------
416 -- convert OpApp's in a command context to HsArrForm's
418 convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
419 convertOpFormsLCmd = fmap convertOpFormsCmd
421 convertOpFormsCmd :: HsCmd id -> HsCmd id
423 convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
424 convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
425 convertOpFormsCmd (OpApp c1 op fixity c2)
427 arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
428 arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
430 HsArrForm op (Just fixity) [arg1, arg2]
432 convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
434 convertOpFormsCmd (HsCase exp matches)
435 = HsCase exp (convertOpFormsMatch matches)
437 convertOpFormsCmd (HsIf f exp c1 c2)
438 = HsIf f exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
440 convertOpFormsCmd (HsLet binds cmd)
441 = HsLet binds (convertOpFormsLCmd cmd)
443 convertOpFormsCmd (HsDo ctxt stmts body ty)
444 = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
445 (convertOpFormsLCmd body) ty
447 -- Anything else is unchanged. This includes HsArrForm (already done),
448 -- things with no sub-commands, and illegal commands (which will be
449 -- caught by the type checker)
450 convertOpFormsCmd c = c
452 convertOpFormsStmt :: StmtLR id id -> StmtLR id id
453 convertOpFormsStmt (BindStmt pat cmd _ _)
454 = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
455 convertOpFormsStmt (ExprStmt cmd _ _)
456 = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
457 convertOpFormsStmt stmt@(RecStmt { recS_stmts = stmts })
458 = stmt { recS_stmts = map (fmap convertOpFormsStmt) stmts }
459 convertOpFormsStmt stmt = stmt
461 convertOpFormsMatch :: MatchGroup id -> MatchGroup id
462 convertOpFormsMatch (MatchGroup ms ty)
463 = MatchGroup (map (fmap convert) ms) ty
464 where convert (Match pat mty grhss)
465 = Match pat mty (convertOpFormsGRHSs grhss)
467 convertOpFormsGRHSs :: GRHSs id -> GRHSs id
468 convertOpFormsGRHSs (GRHSs grhss binds)
469 = GRHSs (map convertOpFormsGRHS grhss) binds
471 convertOpFormsGRHS :: Located (GRHS id) -> Located (GRHS id)
472 convertOpFormsGRHS = fmap convert
474 convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
476 ---------------------------------------------------
477 type CmdNeeds = FreeVars -- Only inhabitants are
478 -- appAName, choiceAName, loopAName
480 -- find what methods the Cmd needs (loop, choice, apply)
481 methodNamesLCmd :: LHsCmd Name -> CmdNeeds
482 methodNamesLCmd = methodNamesCmd . unLoc
484 methodNamesCmd :: HsCmd Name -> CmdNeeds
486 methodNamesCmd (HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
488 methodNamesCmd (HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
490 methodNamesCmd (HsArrForm {}) = emptyFVs
492 methodNamesCmd (HsPar c) = methodNamesLCmd c
494 methodNamesCmd (HsIf _ _ c1 c2)
495 = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
497 methodNamesCmd (HsLet _ c) = methodNamesLCmd c
499 methodNamesCmd (HsDo _ stmts body _)
500 = methodNamesStmts stmts `plusFV` methodNamesLCmd body
502 methodNamesCmd (HsApp c _) = methodNamesLCmd c
504 methodNamesCmd (HsLam match) = methodNamesMatch match
506 methodNamesCmd (HsCase _ matches)
507 = methodNamesMatch matches `addOneFV` choiceAName
509 methodNamesCmd _ = emptyFVs
510 -- Other forms can't occur in commands, but it's not convenient
511 -- to error here so we just do what's convenient.
512 -- The type checker will complain later
514 ---------------------------------------------------
515 methodNamesMatch :: MatchGroup Name -> FreeVars
516 methodNamesMatch (MatchGroup ms _)
517 = plusFVs (map do_one ms)
519 do_one (L _ (Match _ _ grhss)) = methodNamesGRHSs grhss
521 -------------------------------------------------
523 methodNamesGRHSs :: GRHSs Name -> FreeVars
524 methodNamesGRHSs (GRHSs grhss _) = plusFVs (map methodNamesGRHS grhss)
526 -------------------------------------------------
528 methodNamesGRHS :: Located (GRHS Name) -> CmdNeeds
529 methodNamesGRHS (L _ (GRHS _ rhs)) = methodNamesLCmd rhs
531 ---------------------------------------------------
532 methodNamesStmts :: [Located (StmtLR Name Name)] -> FreeVars
533 methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
535 ---------------------------------------------------
536 methodNamesLStmt :: Located (StmtLR Name Name) -> FreeVars
537 methodNamesLStmt = methodNamesStmt . unLoc
539 methodNamesStmt :: StmtLR Name Name -> FreeVars
540 methodNamesStmt (ExprStmt cmd _ _) = methodNamesLCmd cmd
541 methodNamesStmt (BindStmt _ cmd _ _) = methodNamesLCmd cmd
542 methodNamesStmt (RecStmt { recS_stmts = stmts }) = methodNamesStmts stmts `addOneFV` loopAName
543 methodNamesStmt (LetStmt _) = emptyFVs
544 methodNamesStmt (ParStmt _) = emptyFVs
545 methodNamesStmt (TransformStmt {}) = emptyFVs
546 methodNamesStmt (GroupStmt {}) = emptyFVs
547 -- ParStmt, TransformStmt and GroupStmt can't occur in commands, but it's not convenient to error
548 -- here so we just do what's convenient
552 %************************************************************************
556 %************************************************************************
559 rnArithSeq :: ArithSeqInfo RdrName -> RnM (ArithSeqInfo Name, FreeVars)
560 rnArithSeq (From expr)
561 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
562 return (From expr', fvExpr)
564 rnArithSeq (FromThen expr1 expr2)
565 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
566 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
567 return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
569 rnArithSeq (FromTo expr1 expr2)
570 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
571 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
572 return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
574 rnArithSeq (FromThenTo expr1 expr2 expr3)
575 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
576 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
577 rnLExpr expr3 `thenM` \ (expr3', fvExpr3) ->
578 return (FromThenTo expr1' expr2' expr3',
579 plusFVs [fvExpr1, fvExpr2, fvExpr3])
582 %************************************************************************
584 Template Haskell brackets
586 %************************************************************************
589 rnBracket :: HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
590 rnBracket (VarBr n) = do { name <- lookupOccRn n
591 ; this_mod <- getModule
592 ; unless (nameIsLocalOrFrom this_mod name) $ -- Reason: deprecation checking asumes the
593 do { _ <- loadInterfaceForName msg name -- home interface is loaded, and this is the
594 ; return () } -- only way that is going to happen
595 ; return (VarBr name, unitFV name) }
597 msg = ptext (sLit "Need interface for Template Haskell quoted Name")
599 rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
600 ; return (ExpBr e', fvs) }
602 rnBracket (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
604 rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
605 ; return (TypBr t', fvs) }
607 doc = ptext (sLit "In a Template-Haskell quoted type")
609 rnBracket (DecBrL decls)
610 = do { (group, mb_splice) <- findSplice decls
613 Just (SpliceDecl (L loc _) _, _)
615 addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets"))
616 -- Why not? See Section 7.3 of the TH paper.
618 ; gbl_env <- getGblEnv
619 ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
620 -- The emptyDUs is so that we just collect uses for this
621 -- group alone in the call to rnSrcDecls below
622 ; (tcg_env, group') <- setGblEnv new_gbl_env $
626 -- Discard the tcg_env; it contains only extra info about fixity
627 ; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env))))
628 ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
630 rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG"
633 %************************************************************************
635 \subsubsection{@Stmt@s: in @do@ expressions}
637 %************************************************************************
640 rnStmts :: HsStmtContext Name -> [LStmt RdrName]
641 -> RnM (thing, FreeVars)
642 -> RnM (([LStmt Name], thing), FreeVars)
643 -- Variables bound by the Stmts, and mentioned in thing_inside,
644 -- do not appear in the result FreeVars
646 rnStmts (MDoExpr _) stmts thing_inside = rnMDoStmts stmts thing_inside
647 rnStmts ctxt stmts thing_inside = rnNormalStmts ctxt stmts (\ _ -> thing_inside)
649 rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
650 -> ([Name] -> RnM (thing, FreeVars))
651 -> RnM (([LStmt Name], thing), FreeVars)
652 -- Variables bound by the Stmts, and mentioned in thing_inside,
653 -- do not appear in the result FreeVars
655 -- Renaming a single RecStmt can give a sequence of smaller Stmts
657 rnNormalStmts _ [] thing_inside
658 = do { (res, fvs) <- thing_inside []
659 ; return (([], res), fvs) }
661 rnNormalStmts ctxt (stmt@(L loc _) : stmts) thing_inside
662 = do { ((stmts1, (stmts2, thing)), fvs)
664 rnStmt ctxt stmt $ \ bndrs1 ->
665 rnNormalStmts ctxt stmts $ \ bndrs2 ->
666 thing_inside (bndrs1 ++ bndrs2)
667 ; return (((stmts1 ++ stmts2), thing), fvs) }
670 rnStmt :: HsStmtContext Name -> LStmt RdrName
671 -> ([Name] -> RnM (thing, FreeVars))
672 -> RnM (([LStmt Name], thing), FreeVars)
673 -- Variables bound by the Stmt, and mentioned in thing_inside,
674 -- do not appear in the result FreeVars
676 rnStmt _ (L loc (ExprStmt expr _ _)) thing_inside
677 = do { (expr', fv_expr) <- rnLExpr expr
678 ; (then_op, fvs1) <- lookupSyntaxName thenMName
679 ; (thing, fvs2) <- thing_inside []
680 ; return (([L loc (ExprStmt expr' then_op placeHolderType)], thing),
681 fv_expr `plusFV` fvs1 `plusFV` fvs2) }
683 rnStmt ctxt (L loc (BindStmt pat expr _ _)) thing_inside
684 = do { (expr', fv_expr) <- rnLExpr expr
685 -- The binders do not scope over the expression
686 ; (bind_op, fvs1) <- lookupSyntaxName bindMName
687 ; (fail_op, fvs2) <- lookupSyntaxName failMName
688 ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do
689 { (thing, fvs3) <- thing_inside (collectPatBinders pat')
690 ; return (([L loc (BindStmt pat' expr' bind_op fail_op)], thing),
691 fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
692 -- fv_expr shouldn't really be filtered by the rnPatsAndThen
693 -- but it does not matter because the names are unique
695 rnStmt ctxt (L loc (LetStmt binds)) thing_inside
696 = do { checkLetStmt ctxt binds
697 ; rnLocalBindsAndThen binds $ \binds' -> do
698 { (thing, fvs) <- thing_inside (collectLocalBinders binds')
699 ; return (([L loc (LetStmt binds')], thing), fvs) } }
701 rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
702 = do { checkRecStmt ctxt
704 -- Step1: Bring all the binders of the mdo into scope
705 -- (Remember that this also removes the binders from the
706 -- finally-returned free-vars.)
707 -- And rename each individual stmt, making a
708 -- singleton segment. At this stage the FwdRefs field
709 -- isn't finished: it's empty for all except a BindStmt
710 -- for which it's the fwd refs within the bind itself
711 -- (This set may not be empty, because we're in a recursive
713 ; rn_rec_stmts_and_then rec_stmts $ \ segs -> do
715 { let bndrs = nameSetToList $ foldr (unionNameSets . (\(ds,_,_,_) -> ds))
717 ; (thing, fvs_later) <- thing_inside bndrs
718 ; (return_op, fvs1) <- lookupSyntaxName returnMName
719 ; (mfix_op, fvs2) <- lookupSyntaxName mfixName
720 ; (bind_op, fvs3) <- lookupSyntaxName bindMName
722 -- Step 2: Fill in the fwd refs.
723 -- The segments are all singletons, but their fwd-ref
724 -- field mentions all the things used by the segment
725 -- that are bound after their use
726 segs_w_fwd_refs = addFwdRefs segs
728 -- Step 3: Group together the segments to make bigger segments
729 -- Invariant: in the result, no segment uses a variable
730 -- bound in a later segment
731 grouped_segs = glomSegments segs_w_fwd_refs
733 -- Step 4: Turn the segments into Stmts
734 -- Use RecStmt when and only when there are fwd refs
735 -- Also gather up the uses from the end towards the
736 -- start, so we can tell the RecStmt which things are
737 -- used 'after' the RecStmt
738 empty_rec_stmt = emptyRecStmt { recS_ret_fn = return_op
739 , recS_mfix_fn = mfix_op
740 , recS_bind_fn = bind_op }
741 (rec_stmts', fvs) = segsToStmts empty_rec_stmt grouped_segs fvs_later
743 ; return ((rec_stmts', thing), fvs `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } }
745 rnStmt ctxt (L loc (ParStmt segs)) thing_inside
746 = do { checkParStmt ctxt
747 ; ((segs', thing), fvs) <- rnParallelStmts (ParStmtCtxt ctxt) segs thing_inside
748 ; return (([L loc (ParStmt segs')], thing), fvs) }
750 rnStmt ctxt (L loc (TransformStmt stmts _ using by)) thing_inside
751 = do { checkTransformStmt ctxt
753 ; (using', fvs1) <- rnLExpr using
755 ; ((stmts', (by', used_bndrs, thing)), fvs2)
756 <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
757 do { (by', fvs_by) <- case by of
758 Nothing -> return (Nothing, emptyFVs)
759 Just e -> do { (e', fvs) <- rnLExpr e; return (Just e', fvs) }
760 ; (thing, fvs_thing) <- thing_inside bndrs
761 ; let fvs = fvs_by `plusFV` fvs_thing
762 used_bndrs = filter (`elemNameSet` fvs_thing) bndrs
763 ; return ((by', used_bndrs, thing), fvs) }
765 ; return (([L loc (TransformStmt stmts' used_bndrs using' by')], thing),
766 fvs1 `plusFV` fvs2) }
768 rnStmt ctxt (L loc (GroupStmt stmts _ by using)) thing_inside
769 = do { checkTransformStmt ctxt
771 -- Rename the 'using' expression in the context before the transform is begun
772 ; (using', fvs1) <- case using of
773 Left e -> do { (e', fvs) <- rnLExpr e; return (Left e', fvs) }
774 Right _ -> do { (e', fvs) <- lookupSyntaxName groupWithName
775 ; return (Right e', fvs) }
777 -- Rename the stmts and the 'by' expression
778 -- Keep track of the variables mentioned in the 'by' expression
779 ; ((stmts', (by', used_bndrs, thing)), fvs2)
780 <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
781 do { (by', fvs_by) <- mapMaybeFvRn rnLExpr by
782 ; (thing, fvs_thing) <- thing_inside bndrs
783 ; let fvs = fvs_by `plusFV` fvs_thing
784 used_bndrs = filter (`elemNameSet` fvs) bndrs
785 ; return ((by', used_bndrs, thing), fvs) }
787 ; let all_fvs = fvs1 `plusFV` fvs2
788 bndr_map = used_bndrs `zip` used_bndrs
789 -- See Note [GroupStmt binder map] in HsExpr
791 ; traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr bndr_map)
792 ; return (([L loc (GroupStmt stmts' bndr_map by' using')], thing), all_fvs) }
795 type ParSeg id = ([LStmt id], [id]) -- The Names are bound by the Stmts
797 rnParallelStmts :: forall thing. HsStmtContext Name
799 -> ([Name] -> RnM (thing, FreeVars))
800 -> RnM (([ParSeg Name], thing), FreeVars)
801 -- Note [Renaming parallel Stmts]
802 rnParallelStmts ctxt segs thing_inside
803 = do { orig_lcl_env <- getLocalRdrEnv
804 ; rn_segs orig_lcl_env [] segs }
806 rn_segs :: LocalRdrEnv
807 -> [Name] -> [ParSeg RdrName]
808 -> RnM (([ParSeg Name], thing), FreeVars)
809 rn_segs _ bndrs_so_far []
810 = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far
812 ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')
813 ; return (([], thing), fvs) }
815 rn_segs env bndrs_so_far ((stmts,_) : segs)
816 = do { ((stmts', (used_bndrs, segs', thing)), fvs)
817 <- rnNormalStmts ctxt stmts $ \ bndrs ->
818 setLocalRdrEnv env $ do
819 { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs
820 ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
821 ; return ((used_bndrs, segs', thing), fvs) }
823 ; let seg' = (stmts', used_bndrs)
824 ; return ((seg':segs', thing), fvs) }
826 cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
827 dupErr vs = addErr (ptext (sLit "Duplicate binding in parallel list comprehension for:")
828 <+> quotes (ppr (head vs)))
831 Note [Renaming parallel Stmts]
832 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
833 Renaming parallel statements is painful. Given, say
834 [ a+c | a <- as, bs <- bss
837 (a) In order to report "Defined by not used" about 'bs', we must rename
838 each group of Stmts with a thing_inside whose FreeVars include at least {a,c}
840 (b) We want to report that 'a' is illegally bound in both branches
842 (c) The 'bs' in the second group must obviously not be captured by
843 the binding in the first group
845 To satisfy (a) we nest the segements.
846 To satisfy (b) we check for duplicates just before thing_inside.
847 To satisfy (c) we reset the LocalRdrEnv each time.
849 %************************************************************************
851 \subsubsection{mdo expressions}
853 %************************************************************************
856 type FwdRefs = NameSet
857 type Segment stmts = (Defs,
858 Uses, -- May include defs
859 FwdRefs, -- A subset of uses that are
860 -- (a) used before they are bound in this segment, or
861 -- (b) used here, and bound in subsequent segments
862 stmts) -- Either Stmt or [Stmt]
865 ----------------------------------------------------
867 rnMDoStmts :: [LStmt RdrName]
868 -> RnM (thing, FreeVars)
869 -> RnM (([LStmt Name], thing), FreeVars)
870 rnMDoStmts stmts thing_inside
871 = rn_rec_stmts_and_then stmts $ \ segs -> do
872 { (thing, fvs_later) <- thing_inside
873 ; let segs_w_fwd_refs = addFwdRefs segs
874 grouped_segs = glomSegments segs_w_fwd_refs
875 (stmts', fvs) = segsToStmts emptyRecStmt grouped_segs fvs_later
876 ; return ((stmts', thing), fvs) }
878 ---------------------------------------------
880 -- wrapper that does both the left- and right-hand sides
881 rn_rec_stmts_and_then :: [LStmt RdrName]
882 -- assumes that the FreeVars returned includes
883 -- the FreeVars of the Segments
884 -> ([Segment (LStmt Name)] -> RnM (a, FreeVars))
886 rn_rec_stmts_and_then s cont
887 = do { -- (A) Make the mini fixity env for all of the stmts
888 fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)
891 ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s
893 -- ...bring them and their fixities into scope
894 ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)
895 ; bindLocalNamesFV bound_names $
896 addLocalFixities fix_env bound_names $ do
898 -- (C) do the right-hand-sides and thing-inside
899 { segs <- rn_rec_stmts bound_names new_lhs_and_fv
900 ; (res, fvs) <- cont segs
901 ; warnUnusedLocalBinds bound_names fvs
902 ; return (res, fvs) }}
904 -- get all the fixity decls in any Let stmt
905 collectRecStmtsFixities :: [LStmtLR RdrName RdrName] -> [LFixitySig RdrName]
906 collectRecStmtsFixities l =
907 foldr (\ s -> \acc -> case s of
908 (L _ (LetStmt (HsValBinds (ValBindsIn _ sigs)))) ->
909 foldr (\ sig -> \ acc -> case sig of
910 (L loc (FixSig s)) -> (L loc s) : acc
916 rn_rec_stmt_lhs :: MiniFixityEnv
918 -- rename LHS, and return its FVs
919 -- Warning: we will only need the FreeVars below in the case of a BindStmt,
920 -- so we don't bother to compute it accurately in the other cases
921 -> RnM [(LStmtLR Name RdrName, FreeVars)]
923 rn_rec_stmt_lhs _ (L loc (ExprStmt expr a b)) = return [(L loc (ExprStmt expr a b),
924 -- this is actually correct
927 rn_rec_stmt_lhs fix_env (L loc (BindStmt pat expr a b))
929 -- should the ctxt be MDo instead?
930 (pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat
931 return [(L loc (BindStmt pat' expr a b),
934 rn_rec_stmt_lhs _ (L _ (LetStmt binds@(HsIPBinds _)))
935 = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
937 rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds)))
938 = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds
939 return [(L loc (LetStmt (HsValBinds binds')),
940 -- Warning: this is bogus; see function invariant
944 -- XXX Do we need to do something with the return and mfix names?
945 rn_rec_stmt_lhs fix_env (L _ (RecStmt { recS_stmts = stmts })) -- Flatten Rec inside Rec
946 = rn_rec_stmts_lhs fix_env stmts
948 rn_rec_stmt_lhs _ stmt@(L _ (ParStmt _)) -- Syntactically illegal in mdo
949 = pprPanic "rn_rec_stmt" (ppr stmt)
951 rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt {})) -- Syntactically illegal in mdo
952 = pprPanic "rn_rec_stmt" (ppr stmt)
954 rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt {})) -- Syntactically illegal in mdo
955 = pprPanic "rn_rec_stmt" (ppr stmt)
957 rn_rec_stmt_lhs _ (L _ (LetStmt EmptyLocalBinds))
958 = panic "rn_rec_stmt LetStmt EmptyLocalBinds"
960 rn_rec_stmts_lhs :: MiniFixityEnv
962 -> RnM [(LStmtLR Name RdrName, FreeVars)]
963 rn_rec_stmts_lhs fix_env stmts
964 = do { ls <- concatMapM (rn_rec_stmt_lhs fix_env) stmts
965 ; let boundNames = collectLStmtsBinders (map fst ls)
966 -- First do error checking: we need to check for dups here because we
967 -- don't bind all of the variables from the Stmt at once
968 -- with bindLocatedLocals.
969 ; checkDupNames boundNames
975 rn_rec_stmt :: [Name] -> LStmtLR Name RdrName -> FreeVars -> RnM [Segment (LStmt Name)]
976 -- Rename a Stmt that is inside a RecStmt (or mdo)
977 -- Assumes all binders are already in scope
978 -- Turns each stmt into a singleton Stmt
979 rn_rec_stmt _ (L loc (ExprStmt expr _ _)) _
980 = rnLExpr expr `thenM` \ (expr', fvs) ->
981 lookupSyntaxName thenMName `thenM` \ (then_op, fvs1) ->
982 return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
983 L loc (ExprStmt expr' then_op placeHolderType))]
985 rn_rec_stmt _ (L loc (BindStmt pat' expr _ _)) fv_pat
986 = rnLExpr expr `thenM` \ (expr', fv_expr) ->
987 lookupSyntaxName bindMName `thenM` \ (bind_op, fvs1) ->
988 lookupSyntaxName failMName `thenM` \ (fail_op, fvs2) ->
990 bndrs = mkNameSet (collectPatBinders pat')
991 fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
993 return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
994 L loc (BindStmt pat' expr' bind_op fail_op))]
996 rn_rec_stmt _ (L _ (LetStmt binds@(HsIPBinds _))) _
997 = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
999 rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do
1000 (binds', du_binds) <-
1001 -- fixities and unused are handled above in rn_rec_stmts_and_then
1002 rnLocalValBindsRHS (mkNameSet all_bndrs) binds'
1003 return [(duDefs du_binds, allUses du_binds,
1004 emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
1006 -- no RecStmt case becuase they get flattened above when doing the LHSes
1007 rn_rec_stmt _ stmt@(L _ (RecStmt {})) _
1008 = pprPanic "rn_rec_stmt: RecStmt" (ppr stmt)
1010 rn_rec_stmt _ stmt@(L _ (ParStmt {})) _ -- Syntactically illegal in mdo
1011 = pprPanic "rn_rec_stmt: ParStmt" (ppr stmt)
1013 rn_rec_stmt _ stmt@(L _ (TransformStmt {})) _ -- Syntactically illegal in mdo
1014 = pprPanic "rn_rec_stmt: TransformStmt" (ppr stmt)
1016 rn_rec_stmt _ stmt@(L _ (GroupStmt {})) _ -- Syntactically illegal in mdo
1017 = pprPanic "rn_rec_stmt: GroupStmt" (ppr stmt)
1019 rn_rec_stmt _ (L _ (LetStmt EmptyLocalBinds)) _
1020 = panic "rn_rec_stmt: LetStmt EmptyLocalBinds"
1022 rn_rec_stmts :: [Name] -> [(LStmtLR Name RdrName, FreeVars)] -> RnM [Segment (LStmt Name)]
1023 rn_rec_stmts bndrs stmts = mapM (uncurry (rn_rec_stmt bndrs)) stmts `thenM` \ segs_s ->
1024 return (concat segs_s)
1026 ---------------------------------------------
1027 addFwdRefs :: [Segment a] -> [Segment a]
1028 -- So far the segments only have forward refs *within* the Stmt
1029 -- (which happens for bind: x <- ...x...)
1030 -- This function adds the cross-seg fwd ref info
1033 = fst (foldr mk_seg ([], emptyNameSet) pairs)
1035 mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
1036 = (new_seg : segs, all_defs)
1038 new_seg = (defs, uses, new_fwds, stmts)
1039 all_defs = later_defs `unionNameSets` defs
1040 new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
1041 -- Add the downstream fwd refs here
1043 ----------------------------------------------------
1044 -- Glomming the singleton segments of an mdo into
1045 -- minimal recursive groups.
1047 -- At first I thought this was just strongly connected components, but
1048 -- there's an important constraint: the order of the stmts must not change.
1051 -- mdo { x <- ...y...
1058 -- Here, the first stmt mention 'y', which is bound in the third.
1059 -- But that means that the innocent second stmt (p <- z) gets caught
1060 -- up in the recursion. And that in turn means that the binding for
1061 -- 'z' has to be included... and so on.
1063 -- Start at the tail { r <- x }
1064 -- Now add the next one { z <- y ; r <- x }
1065 -- Now add one more { q <- x ; z <- y ; r <- x }
1066 -- Now one more... but this time we have to group a bunch into rec
1067 -- { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
1068 -- Now one more, which we can add on without a rec
1070 -- rec { y <- ...x... ; q <- x ; z <- y } ;
1072 -- Finally we add the last one; since it mentions y we have to
1073 -- glom it togeher with the first two groups
1074 -- { rec { x <- ...y...; p <- z ; y <- ...x... ;
1075 -- q <- x ; z <- y } ;
1078 glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
1080 glomSegments [] = []
1081 glomSegments ((defs,uses,fwds,stmt) : segs)
1082 -- Actually stmts will always be a singleton
1083 = (seg_defs, seg_uses, seg_fwds, seg_stmts) : others
1085 segs' = glomSegments segs
1086 (extras, others) = grab uses segs'
1087 (ds, us, fs, ss) = unzip4 extras
1089 seg_defs = plusFVs ds `plusFV` defs
1090 seg_uses = plusFVs us `plusFV` uses
1091 seg_fwds = plusFVs fs `plusFV` fwds
1092 seg_stmts = stmt : concat ss
1094 grab :: NameSet -- The client
1096 -> ([Segment a], -- Needed by the 'client'
1097 [Segment a]) -- Not needed by the client
1098 -- The result is simply a split of the input
1100 = (reverse yeses, reverse noes)
1102 (noes, yeses) = span not_needed (reverse dus)
1103 not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
1106 ----------------------------------------------------
1107 segsToStmts :: Stmt Name -- A RecStmt with the SyntaxOps filled in
1108 -> [Segment [LStmt Name]]
1109 -> FreeVars -- Free vars used 'later'
1110 -> ([LStmt Name], FreeVars)
1112 segsToStmts _ [] fvs_later = ([], fvs_later)
1113 segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
1114 = ASSERT( not (null ss) )
1115 (new_stmt : later_stmts, later_uses `plusFV` uses)
1117 (later_stmts, later_uses) = segsToStmts empty_rec_stmt segs fvs_later
1118 new_stmt | non_rec = head ss
1119 | otherwise = L (getLoc (head ss)) rec_stmt
1120 rec_stmt = empty_rec_stmt { recS_stmts = ss
1121 , recS_later_ids = nameSetToList used_later
1122 , recS_rec_ids = nameSetToList fwds }
1123 non_rec = isSingleton ss && isEmptyNameSet fwds
1124 used_later = defs `intersectNameSet` later_uses
1125 -- The ones needed after the RecStmt
1128 %************************************************************************
1130 \subsubsection{Assertion utils}
1132 %************************************************************************
1135 srcSpanPrimLit :: SrcSpan -> HsExpr Name
1136 srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDocOneLine (ppr span))))
1138 mkAssertErrorExpr :: RnM (HsExpr Name)
1139 -- Return an expression for (assertError "Foo.hs:27")
1141 = getSrcSpanM `thenM` \ sloc ->
1142 return (HsApp (L sloc (HsVar assertErrorName))
1143 (L sloc (srcSpanPrimLit sloc)))
1146 Note [Adding the implicit parameter to 'assert']
1147 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1148 The renamer transforms (assert e1 e2) to (assert "Foo.hs:27" e1 e2).
1149 By doing this in the renamer we allow the typechecker to just see the
1150 expanded application and do the right thing. But it's not really
1151 the Right Thing because there's no way to "undo" if you want to see
1152 the original source code. We'll have fix this in due course, when
1153 we care more about being able to reconstruct the exact original
1156 %************************************************************************
1158 \subsubsection{Errors}
1160 %************************************************************************
1164 ----------------------
1165 -- Checking when a particular Stmt is ok
1166 checkLetStmt :: HsStmtContext Name -> HsLocalBinds RdrName -> RnM ()
1167 checkLetStmt (ParStmtCtxt _) (HsIPBinds binds) = addErr (badIpBinds (ptext (sLit "a parallel list comprehension:")) binds)
1168 checkLetStmt _ctxt _binds = return ()
1169 -- We do not allow implicit-parameter bindings in a parallel
1170 -- list comprehension. I'm not sure what it might mean.
1173 checkRecStmt :: HsStmtContext Name -> RnM ()
1174 checkRecStmt (MDoExpr {}) = return () -- Recursive stmt ok in 'mdo'
1175 checkRecStmt (DoExpr {}) = return () -- and in 'do'
1176 checkRecStmt ctxt = addErr msg
1178 msg = ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt
1181 checkParStmt :: HsStmtContext Name -> RnM ()
1183 = do { parallel_list_comp <- xoptM Opt_ParallelListComp
1184 ; checkErr parallel_list_comp msg }
1186 msg = ptext (sLit "Illegal parallel list comprehension: use -XParallelListComp")
1189 checkTransformStmt :: HsStmtContext Name -> RnM ()
1190 checkTransformStmt ListComp -- Ensure we are really within a list comprehension because otherwise the
1191 -- desugarer will break when we come to operate on a parallel array
1192 = do { transform_list_comp <- xoptM Opt_TransformListComp
1193 ; checkErr transform_list_comp msg }
1195 msg = ptext (sLit "Illegal transform or grouping list comprehension: use -XTransformListComp")
1196 checkTransformStmt (ParStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension
1197 checkTransformStmt (TransformStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension
1198 checkTransformStmt ctxt = addErr msg
1200 msg = ptext (sLit "Illegal transform or grouping in") <+> pprStmtContext ctxt
1203 checkTupleSection :: [HsTupArg RdrName] -> RnM ()
1204 checkTupleSection args
1205 = do { tuple_section <- xoptM Opt_TupleSections
1206 ; checkErr (all tupArgPresent args || tuple_section) msg }
1208 msg = ptext (sLit "Illegal tuple section: use -XTupleSections")
1211 sectionErr :: HsExpr RdrName -> SDoc
1213 = hang (ptext (sLit "A section must be enclosed in parentheses"))
1214 2 (ptext (sLit "thus:") <+> (parens (ppr expr)))
1216 patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
1217 patSynErr e = do { addErr (sep [ptext (sLit "Pattern syntax in expression context:"),
1219 ; return (EWildPat, emptyFVs) }
1221 badIpBinds :: Outputable a => SDoc -> a -> SDoc
1222 badIpBinds what binds
1223 = hang (ptext (sLit "Implicit-parameter bindings illegal in") <+> what)