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, rnValBindsLHS, rnValBindsRHS,
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 = rnLExpr p `thenM` \ (p', fvP) ->
267 rnLExpr b1 `thenM` \ (b1', fvB1) ->
268 rnLExpr b2 `thenM` \ (b2', fvB2) ->
269 return (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
272 = rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
273 return (HsType t, fvT)
275 doc = text "In a type argument"
277 rnExpr (ArithSeq _ seq)
278 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
279 return (ArithSeq noPostTcExpr new_seq, fvs)
281 rnExpr (PArrSeq _ seq)
282 = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
283 return (PArrSeq noPostTcExpr new_seq, fvs)
286 These three are pattern syntax appearing in expressions.
287 Since all the symbols are reservedops we can simply reject them.
288 We return a (bogus) EWildPat in each case.
291 rnExpr e@EWildPat = patSynErr e
292 rnExpr e@(EAsPat {}) = patSynErr e
293 rnExpr e@(EViewPat {}) = patSynErr e
294 rnExpr e@(ELazyPat {}) = patSynErr e
297 %************************************************************************
301 %************************************************************************
304 rnExpr (HsProc pat body)
306 rnPat ProcExpr pat $ \ pat' ->
307 rnCmdTop body `thenM` \ (body',fvBody) ->
308 return (HsProc pat' body', fvBody)
310 rnExpr (HsArrApp arrow arg _ ho rtl)
311 = select_arrow_scope (rnLExpr arrow) `thenM` \ (arrow',fvArrow) ->
312 rnLExpr arg `thenM` \ (arg',fvArg) ->
313 return (HsArrApp arrow' arg' placeHolderType ho rtl,
314 fvArrow `plusFV` fvArg)
316 select_arrow_scope tc = case ho of
317 HsHigherOrderApp -> tc
318 HsFirstOrderApp -> escapeArrowScope tc
321 rnExpr (HsArrForm op (Just _) [arg1, arg2])
322 = escapeArrowScope (rnLExpr op)
323 `thenM` \ (op',fv_op) ->
324 let L _ (HsVar op_name) = op' in
325 rnCmdTop arg1 `thenM` \ (arg1',fv_arg1) ->
326 rnCmdTop arg2 `thenM` \ (arg2',fv_arg2) ->
330 lookupFixityRn op_name `thenM` \ fixity ->
331 mkOpFormRn arg1' op' fixity arg2' `thenM` \ final_e ->
334 fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
336 rnExpr (HsArrForm op fixity cmds)
337 = escapeArrowScope (rnLExpr op) `thenM` \ (op',fvOp) ->
338 rnCmdArgs cmds `thenM` \ (cmds',fvCmds) ->
339 return (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
341 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
344 ----------------------
345 -- See Note [Parsing sections] in Parser.y.pp
346 rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
347 rnSection section@(SectionR op expr)
348 = do { (op', fvs_op) <- rnLExpr op
349 ; (expr', fvs_expr) <- rnLExpr expr
350 ; checkSectionPrec InfixR section op' expr'
351 ; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
353 rnSection section@(SectionL expr op)
354 = do { (expr', fvs_expr) <- rnLExpr expr
355 ; (op', fvs_op) <- rnLExpr op
356 ; checkSectionPrec InfixL section op' expr'
357 ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
359 rnSection other = pprPanic "rnSection" (ppr other)
362 %************************************************************************
366 %************************************************************************
369 rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
370 -> RnM (HsRecordBinds Name, FreeVars)
371 rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
372 = do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
373 ; (flds', fvss) <- mapAndUnzipM rn_field flds
374 ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd },
375 fvs `plusFV` plusFVs fvss) }
377 rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
378 ; return (fld { hsRecFieldArg = arg' }, fvs) }
382 %************************************************************************
386 %************************************************************************
389 rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
390 rnCmdArgs [] = return ([], emptyFVs)
392 = rnCmdTop arg `thenM` \ (arg',fvArg) ->
393 rnCmdArgs args `thenM` \ (args',fvArgs) ->
394 return (arg':args', fvArg `plusFV` fvArgs)
396 rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
397 rnCmdTop = wrapLocFstM rnCmdTop'
399 rnCmdTop' (HsCmdTop cmd _ _ _)
400 = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
402 cmd_names = [arrAName, composeAName, firstAName] ++
403 nameSetToList (methodNamesCmd (unLoc cmd'))
405 -- Generate the rebindable syntax for the monad
406 lookupSyntaxTable cmd_names `thenM` \ (cmd_names', cmd_fvs) ->
408 return (HsCmdTop cmd' [] placeHolderType cmd_names',
409 fvCmd `plusFV` cmd_fvs)
411 ---------------------------------------------------
412 -- convert OpApp's in a command context to HsArrForm's
414 convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
415 convertOpFormsLCmd = fmap convertOpFormsCmd
417 convertOpFormsCmd :: HsCmd id -> HsCmd id
419 convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
420 convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
421 convertOpFormsCmd (OpApp c1 op fixity c2)
423 arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
424 arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
426 HsArrForm op (Just fixity) [arg1, arg2]
428 convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
430 convertOpFormsCmd (HsCase exp matches)
431 = HsCase exp (convertOpFormsMatch matches)
433 convertOpFormsCmd (HsIf exp c1 c2)
434 = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
436 convertOpFormsCmd (HsLet binds cmd)
437 = HsLet binds (convertOpFormsLCmd cmd)
439 convertOpFormsCmd (HsDo ctxt stmts body ty)
440 = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
441 (convertOpFormsLCmd body) ty
443 -- Anything else is unchanged. This includes HsArrForm (already done),
444 -- things with no sub-commands, and illegal commands (which will be
445 -- caught by the type checker)
446 convertOpFormsCmd c = c
448 convertOpFormsStmt :: StmtLR id id -> StmtLR id id
449 convertOpFormsStmt (BindStmt pat cmd _ _)
450 = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
451 convertOpFormsStmt (ExprStmt cmd _ _)
452 = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
453 convertOpFormsStmt stmt@(RecStmt { recS_stmts = stmts })
454 = stmt { recS_stmts = map (fmap convertOpFormsStmt) stmts }
455 convertOpFormsStmt stmt = stmt
457 convertOpFormsMatch :: MatchGroup id -> MatchGroup id
458 convertOpFormsMatch (MatchGroup ms ty)
459 = MatchGroup (map (fmap convert) ms) ty
460 where convert (Match pat mty grhss)
461 = Match pat mty (convertOpFormsGRHSs grhss)
463 convertOpFormsGRHSs :: GRHSs id -> GRHSs id
464 convertOpFormsGRHSs (GRHSs grhss binds)
465 = GRHSs (map convertOpFormsGRHS grhss) binds
467 convertOpFormsGRHS :: Located (GRHS id) -> Located (GRHS id)
468 convertOpFormsGRHS = fmap convert
470 convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
472 ---------------------------------------------------
473 type CmdNeeds = FreeVars -- Only inhabitants are
474 -- appAName, choiceAName, loopAName
476 -- find what methods the Cmd needs (loop, choice, apply)
477 methodNamesLCmd :: LHsCmd Name -> CmdNeeds
478 methodNamesLCmd = methodNamesCmd . unLoc
480 methodNamesCmd :: HsCmd Name -> CmdNeeds
482 methodNamesCmd (HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
484 methodNamesCmd (HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
486 methodNamesCmd (HsArrForm {}) = emptyFVs
488 methodNamesCmd (HsPar c) = methodNamesLCmd c
490 methodNamesCmd (HsIf _ c1 c2)
491 = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
493 methodNamesCmd (HsLet _ c) = methodNamesLCmd c
495 methodNamesCmd (HsDo _ stmts body _)
496 = methodNamesStmts stmts `plusFV` methodNamesLCmd body
498 methodNamesCmd (HsApp c _) = methodNamesLCmd c
500 methodNamesCmd (HsLam match) = methodNamesMatch match
502 methodNamesCmd (HsCase _ matches)
503 = methodNamesMatch matches `addOneFV` choiceAName
505 methodNamesCmd _ = emptyFVs
506 -- Other forms can't occur in commands, but it's not convenient
507 -- to error here so we just do what's convenient.
508 -- The type checker will complain later
510 ---------------------------------------------------
511 methodNamesMatch :: MatchGroup Name -> FreeVars
512 methodNamesMatch (MatchGroup ms _)
513 = plusFVs (map do_one ms)
515 do_one (L _ (Match _ _ grhss)) = methodNamesGRHSs grhss
517 -------------------------------------------------
519 methodNamesGRHSs :: GRHSs Name -> FreeVars
520 methodNamesGRHSs (GRHSs grhss _) = plusFVs (map methodNamesGRHS grhss)
522 -------------------------------------------------
524 methodNamesGRHS :: Located (GRHS Name) -> CmdNeeds
525 methodNamesGRHS (L _ (GRHS _ rhs)) = methodNamesLCmd rhs
527 ---------------------------------------------------
528 methodNamesStmts :: [Located (StmtLR Name Name)] -> FreeVars
529 methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
531 ---------------------------------------------------
532 methodNamesLStmt :: Located (StmtLR Name Name) -> FreeVars
533 methodNamesLStmt = methodNamesStmt . unLoc
535 methodNamesStmt :: StmtLR Name Name -> FreeVars
536 methodNamesStmt (ExprStmt cmd _ _) = methodNamesLCmd cmd
537 methodNamesStmt (BindStmt _ cmd _ _) = methodNamesLCmd cmd
538 methodNamesStmt (RecStmt { recS_stmts = stmts }) = methodNamesStmts stmts `addOneFV` loopAName
539 methodNamesStmt (LetStmt _) = emptyFVs
540 methodNamesStmt (ParStmt _) = emptyFVs
541 methodNamesStmt (TransformStmt {}) = emptyFVs
542 methodNamesStmt (GroupStmt {}) = emptyFVs
543 -- ParStmt, TransformStmt and GroupStmt can't occur in commands, but it's not convenient to error
544 -- here so we just do what's convenient
548 %************************************************************************
552 %************************************************************************
555 rnArithSeq :: ArithSeqInfo RdrName -> RnM (ArithSeqInfo Name, FreeVars)
556 rnArithSeq (From expr)
557 = rnLExpr expr `thenM` \ (expr', fvExpr) ->
558 return (From expr', fvExpr)
560 rnArithSeq (FromThen expr1 expr2)
561 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
562 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
563 return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
565 rnArithSeq (FromTo expr1 expr2)
566 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
567 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
568 return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
570 rnArithSeq (FromThenTo expr1 expr2 expr3)
571 = rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
572 rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
573 rnLExpr expr3 `thenM` \ (expr3', fvExpr3) ->
574 return (FromThenTo expr1' expr2' expr3',
575 plusFVs [fvExpr1, fvExpr2, fvExpr3])
578 %************************************************************************
580 Template Haskell brackets
582 %************************************************************************
585 rnBracket :: HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
586 rnBracket (VarBr n) = do { name <- lookupOccRn n
587 ; this_mod <- getModule
588 ; unless (nameIsLocalOrFrom this_mod name) $ -- Reason: deprecation checking asumes the
589 do { _ <- loadInterfaceForName msg name -- home interface is loaded, and this is the
590 ; return () } -- only way that is going to happen
591 ; return (VarBr name, unitFV name) }
593 msg = ptext (sLit "Need interface for Template Haskell quoted Name")
595 rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
596 ; return (ExpBr e', fvs) }
598 rnBracket (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
600 rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
601 ; return (TypBr t', fvs) }
603 doc = ptext (sLit "In a Template-Haskell quoted type")
605 rnBracket (DecBrL decls)
606 = do { (group, mb_splice) <- findSplice decls
609 Just (SpliceDecl (L loc _) _, _)
611 addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets"))
612 -- Why not? See Section 7.3 of the TH paper.
614 ; gbl_env <- getGblEnv
615 ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
616 -- The emptyDUs is so that we just collect uses for this
617 -- group alone in the call to rnSrcDecls below
618 ; (tcg_env, group') <- setGblEnv new_gbl_env $
622 -- Discard the tcg_env; it contains only extra info about fixity
623 ; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env))))
624 ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
626 rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG"
629 %************************************************************************
631 \subsubsection{@Stmt@s: in @do@ expressions}
633 %************************************************************************
636 rnStmts :: HsStmtContext Name -> [LStmt RdrName]
637 -> RnM (thing, FreeVars)
638 -> RnM (([LStmt Name], thing), FreeVars)
639 -- Variables bound by the Stmts, and mentioned in thing_inside,
640 -- do not appear in the result FreeVars
642 rnStmts (MDoExpr _) stmts thing_inside = rnMDoStmts stmts thing_inside
643 rnStmts ctxt stmts thing_inside = rnNormalStmts ctxt stmts (\ _ -> thing_inside)
645 rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
646 -> ([Name] -> RnM (thing, FreeVars))
647 -> RnM (([LStmt Name], thing), FreeVars)
648 -- Variables bound by the Stmts, and mentioned in thing_inside,
649 -- do not appear in the result FreeVars
651 -- Renaming a single RecStmt can give a sequence of smaller Stmts
653 rnNormalStmts _ [] thing_inside
654 = do { (res, fvs) <- thing_inside []
655 ; return (([], res), fvs) }
657 rnNormalStmts ctxt (stmt@(L loc _) : stmts) thing_inside
658 = do { ((stmts1, (stmts2, thing)), fvs)
660 rnStmt ctxt stmt $ \ bndrs1 ->
661 rnNormalStmts ctxt stmts $ \ bndrs2 ->
662 thing_inside (bndrs1 ++ bndrs2)
663 ; return (((stmts1 ++ stmts2), thing), fvs) }
666 rnStmt :: HsStmtContext Name -> LStmt RdrName
667 -> ([Name] -> RnM (thing, FreeVars))
668 -> RnM (([LStmt Name], thing), FreeVars)
669 -- Variables bound by the Stmt, and mentioned in thing_inside,
670 -- do not appear in the result FreeVars
672 rnStmt _ (L loc (ExprStmt expr _ _)) thing_inside
673 = do { (expr', fv_expr) <- rnLExpr expr
674 ; (then_op, fvs1) <- lookupSyntaxName thenMName
675 ; (thing, fvs2) <- thing_inside []
676 ; return (([L loc (ExprStmt expr' then_op placeHolderType)], thing),
677 fv_expr `plusFV` fvs1 `plusFV` fvs2) }
679 rnStmt ctxt (L loc (BindStmt pat expr _ _)) thing_inside
680 = do { (expr', fv_expr) <- rnLExpr expr
681 -- The binders do not scope over the expression
682 ; (bind_op, fvs1) <- lookupSyntaxName bindMName
683 ; (fail_op, fvs2) <- lookupSyntaxName failMName
684 ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do
685 { (thing, fvs3) <- thing_inside (collectPatBinders pat')
686 ; return (([L loc (BindStmt pat' expr' bind_op fail_op)], thing),
687 fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
688 -- fv_expr shouldn't really be filtered by the rnPatsAndThen
689 -- but it does not matter because the names are unique
691 rnStmt ctxt (L loc (LetStmt binds)) thing_inside
692 = do { checkLetStmt ctxt binds
693 ; rnLocalBindsAndThen binds $ \binds' -> do
694 { (thing, fvs) <- thing_inside (collectLocalBinders binds')
695 ; return (([L loc (LetStmt binds')], thing), fvs) } }
697 rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
698 = do { checkRecStmt ctxt
700 -- Step1: Bring all the binders of the mdo into scope
701 -- (Remember that this also removes the binders from the
702 -- finally-returned free-vars.)
703 -- And rename each individual stmt, making a
704 -- singleton segment. At this stage the FwdRefs field
705 -- isn't finished: it's empty for all except a BindStmt
706 -- for which it's the fwd refs within the bind itself
707 -- (This set may not be empty, because we're in a recursive
709 ; rn_rec_stmts_and_then rec_stmts $ \ segs -> do
711 { let bndrs = nameSetToList $ foldr (unionNameSets . (\(ds,_,_,_) -> ds))
713 ; (thing, fvs_later) <- thing_inside bndrs
714 ; (return_op, fvs1) <- lookupSyntaxName returnMName
715 ; (mfix_op, fvs2) <- lookupSyntaxName mfixName
716 ; (bind_op, fvs3) <- lookupSyntaxName bindMName
718 -- Step 2: Fill in the fwd refs.
719 -- The segments are all singletons, but their fwd-ref
720 -- field mentions all the things used by the segment
721 -- that are bound after their use
722 segs_w_fwd_refs = addFwdRefs segs
724 -- Step 3: Group together the segments to make bigger segments
725 -- Invariant: in the result, no segment uses a variable
726 -- bound in a later segment
727 grouped_segs = glomSegments segs_w_fwd_refs
729 -- Step 4: Turn the segments into Stmts
730 -- Use RecStmt when and only when there are fwd refs
731 -- Also gather up the uses from the end towards the
732 -- start, so we can tell the RecStmt which things are
733 -- used 'after' the RecStmt
734 empty_rec_stmt = emptyRecStmt { recS_ret_fn = return_op
735 , recS_mfix_fn = mfix_op
736 , recS_bind_fn = bind_op }
737 (rec_stmts', fvs) = segsToStmts empty_rec_stmt grouped_segs fvs_later
739 ; return ((rec_stmts', thing), fvs `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } }
741 rnStmt ctxt (L loc (ParStmt segs)) thing_inside
742 = do { checkParStmt ctxt
743 ; ((segs', thing), fvs) <- rnParallelStmts (ParStmtCtxt ctxt) segs thing_inside
744 ; return (([L loc (ParStmt segs')], thing), fvs) }
746 rnStmt ctxt (L loc (TransformStmt stmts _ using by)) thing_inside
747 = do { checkTransformStmt ctxt
749 ; (using', fvs1) <- rnLExpr using
751 ; ((stmts', (by', used_bndrs, thing)), fvs2)
752 <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
753 do { (by', fvs_by) <- case by of
754 Nothing -> return (Nothing, emptyFVs)
755 Just e -> do { (e', fvs) <- rnLExpr e; return (Just e', fvs) }
756 ; (thing, fvs_thing) <- thing_inside bndrs
757 ; let fvs = fvs_by `plusFV` fvs_thing
758 used_bndrs = filter (`elemNameSet` fvs_thing) bndrs
759 ; return ((by', used_bndrs, thing), fvs) }
761 ; return (([L loc (TransformStmt stmts' used_bndrs using' by')], thing),
762 fvs1 `plusFV` fvs2) }
764 rnStmt ctxt (L loc (GroupStmt stmts _ by using)) thing_inside
765 = do { checkTransformStmt ctxt
767 -- Rename the 'using' expression in the context before the transform is begun
768 ; (using', fvs1) <- case using of
769 Left e -> do { (e', fvs) <- rnLExpr e; return (Left e', fvs) }
770 Right _ -> do { (e', fvs) <- lookupSyntaxName groupWithName
771 ; return (Right e', fvs) }
773 -- Rename the stmts and the 'by' expression
774 -- Keep track of the variables mentioned in the 'by' expression
775 ; ((stmts', (by', used_bndrs, thing)), fvs2)
776 <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
777 do { (by', fvs_by) <- mapMaybeFvRn rnLExpr by
778 ; (thing, fvs_thing) <- thing_inside bndrs
779 ; let fvs = fvs_by `plusFV` fvs_thing
780 used_bndrs = filter (`elemNameSet` fvs) bndrs
781 ; return ((by', used_bndrs, thing), fvs) }
783 ; let all_fvs = fvs1 `plusFV` fvs2
784 bndr_map = used_bndrs `zip` used_bndrs
785 -- See Note [GroupStmt binder map] in HsExpr
787 ; traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr bndr_map)
788 ; return (([L loc (GroupStmt stmts' bndr_map by' using')], thing), all_fvs) }
791 type ParSeg id = ([LStmt id], [id]) -- The Names are bound by the Stmts
793 rnParallelStmts :: forall thing. HsStmtContext Name
795 -> ([Name] -> RnM (thing, FreeVars))
796 -> RnM (([ParSeg Name], thing), FreeVars)
797 -- Note [Renaming parallel Stmts]
798 rnParallelStmts ctxt segs thing_inside
799 = do { orig_lcl_env <- getLocalRdrEnv
800 ; rn_segs orig_lcl_env [] segs }
802 rn_segs :: LocalRdrEnv
803 -> [Name] -> [ParSeg RdrName]
804 -> RnM (([ParSeg Name], thing), FreeVars)
805 rn_segs _ bndrs_so_far []
806 = do { let (bndrs', dups) = removeDups cmpByOcc bndrs_so_far
808 ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')
809 ; return (([], thing), fvs) }
811 rn_segs env bndrs_so_far ((stmts,_) : segs)
812 = do { ((stmts', (used_bndrs, segs', thing)), fvs)
813 <- rnNormalStmts ctxt stmts $ \ bndrs ->
814 setLocalRdrEnv env $ do
815 { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs
816 ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
817 ; return ((used_bndrs, segs', thing), fvs) }
819 ; let seg' = (stmts', used_bndrs)
820 ; return ((seg':segs', thing), fvs) }
822 cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
823 dupErr vs = addErr (ptext (sLit "Duplicate binding in parallel list comprehension for:")
824 <+> quotes (ppr (head vs)))
827 Note [Renaming parallel Stmts]
828 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
829 Renaming parallel statements is painful. Given, say
830 [ a+c | a <- as, bs <- bss
833 (a) In order to report "Defined by not used" about 'bs', we must rename
834 each group of Stmts with a thing_inside whose FreeVars include at least {a,c}
836 (b) We want to report that 'a' is illegally bound in both branches
838 (c) The 'bs' in the second group must obviously not be captured by
839 the binding in the first group
841 To satisfy (a) we nest the segements.
842 To satisfy (b) we check for duplicates just before thing_inside.
843 To satisfy (c) we reset the LocalRdrEnv each time.
845 %************************************************************************
847 \subsubsection{mdo expressions}
849 %************************************************************************
852 type FwdRefs = NameSet
853 type Segment stmts = (Defs,
854 Uses, -- May include defs
855 FwdRefs, -- A subset of uses that are
856 -- (a) used before they are bound in this segment, or
857 -- (b) used here, and bound in subsequent segments
858 stmts) -- Either Stmt or [Stmt]
861 ----------------------------------------------------
863 rnMDoStmts :: [LStmt RdrName]
864 -> RnM (thing, FreeVars)
865 -> RnM (([LStmt Name], thing), FreeVars)
866 rnMDoStmts stmts thing_inside
867 = rn_rec_stmts_and_then stmts $ \ segs -> do
868 { (thing, fvs_later) <- thing_inside
869 ; let segs_w_fwd_refs = addFwdRefs segs
870 grouped_segs = glomSegments segs_w_fwd_refs
871 (stmts', fvs) = segsToStmts emptyRecStmt grouped_segs fvs_later
872 ; return ((stmts', thing), fvs) }
874 ---------------------------------------------
876 -- wrapper that does both the left- and right-hand sides
877 rn_rec_stmts_and_then :: [LStmt RdrName]
878 -- assumes that the FreeVars returned includes
879 -- the FreeVars of the Segments
880 -> ([Segment (LStmt Name)] -> RnM (a, FreeVars))
882 rn_rec_stmts_and_then s cont
883 = do { -- (A) Make the mini fixity env for all of the stmts
884 fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)
887 ; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s
889 -- ...bring them and their fixities into scope
890 ; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)
891 ; bindLocalNamesFV bound_names $
892 addLocalFixities fix_env bound_names $ do
894 -- (C) do the right-hand-sides and thing-inside
895 { segs <- rn_rec_stmts bound_names new_lhs_and_fv
896 ; (res, fvs) <- cont segs
897 ; warnUnusedLocalBinds bound_names fvs
898 ; return (res, fvs) }}
900 -- get all the fixity decls in any Let stmt
901 collectRecStmtsFixities :: [LStmtLR RdrName RdrName] -> [LFixitySig RdrName]
902 collectRecStmtsFixities l =
903 foldr (\ s -> \acc -> case s of
904 (L _ (LetStmt (HsValBinds (ValBindsIn _ sigs)))) ->
905 foldr (\ sig -> \ acc -> case sig of
906 (L loc (FixSig s)) -> (L loc s) : acc
912 rn_rec_stmt_lhs :: MiniFixityEnv
914 -- rename LHS, and return its FVs
915 -- Warning: we will only need the FreeVars below in the case of a BindStmt,
916 -- so we don't bother to compute it accurately in the other cases
917 -> RnM [(LStmtLR Name RdrName, FreeVars)]
919 rn_rec_stmt_lhs _ (L loc (ExprStmt expr a b)) = return [(L loc (ExprStmt expr a b),
920 -- this is actually correct
923 rn_rec_stmt_lhs fix_env (L loc (BindStmt pat expr a b))
925 -- should the ctxt be MDo instead?
926 (pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat
927 return [(L loc (BindStmt pat' expr a b),
930 rn_rec_stmt_lhs _ (L _ (LetStmt binds@(HsIPBinds _)))
931 = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
933 rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds)))
934 = do (_bound_names, binds') <- rnValBindsLHS fix_env binds
935 return [(L loc (LetStmt (HsValBinds binds')),
936 -- Warning: this is bogus; see function invariant
940 -- XXX Do we need to do something with the return and mfix names?
941 rn_rec_stmt_lhs fix_env (L _ (RecStmt { recS_stmts = stmts })) -- Flatten Rec inside Rec
942 = rn_rec_stmts_lhs fix_env stmts
944 rn_rec_stmt_lhs _ stmt@(L _ (ParStmt _)) -- Syntactically illegal in mdo
945 = pprPanic "rn_rec_stmt" (ppr stmt)
947 rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt {})) -- Syntactically illegal in mdo
948 = pprPanic "rn_rec_stmt" (ppr stmt)
950 rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt {})) -- Syntactically illegal in mdo
951 = pprPanic "rn_rec_stmt" (ppr stmt)
953 rn_rec_stmt_lhs _ (L _ (LetStmt EmptyLocalBinds))
954 = panic "rn_rec_stmt LetStmt EmptyLocalBinds"
956 rn_rec_stmts_lhs :: MiniFixityEnv
958 -> RnM [(LStmtLR Name RdrName, FreeVars)]
959 rn_rec_stmts_lhs fix_env stmts
960 = do { ls <- concatMapM (rn_rec_stmt_lhs fix_env) stmts
961 ; let boundNames = collectLStmtsBinders (map fst ls)
962 -- First do error checking: we need to check for dups here because we
963 -- don't bind all of the variables from the Stmt at once
964 -- with bindLocatedLocals.
965 ; checkDupNames boundNames
971 rn_rec_stmt :: [Name] -> LStmtLR Name RdrName -> FreeVars -> RnM [Segment (LStmt Name)]
972 -- Rename a Stmt that is inside a RecStmt (or mdo)
973 -- Assumes all binders are already in scope
974 -- Turns each stmt into a singleton Stmt
975 rn_rec_stmt _ (L loc (ExprStmt expr _ _)) _
976 = rnLExpr expr `thenM` \ (expr', fvs) ->
977 lookupSyntaxName thenMName `thenM` \ (then_op, fvs1) ->
978 return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
979 L loc (ExprStmt expr' then_op placeHolderType))]
981 rn_rec_stmt _ (L loc (BindStmt pat' expr _ _)) fv_pat
982 = rnLExpr expr `thenM` \ (expr', fv_expr) ->
983 lookupSyntaxName bindMName `thenM` \ (bind_op, fvs1) ->
984 lookupSyntaxName failMName `thenM` \ (fail_op, fvs2) ->
986 bndrs = mkNameSet (collectPatBinders pat')
987 fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
989 return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
990 L loc (BindStmt pat' expr' bind_op fail_op))]
992 rn_rec_stmt _ (L _ (LetStmt binds@(HsIPBinds _))) _
993 = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
995 rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do
996 (binds', du_binds) <-
997 -- fixities and unused are handled above in rn_rec_stmts_and_then
998 rnValBindsRHS (mkNameSet all_bndrs) binds'
999 return [(duDefs du_binds, allUses du_binds,
1000 emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
1002 -- no RecStmt case becuase they get flattened above when doing the LHSes
1003 rn_rec_stmt _ stmt@(L _ (RecStmt {})) _
1004 = pprPanic "rn_rec_stmt: RecStmt" (ppr stmt)
1006 rn_rec_stmt _ stmt@(L _ (ParStmt {})) _ -- Syntactically illegal in mdo
1007 = pprPanic "rn_rec_stmt: ParStmt" (ppr stmt)
1009 rn_rec_stmt _ stmt@(L _ (TransformStmt {})) _ -- Syntactically illegal in mdo
1010 = pprPanic "rn_rec_stmt: TransformStmt" (ppr stmt)
1012 rn_rec_stmt _ stmt@(L _ (GroupStmt {})) _ -- Syntactically illegal in mdo
1013 = pprPanic "rn_rec_stmt: GroupStmt" (ppr stmt)
1015 rn_rec_stmt _ (L _ (LetStmt EmptyLocalBinds)) _
1016 = panic "rn_rec_stmt: LetStmt EmptyLocalBinds"
1018 rn_rec_stmts :: [Name] -> [(LStmtLR Name RdrName, FreeVars)] -> RnM [Segment (LStmt Name)]
1019 rn_rec_stmts bndrs stmts = mapM (uncurry (rn_rec_stmt bndrs)) stmts `thenM` \ segs_s ->
1020 return (concat segs_s)
1022 ---------------------------------------------
1023 addFwdRefs :: [Segment a] -> [Segment a]
1024 -- So far the segments only have forward refs *within* the Stmt
1025 -- (which happens for bind: x <- ...x...)
1026 -- This function adds the cross-seg fwd ref info
1029 = fst (foldr mk_seg ([], emptyNameSet) pairs)
1031 mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
1032 = (new_seg : segs, all_defs)
1034 new_seg = (defs, uses, new_fwds, stmts)
1035 all_defs = later_defs `unionNameSets` defs
1036 new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
1037 -- Add the downstream fwd refs here
1039 ----------------------------------------------------
1040 -- Glomming the singleton segments of an mdo into
1041 -- minimal recursive groups.
1043 -- At first I thought this was just strongly connected components, but
1044 -- there's an important constraint: the order of the stmts must not change.
1047 -- mdo { x <- ...y...
1054 -- Here, the first stmt mention 'y', which is bound in the third.
1055 -- But that means that the innocent second stmt (p <- z) gets caught
1056 -- up in the recursion. And that in turn means that the binding for
1057 -- 'z' has to be included... and so on.
1059 -- Start at the tail { r <- x }
1060 -- Now add the next one { z <- y ; r <- x }
1061 -- Now add one more { q <- x ; z <- y ; r <- x }
1062 -- Now one more... but this time we have to group a bunch into rec
1063 -- { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
1064 -- Now one more, which we can add on without a rec
1066 -- rec { y <- ...x... ; q <- x ; z <- y } ;
1068 -- Finally we add the last one; since it mentions y we have to
1069 -- glom it togeher with the first two groups
1070 -- { rec { x <- ...y...; p <- z ; y <- ...x... ;
1071 -- q <- x ; z <- y } ;
1074 glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
1076 glomSegments [] = []
1077 glomSegments ((defs,uses,fwds,stmt) : segs)
1078 -- Actually stmts will always be a singleton
1079 = (seg_defs, seg_uses, seg_fwds, seg_stmts) : others
1081 segs' = glomSegments segs
1082 (extras, others) = grab uses segs'
1083 (ds, us, fs, ss) = unzip4 extras
1085 seg_defs = plusFVs ds `plusFV` defs
1086 seg_uses = plusFVs us `plusFV` uses
1087 seg_fwds = plusFVs fs `plusFV` fwds
1088 seg_stmts = stmt : concat ss
1090 grab :: NameSet -- The client
1092 -> ([Segment a], -- Needed by the 'client'
1093 [Segment a]) -- Not needed by the client
1094 -- The result is simply a split of the input
1096 = (reverse yeses, reverse noes)
1098 (noes, yeses) = span not_needed (reverse dus)
1099 not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
1102 ----------------------------------------------------
1103 segsToStmts :: Stmt Name -- A RecStmt with the SyntaxOps filled in
1104 -> [Segment [LStmt Name]]
1105 -> FreeVars -- Free vars used 'later'
1106 -> ([LStmt Name], FreeVars)
1108 segsToStmts _ [] fvs_later = ([], fvs_later)
1109 segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
1110 = ASSERT( not (null ss) )
1111 (new_stmt : later_stmts, later_uses `plusFV` uses)
1113 (later_stmts, later_uses) = segsToStmts empty_rec_stmt segs fvs_later
1114 new_stmt | non_rec = head ss
1115 | otherwise = L (getLoc (head ss)) rec_stmt
1116 rec_stmt = empty_rec_stmt { recS_stmts = ss
1117 , recS_later_ids = nameSetToList used_later
1118 , recS_rec_ids = nameSetToList fwds }
1119 non_rec = isSingleton ss && isEmptyNameSet fwds
1120 used_later = defs `intersectNameSet` later_uses
1121 -- The ones needed after the RecStmt
1124 %************************************************************************
1126 \subsubsection{Assertion utils}
1128 %************************************************************************
1131 srcSpanPrimLit :: SrcSpan -> HsExpr Name
1132 srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDocOneLine (ppr span))))
1134 mkAssertErrorExpr :: RnM (HsExpr Name)
1135 -- Return an expression for (assertError "Foo.hs:27")
1137 = getSrcSpanM `thenM` \ sloc ->
1138 return (HsApp (L sloc (HsVar assertErrorName))
1139 (L sloc (srcSpanPrimLit sloc)))
1142 Note [Adding the implicit parameter to 'assert']
1143 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1144 The renamer transforms (assert e1 e2) to (assert "Foo.hs:27" e1 e2).
1145 By doing this in the renamer we allow the typechecker to just see the
1146 expanded application and do the right thing. But it's not really
1147 the Right Thing because there's no way to "undo" if you want to see
1148 the original source code. We'll have fix this in due course, when
1149 we care more about being able to reconstruct the exact original
1152 %************************************************************************
1154 \subsubsection{Errors}
1156 %************************************************************************
1160 ----------------------
1161 -- Checking when a particular Stmt is ok
1162 checkLetStmt :: HsStmtContext Name -> HsLocalBinds RdrName -> RnM ()
1163 checkLetStmt (ParStmtCtxt _) (HsIPBinds binds) = addErr (badIpBinds (ptext (sLit "a parallel list comprehension:")) binds)
1164 checkLetStmt _ctxt _binds = return ()
1165 -- We do not allow implicit-parameter bindings in a parallel
1166 -- list comprehension. I'm not sure what it might mean.
1169 checkRecStmt :: HsStmtContext Name -> RnM ()
1170 checkRecStmt (MDoExpr {}) = return () -- Recursive stmt ok in 'mdo'
1171 checkRecStmt (DoExpr {}) = return () -- and in 'do'
1172 checkRecStmt ctxt = addErr msg
1174 msg = ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt
1177 checkParStmt :: HsStmtContext Name -> RnM ()
1179 = do { parallel_list_comp <- xoptM Opt_ParallelListComp
1180 ; checkErr parallel_list_comp msg }
1182 msg = ptext (sLit "Illegal parallel list comprehension: use -XParallelListComp")
1185 checkTransformStmt :: HsStmtContext Name -> RnM ()
1186 checkTransformStmt ListComp -- Ensure we are really within a list comprehension because otherwise the
1187 -- desugarer will break when we come to operate on a parallel array
1188 = do { transform_list_comp <- xoptM Opt_TransformListComp
1189 ; checkErr transform_list_comp msg }
1191 msg = ptext (sLit "Illegal transform or grouping list comprehension: use -XTransformListComp")
1192 checkTransformStmt (ParStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension
1193 checkTransformStmt (TransformStmtCtxt ctxt) = checkTransformStmt ctxt -- Ok to nest inside a parallel comprehension
1194 checkTransformStmt ctxt = addErr msg
1196 msg = ptext (sLit "Illegal transform or grouping in") <+> pprStmtContext ctxt
1199 checkTupleSection :: [HsTupArg RdrName] -> RnM ()
1200 checkTupleSection args
1201 = do { tuple_section <- xoptM Opt_TupleSections
1202 ; checkErr (all tupArgPresent args || tuple_section) msg }
1204 msg = ptext (sLit "Illegal tuple section: use -XTupleSections")
1207 sectionErr :: HsExpr RdrName -> SDoc
1209 = hang (ptext (sLit "A section must be enclosed in parentheses"))
1210 2 (ptext (sLit "thus:") <+> (parens (ppr expr)))
1212 patSynErr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
1213 patSynErr e = do { addErr (sep [ptext (sLit "Pattern syntax in expression context:"),
1215 ; return (EWildPat, emptyFVs) }
1217 badIpBinds :: Outputable a => SDoc -> a -> SDoc
1218 badIpBinds what binds
1219 = hang (ptext (sLit "Implicit-parameter bindings illegal in") <+> what)