RnExpr.lhs 44.1 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 4 5 6 7
%
\section[RnExpr]{Renaming of expressions}

Basically dependency analysis.

8
Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
9 10 11 12
general, all of these functions return a renamed thing, and a set of
free variables.

\begin{code}
13
{-# OPTIONS -w #-}
14 15 16
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
17
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
18 19
-- for details

20
module RnExpr (
21
	rnLExpr, rnExpr, rnStmts
22 23
   ) where

24 25
#include "HsVersions.h"

26 27 28 29
#ifdef GHCI
import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
#endif 	/* GHCI */

30
import RnSource  ( rnSrcDecls, rnSplice, checkTH ) 
31 32
import RnBinds   ( rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS,
                   rnMatchGroup, makeMiniFixityEnv) 
33
import HsSyn
34
import TcRnMonad
35
import RnEnv
36
import HscTypes         ( availNames )
37 38
import RnTypes		( rnHsTypeFVs, 
			  mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
39
import RnPat            (rnQuasiQuote, rnOverLit, rnPatsAndThen_LocalRightwards, rnBindPat,
40
                         localRecNameMaker, rnLit,
41
			 rnHsRecFields_Con, rnHsRecFields_Update, checkTupSize)
42
import RdrName      ( mkRdrUnqual )
43 44
import DynFlags		( DynFlag(..) )
import BasicTypes	( FixityDirection(..) )
45
import SrcLoc           ( SrcSpan )
46
import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
47
			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
48
			  negateName, thenMName, bindMName, failMName, groupWithName )
mnislaih's avatar
mnislaih committed
49

50
import Name		( Name, nameOccName, nameModule, nameIsLocalOrFrom )
51
import NameSet
52
import LazyUniqFM
53
import RdrName		( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
Simon Marlow's avatar
Simon Marlow committed
54
import LoadIface	( loadInterfaceForName )
55
import UniqSet		( isEmptyUniqSet, emptyUniqSet )
56
import List		( nub )
57
import Util		( isSingleton )
58
import ListSetOps	( removeDups )
59
import Maybes		( expectJust )
sof's avatar
sof committed
60
import Outputable
61
import SrcLoc		( Located(..), unLoc, getLoc, noLoc )
62
import FastString
63 64

import List		( unzip4 )
Ian Lynagh's avatar
Ian Lynagh committed
65
import Control.Monad
66 67 68
\end{code}


Ian Lynagh's avatar
Ian Lynagh committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
\begin{code}
-- XXX
thenM :: Monad a => a b -> (b -> a c) -> a c
thenM = (>>=)

thenM_ :: Monad a => a b -> a c -> a c
thenM_ = (>>)

returnM :: Monad m => a -> m a
returnM = return

mappM :: (Monad m) => (a -> m b) -> [a] -> m [b]
mappM = mapM

mappM_ :: (Monad m) => (a -> m b) -> [a] -> m ()
mappM_ = mapM_

checkM :: Monad m => Bool -> m () -> m ()
checkM = unless
\end{code}

90 91 92 93 94 95 96
%************************************************************************
%*									*
\subsubsection{Expressions}
%*									*
%************************************************************************

\begin{code}
97
rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
sof's avatar
sof committed
98 99
rnExprs ls = rnExprs' ls emptyUniqSet
 where
100
  rnExprs' [] acc = returnM ([], acc)
sof's avatar
sof committed
101
  rnExprs' (expr:exprs) acc
102
   = rnLExpr expr 	        `thenM` \ (expr', fvExpr) ->
sof's avatar
sof committed
103 104 105 106

	-- Now we do a "seq" on the free vars because typically it's small
	-- or empty, especially in very long lists of constants
    let
107
	acc' = acc `plusFV` fvExpr
sof's avatar
sof committed
108
    in
109 110
    (grubby_seqNameSet acc' rnExprs') exprs acc'	`thenM` \ (exprs', fvExprs) ->
    returnM (expr':exprs', fvExprs)
sof's avatar
sof committed
111 112

-- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
113
grubby_seqNameSet ns result | isEmptyUniqSet ns = result
sof's avatar
sof committed
114
			    | otherwise    = result
115 116
\end{code}

117
Variables. We look up the variable and return the resulting name. 
118 119

\begin{code}
120 121 122 123
rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
rnLExpr = wrapLocFstM rnExpr

rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
124 125

rnExpr (HsVar v)
126 127
  = do name           <- lookupOccRn v
       ignore_asserts <- doptM Opt_IgnoreAsserts
128 129 130 131 132 133 134 135
       finish_var ignore_asserts name
  where
    finish_var ignore_asserts name
	| ignore_asserts || not (name `hasKey` assertIdKey)
	= return (HsVar name, unitFV name)
  	| otherwise
	= do { (e, fvs) <- mkAssertErrorExpr
             ; return (e, fvs `addOneFV` name) }
136

137
rnExpr (HsIPVar v)
138 139
  = newIPNameRn v		`thenM` \ name ->
    returnM (HsIPVar name, emptyFVs)
140

141 142 143 144
rnExpr (HsLit lit@(HsString s))
  = do {
         opt_OverloadedStrings <- doptM Opt_OverloadedStrings
       ; if opt_OverloadedStrings then
145
            rnExpr (HsOverLit (mkHsIsString s placeHolderType))
146 147 148 149 150
	 else -- Same as below
	    rnLit lit		`thenM_`
            returnM (HsLit lit, emptyFVs)
       }

151
rnExpr (HsLit lit) 
152 153
  = rnLit lit		`thenM_`
    returnM (HsLit lit, emptyFVs)
154

155
rnExpr (HsOverLit lit) 
156 157
  = rnOverLit lit		`thenM` \ (lit', fvs) ->
    returnM (HsOverLit lit', fvs)
158

159
rnExpr (HsApp fun arg)
160 161
  = rnLExpr fun		`thenM` \ (fun',fvFun) ->
    rnLExpr arg		`thenM` \ (arg',fvArg) ->
162
    returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
163

164
rnExpr (OpApp e1 op _ e2) 
165 166 167
  = rnLExpr e1				`thenM` \ (e1', fv_e1) ->
    rnLExpr e2				`thenM` \ (e2', fv_e2) ->
    rnLExpr op				`thenM` \ (op'@(L _ (HsVar op_name)), fv_op) ->
168

sof's avatar
sof committed
169 170
	-- Deal with fixity
	-- When renaming code synthesised from "deriving" declarations
171 172 173 174 175
	-- we used to avoid fixity stuff, but we can't easily tell any
	-- more, so I've removed the test.  Adding HsPars in TcGenDeriv
	-- should prevent bad things happening.
    lookupFixityRn op_name		`thenM` \ fixity ->
    mkOpAppRn e1' op' fixity e2'	`thenM` \ final_e -> 
176

177
    returnM (final_e,
178
	      fv_e1 `plusFV` fv_op `plusFV` fv_e2)
179

180
rnExpr (NegApp e _)
181
  = rnLExpr e			`thenM` \ (e', fv_e) ->
182 183 184
    lookupSyntaxName negateName	`thenM` \ (neg_name, fv_neg) ->
    mkNegAppRn e' neg_name	`thenM` \ final_e ->
    returnM (final_e, fv_e `plusFV` fv_neg)
185 186

rnExpr (HsPar e)
187
  = rnLExpr e 		`thenM` \ (e', fvs_e) ->
188 189 190
    returnM (HsPar e', fvs_e)

-- Template Haskell extensions
191 192
-- Don't ifdef-GHCI them because we want to fail gracefully
-- (not with an rnExpr crash) in a stage-1 compiler.
193 194
rnExpr e@(HsBracket br_body)
  = checkTH e "bracket"		`thenM_`
195
    rnBracket br_body		`thenM` \ (body', fvs_e) ->
196
    returnM (HsBracket body', fvs_e)
197

198 199 200
rnExpr e@(HsSpliceE splice)
  = rnSplice splice 		`thenM` \ (splice', fvs) ->
    returnM (HsSpliceE splice', fvs)
201

202 203 204 205 206 207 208 209 210 211
#ifndef GHCI
rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
#else
rnExpr e@(HsQuasiQuoteE qq)
  = rnQuasiQuote qq 		`thenM` \ (qq', fvs_qq) ->
    runQuasiQuoteExpr qq'	`thenM` \ (L _ expr') ->
    rnExpr expr'		`thenM` \ (expr'', fvs_expr) ->
    returnM (expr'', fvs_qq `plusFV` fvs_expr)
#endif 	/* GHCI */

212
rnExpr section@(SectionL expr op)
213 214
  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
    rnLExpr op	 		`thenM` \ (op', fvs_op) ->
215 216
    checkSectionPrec InfixL section op' expr' `thenM_`
    returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
217

218
rnExpr section@(SectionR op expr)
219 220
  = rnLExpr op	 				`thenM` \ (op',   fvs_op) ->
    rnLExpr expr	 				`thenM` \ (expr', fvs_expr) ->
221 222
    checkSectionPrec InfixR section op' expr'	`thenM_`
    returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
223

224
rnExpr (HsCoreAnn ann expr)
225
  = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
226 227
    returnM (HsCoreAnn ann expr', fvs_expr)

228
rnExpr (HsSCC lbl expr)
229
  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
230
    returnM (HsSCC lbl expr', fvs_expr)
andy@galois.com's avatar
andy@galois.com committed
231 232 233
rnExpr (HsTickPragma info expr)
  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
    returnM (HsTickPragma info expr', fvs_expr)
234

235 236 237 238 239
rnExpr (HsLam matches)
  = rnMatchGroup LambdaExpr matches	`thenM` \ (matches', fvMatch) ->
    returnM (HsLam matches', fvMatch)

rnExpr (HsCase expr matches)
240
  = rnLExpr expr		 	`thenM` \ (new_expr, e_fvs) ->
241 242
    rnMatchGroup CaseAlt matches	`thenM` \ (new_matches, ms_fvs) ->
    returnM (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
243 244

rnExpr (HsLet binds expr)
245
  = rnLocalBindsAndThen binds		$ \ binds' ->
246
    rnLExpr expr			 `thenM` \ (expr',fvExpr) ->
247
    returnM (HsLet binds' expr', fvExpr)
248

249 250 251 252
rnExpr e@(HsDo do_or_lc stmts body _)
  = do 	{ ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
				    rnLExpr body
	; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
253

254
rnExpr (ExplicitList _ exps)
255
  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
256
    returnM  (ExplicitList placeHolderType exps', fvs)
257

chak's avatar
chak committed
258
rnExpr (ExplicitPArr _ exps)
259
  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
260
    returnM  (ExplicitPArr placeHolderType exps', fvs)
chak's avatar
chak committed
261

262
rnExpr e@(ExplicitTuple exps boxity)
263
  = checkTupSize (length exps)			`thenM_`
264
    rnExprs exps	 			`thenM` \ (exps', fvs) ->
265
    returnM (ExplicitTuple exps' boxity, fvs)
266

267 268
rnExpr (RecordCon con_id _ rbinds)
  = do	{ conname <- lookupLocatedOccRn con_id
269
	; (rbinds', fvRbinds) <- rnHsRecFields_Con conname rnLExpr rbinds
270 271
	; return (RecordCon conname noPostTcExpr rbinds', 
		  fvRbinds `addOneFV` unLoc conname) }
272

273 274
rnExpr (RecordUpd expr rbinds _ _ _)
  = do	{ (expr', fvExpr) <- rnLExpr expr
275
	; (rbinds', fvRbinds) <- rnHsRecFields_Update rnLExpr rbinds
276 277
	; return (RecordUpd expr' rbinds' [] [] [], 
		  fvExpr `plusFV` fvRbinds) }
278 279

rnExpr (ExprWithTySig expr pty)
280 281 282 283
  = do	{ (pty', fvTy) <- rnHsTypeFVs doc pty
	; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
		  	     rnLExpr expr
	; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
284 285
  where 
    doc = text "In an expression type signature"
286

287 288 289 290 291
rnExpr (HsIf p b1 b2)
  = rnLExpr p		`thenM` \ (p', fvP) ->
    rnLExpr b1		`thenM` \ (b1', fvB1) ->
    rnLExpr b2		`thenM` \ (b2', fvB2) ->
    returnM (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
292

293
rnExpr (HsType a)
294 295
  = rnHsTypeFVs doc a	`thenM` \ (t, fvT) -> 
    returnM (HsType t, fvT)
296
  where 
297
    doc = text "In a type argument"
298

299
rnExpr (ArithSeq _ seq)
300
  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
301
    returnM (ArithSeq noPostTcExpr new_seq, fvs)
chak's avatar
chak committed
302

303
rnExpr (PArrSeq _ seq)
304
  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
305
    returnM (PArrSeq noPostTcExpr new_seq, fvs)
306
\end{code}
307

308 309 310 311 312
These three are pattern syntax appearing in expressions.
Since all the symbols are reservedops we can simply reject them.
We return a (bogus) EWildPat in each case.

\begin{code}
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
313 314
rnExpr e@EWildPat      = patSynErr e
rnExpr e@(EAsPat {})   = patSynErr e
315
rnExpr e@(EViewPat {}) = patSynErr e
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
316
rnExpr e@(ELazyPat {}) = patSynErr e
317 318
\end{code}

319 320 321 322 323 324 325
%************************************************************************
%*									*
	Arrow notation
%*									*
%************************************************************************

\begin{code}
326
rnExpr (HsProc pat body)
ross's avatar
ross committed
327
  = newArrowScope $
328
    rnPatsAndThen_LocalRightwards ProcExpr [pat] $ \ [pat'] ->
329
    rnCmdTop body	         `thenM` \ (body',fvBody) ->
330
    returnM (HsProc pat' body', fvBody)
331

332
rnExpr (HsArrApp arrow arg _ ho rtl)
ross's avatar
ross committed
333 334
  = select_arrow_scope (rnLExpr arrow)	`thenM` \ (arrow',fvArrow) ->
    rnLExpr arg				`thenM` \ (arg',fvArg) ->
335
    returnM (HsArrApp arrow' arg' placeHolderType ho rtl,
336
	     fvArrow `plusFV` fvArg)
ross's avatar
ross committed
337 338 339 340
  where
    select_arrow_scope tc = case ho of
        HsHigherOrderApp -> tc
        HsFirstOrderApp  -> escapeArrowScope tc
341 342

-- infix form
343
rnExpr (HsArrForm op (Just _) [arg1, arg2])
ross's avatar
ross committed
344 345
  = escapeArrowScope (rnLExpr op)
			`thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
346 347 348 349 350 351 352 353 354 355 356
    rnCmdTop arg1	`thenM` \ (arg1',fv_arg1) ->
    rnCmdTop arg2	`thenM` \ (arg2',fv_arg2) ->

	-- Deal with fixity

    lookupFixityRn op_name		`thenM` \ fixity ->
    mkOpFormRn arg1' op' fixity arg2'	`thenM` \ final_e -> 

    returnM (final_e,
	      fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)

357
rnExpr (HsArrForm op fixity cmds)
ross's avatar
ross committed
358 359
  = escapeArrowScope (rnLExpr op)	`thenM` \ (op',fvOp) ->
    rnCmdArgs cmds			`thenM` \ (cmds',fvCmds) ->
360
    returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
361

362
rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
363
	-- HsWrap
364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
\end{code}


%************************************************************************
%*									*
	Arrow commands
%*									*
%************************************************************************

\begin{code}
rnCmdArgs [] = returnM ([], emptyFVs)
rnCmdArgs (arg:args)
  = rnCmdTop arg	`thenM` \ (arg',fvArg) ->
    rnCmdArgs args	`thenM` \ (args',fvArgs) ->
    returnM (arg':args', fvArg `plusFV` fvArgs)

380 381 382 383 384 385

rnCmdTop = wrapLocFstM rnCmdTop'
 where
  rnCmdTop' (HsCmdTop cmd _ _ _) 
   = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
     let 
386
	cmd_names = [arrAName, composeAName, firstAName] ++
387 388
		    nameSetToList (methodNamesCmd (unLoc cmd'))
     in
389
	-- Generate the rebindable syntax for the monad
390
     lookupSyntaxTable cmd_names	`thenM` \ (cmd_names', cmd_fvs) ->
391

392
     returnM (HsCmdTop cmd' [] placeHolderType cmd_names', 
393 394 395 396 397
	     fvCmd `plusFV` cmd_fvs)

---------------------------------------------------
-- convert OpApp's in a command context to HsArrForm's

398 399 400
convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
convertOpFormsLCmd = fmap convertOpFormsCmd

401 402
convertOpFormsCmd :: HsCmd id -> HsCmd id

403
convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
404 405 406
convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
convertOpFormsCmd (OpApp c1 op fixity c2)
  = let
407 408
	arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
	arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
409
    in
410
    HsArrForm op (Just fixity) [arg1, arg2]
411

412
convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
413

414
convertOpFormsCmd (HsCase exp matches)
415
  = HsCase exp (convertOpFormsMatch matches)
416

417 418
convertOpFormsCmd (HsIf exp c1 c2)
  = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
419 420

convertOpFormsCmd (HsLet binds cmd)
421
  = HsLet binds (convertOpFormsLCmd cmd)
422

423 424 425
convertOpFormsCmd (HsDo ctxt stmts body ty)
  = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
	      (convertOpFormsLCmd body) ty
426 427 428 429 430 431

-- Anything else is unchanged.  This includes HsArrForm (already done),
-- things with no sub-commands, and illegal commands (which will be
-- caught by the type checker)
convertOpFormsCmd c = c

432 433 434 435 436 437
convertOpFormsStmt (BindStmt pat cmd _ _)
  = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
convertOpFormsStmt (ExprStmt cmd _ _)
  = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
convertOpFormsStmt (RecStmt stmts lvs rvs es binds)
  = RecStmt (map (fmap convertOpFormsStmt) stmts) lvs rvs es binds
438 439
convertOpFormsStmt stmt = stmt

440 441
convertOpFormsMatch (MatchGroup ms ty)
  = MatchGroup (map (fmap convert) ms) ty
442 443
 where convert (Match pat mty grhss)
	  = Match pat mty (convertOpFormsGRHSs grhss)
444

445 446
convertOpFormsGRHSs (GRHSs grhss binds)
  = GRHSs (map convertOpFormsGRHS grhss) binds
447

448
convertOpFormsGRHS = fmap convert
449 450
 where 
   convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
451 452 453 454 455 456

---------------------------------------------------
type CmdNeeds = FreeVars	-- Only inhabitants are 
				-- 	appAName, choiceAName, loopAName

-- find what methods the Cmd needs (loop, choice, apply)
457 458 459
methodNamesLCmd :: LHsCmd Name -> CmdNeeds
methodNamesLCmd = methodNamesCmd . unLoc

460 461
methodNamesCmd :: HsCmd Name -> CmdNeeds

462
methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
463
  = emptyFVs
464
methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
465 466 467
  = unitFV appAName
methodNamesCmd cmd@(HsArrForm {}) = emptyFVs

468
methodNamesCmd (HsPar c) = methodNamesLCmd c
469

470 471
methodNamesCmd (HsIf p c1 c2)
  = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
472

473
methodNamesCmd (HsLet b c) = methodNamesLCmd c
474

475 476
methodNamesCmd (HsDo sc stmts body ty) 
  = methodNamesStmts stmts `plusFV` methodNamesLCmd body
477

478
methodNamesCmd (HsApp c e) = methodNamesLCmd c
ross's avatar
ross committed
479

480 481
methodNamesCmd (HsLam match) = methodNamesMatch match

482
methodNamesCmd (HsCase scrut matches)
483
  = methodNamesMatch matches `addOneFV` choiceAName
484 485 486 487 488 489 490

methodNamesCmd other = emptyFVs
   -- Other forms can't occur in commands, but it's not convenient 
   -- to error here so we just do what's convenient.
   -- The type checker will complain later

---------------------------------------------------
491
methodNamesMatch (MatchGroup ms _)
492 493 494
  = plusFVs (map do_one ms)
 where 
    do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss
495 496

-------------------------------------------------
497 498
-- gaw 2004
methodNamesGRHSs (GRHSs grhss binds) = plusFVs (map methodNamesGRHS grhss)
499 500

-------------------------------------------------
501
methodNamesGRHS (L _ (GRHS stmts rhs)) = methodNamesLCmd rhs
502 503

---------------------------------------------------
504
methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
505 506

---------------------------------------------------
507 508
methodNamesLStmt = methodNamesStmt . unLoc

509 510 511
methodNamesStmt (ExprStmt cmd _ _)     = methodNamesLCmd cmd
methodNamesStmt (BindStmt pat cmd _ _) = methodNamesLCmd cmd
methodNamesStmt (RecStmt stmts _ _ _ _)
512 513 514
  = methodNamesStmts stmts `addOneFV` loopAName
methodNamesStmt (LetStmt b)  = emptyFVs
methodNamesStmt (ParStmt ss) = emptyFVs
515 516 517
methodNamesStmt (TransformStmt _ _ _) = emptyFVs
methodNamesStmt (GroupStmt _ _) = emptyFVs
   -- ParStmt, TransformStmt and GroupStmt can't occur in commands, but it's not convenient to error 
518 519 520 521
   -- here so we just do what's convenient
\end{code}


522 523 524 525 526 527 528 529
%************************************************************************
%*									*
	Arithmetic sequences
%*									*
%************************************************************************

\begin{code}
rnArithSeq (From expr)
530
 = rnLExpr expr 	`thenM` \ (expr', fvExpr) ->
531 532 533
   returnM (From expr', fvExpr)

rnArithSeq (FromThen expr1 expr2)
534 535
 = rnLExpr expr1 	`thenM` \ (expr1', fvExpr1) ->
   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
536 537 538
   returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)

rnArithSeq (FromTo expr1 expr2)
539 540
 = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
541 542 543
   returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)

rnArithSeq (FromThenTo expr1 expr2 expr3)
544 545 546
 = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
   rnLExpr expr3	`thenM` \ (expr3', fvExpr3) ->
547 548 549
   returnM (FromThenTo expr1' expr2' expr3',
	    plusFVs [fvExpr1, fvExpr2, fvExpr3])
\end{code}
550

551 552 553 554 555
%************************************************************************
%*									*
	Template Haskell brackets
%*									*
%************************************************************************
556

557
\begin{code}
558
rnBracket (VarBr n) = do { name <- lookupOccRn n
559 560
			 ; this_mod <- getModule
			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
Simon Marlow's avatar
Simon Marlow committed
561
			   do { loadInterfaceForName msg name		-- home interface is loaded, and this is the
562
			      ; return () }				-- only way that is going to happen
563 564 565 566 567 568
			 ; returnM (VarBr name, unitFV name) }
		    where
		      msg = ptext SLIT("Need interface for Template Haskell quoted Name")

rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
			 ; return (ExpBr e', fvs) }
569 570 571 572

rnBracket (PatBr p) = do { addErr (ptext SLIT("Tempate Haskell pattern brackets are not supported yet"));
                           failM }

573 574
rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
			 ; return (TypBr t', fvs) }
575 576
		    where
		      doc = ptext SLIT("In a Template-Haskell quoted type")
577
rnBracket (DecBr group) 
578 579 580 581 582 583 584 585 586 587 588 589
  = do { gbl_env  <- getGblEnv

	; let new_gbl_env = gbl_env { -- Set the module to thFAKE.  The top-level names from the bracketed 
	                              -- declarations will go into the name cache, and we don't want them to 
	                              -- confuse the Names for the current module.  
	                              -- By using a pretend module, thFAKE, we keep them safely out of the way.
                                     tcg_mod = thFAKE,
                        
                                     -- The emptyDUs is so that we just collect uses for this group alone
                                     -- in the call to rnSrcDecls below
                                     tcg_dus = emptyDUs }
       ; setGblEnv new_gbl_env $ do {
590 591

	-- In this situation we want to *shadow* top-level bindings.
592
	--	foo = 1
593
	--	bar = [d| foo = 1 |]
594 595 596 597 598 599
	-- If we don't shadow, we'll get an ambiguity complaint when we do 
	-- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
	--
	-- Furthermore, arguably if the splice does define foo, that should hide
	-- any foo's further out
	--
600 601
	-- The shadowing is acheived by calling rnSrcDecls with True as the shadowing flag
       ; (tcg_env, group') <- rnSrcDecls True group       
602

603
       -- Discard the tcg_env; it contains only extra info about fixity
604
	; return (DecBr group', allUses (tcg_dus tcg_env)) } }
605 606
\end{code}

607 608
%************************************************************************
%*									*
609
\subsubsection{@Stmt@s: in @do@ expressions}
610 611 612 613
%*									*
%************************************************************************

\begin{code}
614 615 616
rnStmts :: HsStmtContext Name -> [LStmt RdrName] 
	-> RnM (thing, FreeVars)
	-> RnM (([LStmt Name], thing), FreeVars)
617

618 619
rnStmts (MDoExpr _) = rnMDoStmts
rnStmts ctxt        = rnNormalStmts ctxt
620

621 622 623
rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
	      -> RnM (thing, FreeVars)
	      -> RnM (([LStmt Name], thing), FreeVars)	
624 625 626
-- Used for cases *other* than recursive mdo
-- Implements nested scopes

627
rnNormalStmts ctxt [] thing_inside 
628
  = do { (thing, fvs) <- thing_inside
629
	; return (([],thing), fvs) } 
630

631
rnNormalStmts ctxt (L loc stmt : stmts) thing_inside
632 633
  = do { ((stmt', (stmts', thing)), fvs) <- rnStmt ctxt stmt $
            rnNormalStmts ctxt stmts thing_inside
634
	; return (((L loc stmt' : stmts'), thing), fvs) }
635 636


637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652
rnStmt :: HsStmtContext Name -> Stmt RdrName
       -> RnM (thing, FreeVars)
       -> RnM ((Stmt Name, thing), FreeVars)

rnStmt ctxt (ExprStmt expr _ _) thing_inside
  = do	{ (expr', fv_expr) <- rnLExpr expr
	; (then_op, fvs1)  <- lookupSyntaxName thenMName
	; (thing, fvs2)    <- thing_inside
	; return ((ExprStmt expr' then_op placeHolderType, thing),
		  fv_expr `plusFV` fvs1 `plusFV` fvs2) }

rnStmt ctxt (BindStmt pat expr _ _) thing_inside
  = do	{ (expr', fv_expr) <- rnLExpr expr
		-- The binders do not scope over the expression
	; (bind_op, fvs1) <- lookupSyntaxName bindMName
	; (fail_op, fvs2) <- lookupSyntaxName failMName
653
	; rnPatsAndThen_LocalRightwards (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
654 655 656
	{ (thing, fvs3) <- thing_inside
	; return ((BindStmt pat' expr' bind_op fail_op, thing),
		  fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
657
       -- fv_expr shouldn't really be filtered by the rnPatsAndThen
658
	-- but it does not matter because the names are unique
659

660 661 662 663 664
rnStmt ctxt (LetStmt binds) thing_inside 
  = do	{ checkLetStmt ctxt binds
	; rnLocalBindsAndThen binds $ \binds' -> do
	{ (thing, fvs) <- thing_inside
        ; return ((LetStmt binds', thing), fvs) }  }
665

666
rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682
  = do	{ checkRecStmt ctxt
	; rn_rec_stmts_and_then rec_stmts	$ \ segs -> do
	{ (thing, fvs) <- thing_inside
	; let
	    segs_w_fwd_refs          = addFwdRefs segs
	    (ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
	    later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
	    fwd_vars   = nameSetToList (plusFVs fs)
	    uses       = plusFVs us
	    rec_stmt   = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
	; return ((rec_stmt, thing), uses `plusFV` fvs) } }

rnStmt ctxt (ParStmt segs) thing_inside
  = do	{ checkParStmt ctxt
	; ((segs', thing), fvs) <- rnParallelStmts (ParStmtCtxt ctxt) segs thing_inside
	; return ((ParStmt segs', thing), fvs) }
683

684
rnStmt ctxt (TransformStmt (stmts, _) usingExpr maybeByExpr) thing_inside = do
685
    checkTransformStmt ctxt
686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702
    
    (usingExpr', fv_usingExpr) <- rnLExpr usingExpr
    ((stmts', binders, (maybeByExpr', thing)), fvs) <- 
        rnNormalStmtsAndFindUsedBinders (TransformStmtCtxt ctxt) stmts $ \unshadowed_bndrs -> do
            (maybeByExpr', fv_maybeByExpr)  <- rnMaybeLExpr maybeByExpr
            (thing, fv_thing)               <- thing_inside
            
            return ((maybeByExpr', thing), fv_maybeByExpr `plusFV` fv_thing)
    
    return ((TransformStmt (stmts', binders) usingExpr' maybeByExpr', thing), fv_usingExpr `plusFV` fvs)
  where
    rnMaybeLExpr Nothing = return (Nothing, emptyFVs)
    rnMaybeLExpr (Just expr) = do
        (expr', fv_expr) <- rnLExpr expr
        return (Just expr', fv_expr)
        
rnStmt ctxt (GroupStmt (stmts, _) groupByClause) thing_inside = do
703
    checkTransformStmt ctxt
704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818
    
    -- We must rename the using expression in the context before the transform is begun
    groupByClauseAction <- 
        case groupByClause of
            GroupByNothing usingExpr -> do
                (usingExpr', fv_usingExpr) <- rnLExpr usingExpr
                (return . return) (GroupByNothing usingExpr', fv_usingExpr)
            GroupBySomething eitherUsingExpr byExpr -> do
                (eitherUsingExpr', fv_eitherUsingExpr) <- 
                    case eitherUsingExpr of
                        Right _ -> return (Right $ HsVar groupWithName, unitNameSet groupWithName)
                        Left usingExpr -> do
                            (usingExpr', fv_usingExpr) <- rnLExpr usingExpr
                            return (Left usingExpr', fv_usingExpr)
                            
                return $ do
                    (byExpr', fv_byExpr) <- rnLExpr byExpr
                    return (GroupBySomething eitherUsingExpr' byExpr', fv_eitherUsingExpr `plusFV` fv_byExpr)
    
    -- We only use rnNormalStmtsAndFindUsedBinders to get unshadowed_bndrs, so
    -- perhaps we could refactor this to use rnNormalStmts directly?
    ((stmts', _, (groupByClause', usedBinderMap, thing)), fvs) <- 
        rnNormalStmtsAndFindUsedBinders (TransformStmtCtxt ctxt) stmts $ \unshadowed_bndrs -> do
            (groupByClause', fv_groupByClause) <- groupByClauseAction
            
            unshadowed_bndrs' <- mapM newLocalName unshadowed_bndrs
            let binderMap = zip unshadowed_bndrs unshadowed_bndrs'
            
            -- Bind the "thing" inside a context where we have REBOUND everything
            -- bound by the statements before the group. This is necessary since after
            -- the grouping the same identifiers actually have different meanings
            -- i.e. they refer to lists not singletons!
            (thing, fv_thing) <- bindLocalNames unshadowed_bndrs' thing_inside
            
            -- We remove entries from the binder map that are not used in the thing_inside.
            -- We can then use that usage information to ensure that the free variables do 
            -- not contain the things we just bound, but do contain the things we need to
            -- make those bindings (i.e. the corresponding non-listy variables)
            
            -- Note that we also retain those entries which have an old binder in our
            -- own free variables (the using or by expression). This is because this map
            -- is reused in the desugarer to create the type to bind from the statements
            -- that occur before this one. If the binders we need are not in the map, they
            -- will never get bound into our desugared expression and hence the simplifier
            -- crashes as we refer to variables that don't exist!
            let usedBinderMap = filter 
                    (\(old_binder, new_binder) -> 
                        (new_binder `elemNameSet` fv_thing) || 
                        (old_binder `elemNameSet` fv_groupByClause)) binderMap
                (usedOldBinders, usedNewBinders) = unzip usedBinderMap
                real_fv_thing = (delListFromNameSet fv_thing usedNewBinders) `plusFV` (mkNameSet usedOldBinders)
            
            return ((groupByClause', usedBinderMap, thing), fv_groupByClause `plusFV` real_fv_thing)
    
    traceRn (text "rnStmt: implicitly rebound these used binders:" <+> ppr usedBinderMap)
    return ((GroupStmt (stmts', usedBinderMap) groupByClause', thing), fvs)
  
rnNormalStmtsAndFindUsedBinders :: HsStmtContext Name 
          -> [LStmt RdrName]
          -> ([Name] -> RnM (thing, FreeVars))
          -> RnM (([LStmt Name], [Name], thing), FreeVars)	
rnNormalStmtsAndFindUsedBinders ctxt stmts thing_inside = do
    ((stmts', (used_bndrs, inner_thing)), fvs) <- rnNormalStmts ctxt stmts $ do
        -- Find the Names that are bound by stmts that
        -- by assumption we have just renamed
        local_env <- getLocalRdrEnv
        let 
            stmts_binders = collectLStmtsBinders stmts
            bndrs = map (expectJust "rnStmt"
                        . lookupLocalRdrEnv local_env
                        . unLoc) stmts_binders
                        
            -- If shadow, we'll look up (Unqual x) twice, getting
            -- the second binding both times, which is the
            -- one we want
            unshadowed_bndrs = nub bndrs
                        
        -- Typecheck the thing inside, passing on all 
        -- the Names bound before it for its information
        (thing, fvs) <- thing_inside unshadowed_bndrs

        -- Figure out which of the bound names are used
        -- after the statements we renamed
        let used_bndrs = filter (`elemNameSet` fvs) bndrs
        return ((used_bndrs, thing), fvs)

    -- Flatten the tuple returned by the above call a bit!
    return ((stmts', used_bndrs, inner_thing), fvs)


rnParallelStmts ctxt segs thing_inside = do
        orig_lcl_env <- getLocalRdrEnv
        go orig_lcl_env [] segs
    where
        go orig_lcl_env bndrs [] = do 
            let (bndrs', dups) = removeDups cmpByOcc bndrs
                inner_env = extendLocalRdrEnv orig_lcl_env bndrs'
            
            mappM dupErr dups
            (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
            return (([], thing), fvs)

        go orig_lcl_env bndrs_so_far ((stmts, _) : segs) = do 
            ((stmts', bndrs, (segs', thing)), fvs) <- rnNormalStmtsAndFindUsedBinders ctxt stmts $ \new_bndrs -> do
                -- Typecheck the thing inside, passing on all
                -- the Names bound, but separately; revert the envt
                setLocalRdrEnv orig_lcl_env $ do
                    go orig_lcl_env (new_bndrs ++ bndrs_so_far) segs

            let seg' = (stmts', bndrs)
            return (((seg':segs'), thing), delListFromNameSet fvs bndrs)

        cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
        dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
                    <+> quotes (ppr (head vs)))
819 820 821 822 823
\end{code}


%************************************************************************
%*									*
824
\subsubsection{mdo expressions}
825 826
%*									*
%************************************************************************
827

828
\begin{code}
829
type FwdRefs = NameSet
830 831 832
type Segment stmts = (Defs,
		      Uses, 	-- May include defs
		      FwdRefs,	-- A subset of uses that are 
833 834
				--   (a) used before they are bound in this segment, or 
				--   (b) used here, and bound in subsequent segments
835 836
		      stmts)	-- Either Stmt or [Stmt]

837

838
----------------------------------------------------
839

840 841 842 843
rnMDoStmts :: [LStmt RdrName]
	   -> RnM (thing, FreeVars)
	   -> RnM (([LStmt Name], thing), FreeVars)	
rnMDoStmts stmts thing_inside
844 845 846 847 848 849 850 851 852 853
  =    -- Step1: Bring all the binders of the mdo into scope
	-- (Remember that this also removes the binders from the
	-- finally-returned free-vars.)
   	-- And rename each individual stmt, making a
	-- singleton segment.  At this stage the FwdRefs field
	-- isn't finished: it's empty for all except a BindStmt
	-- for which it's the fwd refs within the bind itself
	-- (This set may not be empty, because we're in a recursive 
	-- context.)
     rn_rec_stmts_and_then stmts $ \ segs -> do {
854 855 856 857

	; (thing, fvs_later) <- thing_inside

	; let
858
	-- Step 2: Fill in the fwd refs.
859 860 861
	-- 	   The segments are all singletons, but their fwd-ref
	--	   field mentions all the things used by the segment
	--	   that are bound after their use
862
	    segs_w_fwd_refs = addFwdRefs segs
863

864
	-- Step 3: Group together the segments to make bigger segments
865 866
	--	   Invariant: in the result, no segment uses a variable
	--	   	      bound in a later segment
867
	    grouped_segs = glomSegments segs_w_fwd_refs
868

869
	-- Step 4: Turn the segments into Stmts
870 871 872 873
	--	   Use RecStmt when and only when there are fwd refs
	--	   Also gather up the uses from the end towards the
	--	   start, so we can tell the RecStmt which things are
	--	   used 'after' the RecStmt
874
	    (stmts', fvs) = segsToStmts grouped_segs fvs_later
875

876 877
	; return ((stmts', thing), fvs) }
  where
878
    doc = text "In a recursive mdo-expression"
879

880
---------------------------------------------
881

882 883 884 885 886 887
-- wrapper that does both the left- and right-hand sides
rn_rec_stmts_and_then :: [LStmt RdrName]
                         -- assumes that the FreeVars returned includes
                         -- the FreeVars of the Segments
                      -> ([Segment (LStmt Name)] -> RnM (a, FreeVars))
                      -> RnM (a, FreeVars)
888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903
rn_rec_stmts_and_then s cont
  = do	{ -- (A) Make the mini fixity env for all of the stmts
	  fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)

	  -- (B) Do the LHSes
	; new_lhs_and_fv <- rn_rec_stmts_lhs fix_env s

	  --    ...bring them and their fixities into scope
	; let bound_names = map unLoc $ collectLStmtsBinders (map fst new_lhs_and_fv)
	; bindLocalNamesFV_WithFixities bound_names fix_env $ do

	  -- (C) do the right-hand-sides and thing-inside
	{ segs <- rn_rec_stmts bound_names new_lhs_and_fv
	; (res, fvs) <- cont segs 
	; warnUnusedLocalBinds bound_names fvs
	; return (res, fvs) }}
904 905 906 907 908 909 910 911 912 913 914 915

-- get all the fixity decls in any Let stmt
collectRecStmtsFixities l = 
    foldr (\ s -> \acc -> case s of 
                            (L loc (LetStmt (HsValBinds (ValBindsIn _ sigs)))) -> 
                                foldr (\ sig -> \ acc -> case sig of 
                                                           (L loc (FixSig s)) -> (L loc s) : acc
                                                           _ -> acc) acc sigs
                            _ -> acc) [] l
                             
-- left-hand sides

916
rn_rec_stmt_lhs :: MiniFixityEnv
917 918 919 920 921 922 923 924 925 926 927 928 929
                -> LStmt RdrName
                   -- rename LHS, and return its FVs
                   -- Warning: we will only need the FreeVars below in the case of a BindStmt,
                   -- so we don't bother to compute it accurately in the other cases
                -> RnM [(LStmtLR Name RdrName, FreeVars)]

rn_rec_stmt_lhs fix_env (L loc (ExprStmt expr a b)) = return [(L loc (ExprStmt expr a b), 
                                                       -- this is actually correct
                                                       emptyFVs)]

rn_rec_stmt_lhs fix_env (L loc (BindStmt pat expr a b)) 
  = do 
      -- should the ctxt be MDo instead?
930
      (pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat 
931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949
      return [(L loc (BindStmt pat' expr a b),
               fv_pat)]

rn_rec_stmt_lhs fix_env (L loc (LetStmt binds@(HsIPBinds _)))
  = do	{ addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
	; failM }

rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds))) 
    = do binds' <- rnValBindsLHS fix_env binds
         return [(L loc (LetStmt (HsValBinds binds')),
                 -- Warning: this is bogus; see function invariant
                 emptyFVs
                 )]

rn_rec_stmt_lhs fix_env (L loc (RecStmt stmts _ _ _ _))	-- Flatten Rec inside Rec
    = rn_rec_stmts_lhs fix_env stmts

rn_rec_stmt_lhs _ stmt@(L _ (ParStmt _))	-- Syntactically illegal in mdo
  = pprPanic "rn_rec_stmt" (ppr stmt)
950 951 952 953 954 955 956
  
rn_rec_stmt_lhs _ stmt@(L _ (TransformStmt _ _ _))	-- Syntactically illegal in mdo
  = pprPanic "rn_rec_stmt" (ppr stmt)
  
rn_rec_stmt_lhs _ stmt@(L _ (GroupStmt _ _))	-- Syntactically illegal in mdo
  = pprPanic "rn_rec_stmt" (ppr stmt)
  
957
rn_rec_stmts_lhs :: MiniFixityEnv
958 959 960 961 962 963 964 965 966
                 -> [LStmt RdrName] 
                 -> RnM [(LStmtLR Name RdrName, FreeVars)]
rn_rec_stmts_lhs fix_env stmts = 
    let boundNames = collectLStmtsBinders stmts
        doc = text "In a recursive mdo-expression"
    in do
     -- First do error checking: we need to check for dups here because we
     -- don't bind all of the variables from the Stmt at once
     -- with bindLocatedLocals.
967
     checkDupRdrNames doc boundNames
968 969 970 971 972 973
     mappM (rn_rec_stmt_lhs fix_env) stmts `thenM` \ ls -> returnM (concat ls)


-- right-hand-sides

rn_rec_stmt :: [Name] -> LStmtLR Name RdrName -> FreeVars -> RnM [Segment (LStmt Name)]
974
	-- Rename a Stmt that is inside a RecStmt (or mdo)
975 976
	-- Assumes all binders are already in scope
	-- Turns each stmt into a singleton Stmt
977 978
rn_rec_stmt all_bndrs (L loc (ExprStmt expr _ _)) _
  = rnLExpr expr `thenM` \ (expr', fvs) ->
979 980 981
    lookupSyntaxName thenMName	`thenM` \ (then_op, fvs1) ->
    returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
	      L loc (ExprStmt expr' then_op placeHolderType))]
982

983
rn_rec_stmt all_bndrs (L loc (BindStmt pat' expr _ _)) fv_pat
984
  = rnLExpr expr		`thenM` \ (expr', fv_expr) ->
985 986
    lookupSyntaxName bindMName	`thenM` \ (bind_op, fvs1) ->
    lookupSyntaxName failMName	`thenM` \ (fail_op, fvs2) ->
987 988
    let
	bndrs = mkNameSet (collectPatBinders pat')
989
	fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
990
    in
991
    returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
992
	      L loc (BindStmt pat' expr' bind_op fail_op))]
993

994
rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _))) _
995 996 997
  = do	{ addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
	; failM }

998 999 1000 1001 1002 1003
rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do 
  (binds', du_binds) <- 
      -- fixities and unused are handled above in rn_rec_stmts_and_then
      rnValBindsRHS all_bndrs binds'
  returnM [(duDefs du_binds, duUses du_binds, 
	    emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
1004

1005 1006 1007
-- no RecStmt case becuase they get flattened above when doing the LHSes
rn_rec_stmt all_bndrs stmt@(L loc (RecStmt stmts _ _ _ _)) _	
  = pprPanic "rn_rec_stmt: RecStmt" (ppr stmt)
1008

1009 1010 1011
rn_rec_stmt all_bndrs stmt@(L _ (ParStmt _)) _	-- Syntactically illegal in mdo
  = pprPanic "rn_rec_stmt: ParStmt" (ppr stmt)