Tidy up rebindable syntax for MDo

For a long time an 'mdo' expression has had a SyntaxTable
attached to it.  However, we're busy deprecating SyntaxTables
in favour of rebindable syntax attached to individual Stmts,
and MDoExpr was totally inconsistent with DoExpr in this
regard.

This patch tidies it all up.  Now there's no SyntaxTable on
MDoExpr, and 'modo' is generally handled much more like 'do'.

There is resulting small change in behaviour: now MonadFix is
required only if you actually *use* recursion in mdo. This
seems consistent with the implicit dependency analysis that
is done for mdo.

Still to do:
  * Deal with #4148 (this patch is on the way)
  * Get rid of the last remaining SyntaxTable on HsCmdTop

12 files changed, 76 insertions, 135 deletions

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 72c9e664f3..b0e92bb20e 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -465,10 +465,8 @@ addTickStmt isGuard stmt@(RecStmt {})
        ; ret'   <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)
        ; mfix'  <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)
        ; bind'  <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)
-       ; dicts' <- addTickEvBinds (recS_dicts stmt)
        ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
-                      , recS_mfix_fn = mfix', recS_bind_fn = bind'
-                      , recS_dicts = dicts' }) }
+                      , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
 
 addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
 addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
@@ -539,9 +537,6 @@ addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
 addTickLHsCmd ::  LHsCmd Id -> TM (LHsCmd Id)
 addTickLHsCmd x = addTickLHsExpr x
 
-addTickEvBinds :: TcEvBinds -> TM TcEvBinds
-addTickEvBinds x = return x   -- No coverage testing for dictionary binding
-
 addTickHsRecordBinds :: HsRecordBinds Id -> TM (HsRecordBinds Id)
 addTickHsRecordBinds (HsRecFields fields dd) 
   = do	{ fields' <- mapM process fields
diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 3360a95a97..58bf6b88e7 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -779,8 +779,8 @@ dsCmdStmt ids local_vars env_ids out_ids (LetStmt binds) = do
 
 dsCmdStmt ids local_vars env_ids out_ids 
           (RecStmt { recS_stmts = stmts, recS_later_ids = later_ids, recS_rec_ids = rec_ids
-                   , recS_rec_rets = rhss, recS_dicts = _binds }) = do
-    let         -- ToDo: ****** binds not desugared; ROSS PLEASE FIX ********
+                   , recS_rec_rets = rhss }) = do
+    let
         env2_id_set = mkVarSet out_ids `minusVarSet` mkVarSet later_ids
         env2_ids = varSetElems env2_id_set
         env2_ty = mkBigCoreVarTupTy env2_ids
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index e79ce7ff3c..4084310638 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -34,7 +34,6 @@ import DsMeta
 #endif
 
 import HsSyn
-import TcHsSyn
 
 -- NB: The desugarer, which straddles the source and Core worlds, sometimes
 --     needs to see source types
@@ -338,10 +337,8 @@ dsExpr (HsDo DoExpr stmts body result_ty)
 dsExpr (HsDo GhciStmt stmts body result_ty)
   = dsDo stmts body result_ty
 
-dsExpr (HsDo ctxt@(MDoExpr tbl) stmts body result_ty)
-  = do { (meth_binds, tbl') <- dsSyntaxTable tbl
-       ; core_expr <- dsMDo ctxt tbl' stmts body result_ty
-       ; return (mkLets meth_binds core_expr) }
+dsExpr (HsDo MDoExpr stmts body result_ty)
+  = dsDo stmts body result_ty
 
 dsExpr (HsDo PArrComp stmts body result_ty)
   =	-- Special case for array comprehensions
@@ -753,16 +750,15 @@ dsDo stmts body result_ty
     go loc (RecStmt { recS_stmts = rec_stmts, recS_later_ids = later_ids
                     , recS_rec_ids = rec_ids, recS_ret_fn = return_op
                     , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op
-                    , recS_rec_rets = rec_rets, recS_dicts = _ev_binds }) stmts 
+                    , recS_rec_rets = rec_rets }) stmts
       = ASSERT( length rec_ids > 0 )
-        ASSERT( isEmptyTcEvBinds _ev_binds )   -- No method binds
         goL (new_bind_stmt : stmts)
       where
         -- returnE <- dsExpr return_id
         -- mfixE <- dsExpr mfix_id
         new_bind_stmt = L loc $ BindStmt (mkLHsPatTup later_pats) mfix_app
                                          bind_op 
-		                             noSyntaxExpr  -- Tuple cannot fail
+                                         noSyntaxExpr  -- Tuple cannot fail
 
         tup_ids      = rec_ids ++ filterOut (`elem` rec_ids) later_ids
         rec_tup_pats = map nlVarPat tup_ids
@@ -778,15 +774,16 @@ dsDo stmts body result_ty
 	body_ty    = mkAppTy m_ty tup_ty
         tup_ty     = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case
 
+handle_failure :: LPat Id -> MatchResult -> SyntaxExpr Id -> DsM CoreExpr
     -- In a do expression, pattern-match failure just calls
     -- the monadic 'fail' rather than throwing an exception
-    handle_failure pat match fail_op
-      | matchCanFail match
-      = do { fail_op' <- dsExpr fail_op
-	   ; fail_msg <- mkStringExpr (mk_fail_msg pat)
-    	   ; extractMatchResult match (App fail_op' fail_msg) }
-      | otherwise
-      = extractMatchResult match (error "It can't fail") 
+handle_failure pat match fail_op
+  | matchCanFail match
+  = do { fail_op' <- dsExpr fail_op
+       ; fail_msg <- mkStringExpr (mk_fail_msg pat)
+       ; extractMatchResult match (App fail_op' fail_msg) }
+  | otherwise
+  = extractMatchResult match (error "It can't fail")
 
 mk_fail_msg :: Located e -> String
 mk_fail_msg pat = "Pattern match failure in do expression at " ++ 
@@ -801,7 +798,8 @@ We turn (RecStmt [v1,..vn] stmts) into:
 				      return (v1,..vn))
 
 \begin{code}
-dsMDo	:: HsStmtContext Name
+{-
+dsMDo   :: HsStmtContext Name
         -> [(Name,Id)]
 	-> [LStmt Id]
 	-> LHsExpr Id
@@ -815,7 +813,6 @@ dsMDo ctxt tbl stmts body result_ty
     goL ((L loc stmt):lstmts) = putSrcSpanDs loc (go loc stmt lstmts)
   
     (m_ty, b_ty) = tcSplitAppTy result_ty	-- result_ty must be of the form (m b)
-    mfix_id   = lookupEvidence tbl mfixName
     return_id = lookupEvidence tbl returnMName
     bind_id   = lookupEvidence tbl bindMName
     then_id   = lookupEvidence tbl thenMName
@@ -825,35 +822,34 @@ dsMDo ctxt tbl stmts body result_ty
       = do { rest <- goL stmts
 	   ; dsLocalBinds binds rest }
 
-    go _ (ExprStmt rhs _ rhs_ty) stmts
+    go _ (ExprStmt rhs then_expr rhs_ty) stmts
       = do { rhs2 <- dsLExpr rhs
 	   ; warnDiscardedDoBindings rhs m_ty rhs_ty
+           ; then_expr2 <- dsExpr then_expr
            ; rest <- goL stmts
-	   ; return (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
+           ; return (mkApps then_expr2 [rhs2, rest]) }
     
-    go _ (BindStmt pat rhs _ _) stmts
-      = do { body  <- goL stmts
-	   ; var   <- selectSimpleMatchVarL pat
+    go _ (BindStmt pat rhs bind_op _) stmts
+      = do { body     <- goL stmts
+           ; rhs'     <- dsLExpr rhs
+           ; bind_op' <- dsExpr bind_op
+           ; var   <- selectSimpleMatchVarL pat
 	   ; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
-    				  result_ty (cantFailMatchResult body)
-	   ; fail_msg   <- mkStringExpr (mk_fail_msg pat)
-	   ; let fail_expr = mkApps (Var fail_id) [Type b_ty, fail_msg]
-	   ; match_code <- extractMatchResult match fail_expr
-
-	   ; rhs'       <- dsLExpr rhs
-	   ; return (mkApps (Var bind_id) [Type (hsLPatType pat), Type b_ty, 
-					     rhs', Lam var match_code]) }
+                                     result_ty (cantFailMatchResult body)
+           ; match_code <- handle_failure pat match fail_op
+           ; return (mkApps bind_op [rhs', Lam var match_code]) }
     
     go loc (RecStmt { recS_stmts = rec_stmts, recS_later_ids = later_ids
-                    , recS_rec_ids = rec_ids, recS_rec_rets = rec_rets 
-                    , recS_dicts = _ev_binds }) stmts
+                    , recS_rec_ids = rec_ids, recS_rec_rets = rec_rets
+                    , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op }) stmts
       = ASSERT( length rec_ids > 0 )
         ASSERT( length rec_ids == length rec_rets )
         ASSERT( isEmptyTcEvBinds _ev_binds )
         pprTrace "dsMDo" (ppr later_ids) $
 	 goL (new_bind_stmt : stmts)
       where
-        new_bind_stmt = L loc $ mkBindStmt (mk_tup_pat later_pats) mfix_app
+        new_bind_stmt = L loc $ BindStmt (mk_tup_pat later_pats) mfix_app
+                                         bind_op noSyntaxExpr
 	
 		-- Remove the later_ids that appear (without fancy coercions) 
 		-- in rec_rets, because there's no need to knot-tie them separately
@@ -861,7 +857,7 @@ dsMDo ctxt tbl stmts body result_ty
 	later_ids'   = filter (`notElem` mono_rec_ids) later_ids
 	mono_rec_ids = [ id | HsVar id <- rec_rets ]
     
-	mfix_app = nlHsApp (nlHsTyApp mfix_id [tup_ty]) mfix_arg
+        mfix_app = nlHsApp (noLoc mfix_op) mfix_arg
 	mfix_arg = noLoc $ HsLam (MatchGroup [mkSimpleMatch [mfix_pat] body]
 					     (mkFunTy tup_ty body_ty))
 
@@ -877,8 +873,7 @@ dsMDo ctxt tbl stmts body result_ty
 	body_ty = mkAppTy m_ty tup_ty
 	tup_ty  = mkBoxedTupleTy (map idType (later_ids' ++ rec_ids))  -- Deals with singleton case
 
-	return_app  = nlHsApp (nlHsTyApp return_id [tup_ty]) 
-			      (mkLHsTupleExpr rets)
+        return_app  = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets)
 
 	mk_wild_pat :: Id -> LPat Id 
    	mk_wild_pat v = noLoc $ WildPat $ idType v
@@ -890,6 +885,7 @@ dsMDo ctxt tbl stmts body result_ty
  	mk_tup_pat :: [LPat Id] -> LPat Id
   	mk_tup_pat [p] = p
 	mk_tup_pat ps  = noLoc $ mkVanillaTuplePat ps Boxed
+-}
 \end{code}
 
 
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 78577072ef..56fc9a76b6 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -905,9 +905,6 @@ data StmtLR idL idR
                                      -- because the Id may be *polymorphic*, but
                                      -- the returned thing has to be *monomorphic*, 
 				     -- so they may be type applications
-
-      , recS_dicts :: TcEvBinds    -- Method bindings of Ids bound by the
-                                   -- RecStmt, and used afterwards
       }
   deriving (Data, Typeable)
 \end{code}
@@ -1043,7 +1040,7 @@ pprBy (Just e) = ptext (sLit "by") <+> ppr e
 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
 pprDo DoExpr      stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
 pprDo GhciStmt    stmts body = ptext (sLit "do")  <+> ppr_do_stmts stmts body
-pprDo (MDoExpr _) stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
+pprDo MDoExpr     stmts body = ptext (sLit "mdo") <+> ppr_do_stmts stmts body
 pprDo ListComp    stmts body = brackets    $ pprComp stmts body
 pprDo PArrComp    stmts body = pa_brackets $ pprComp stmts body
 pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
@@ -1176,9 +1173,7 @@ data HsStmtContext id
   = ListComp
   | DoExpr
   | GhciStmt				 -- A command-line Stmt in GHCi pat <- rhs
-  | MDoExpr PostTcTable                  -- Recursive do-expression
-                                         -- (tiresomely, it needs table
-                                         --  of its return/bind ops)
+  | MDoExpr                              -- Recursive do-expression
   | PArrComp                             -- Parallel array comprehension
   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
@@ -1188,9 +1183,9 @@ data HsStmtContext id
 
 \begin{code}
 isDoExpr :: HsStmtContext id -> Bool
-isDoExpr DoExpr      = True
-isDoExpr (MDoExpr _) = True
-isDoExpr _           = False
+isDoExpr DoExpr  = True
+isDoExpr MDoExpr = True
+isDoExpr _       = False
 
 isListCompExpr :: HsStmtContext id -> Bool
 isListCompExpr ListComp = True
@@ -1241,7 +1236,7 @@ pprStmtContext (PatGuard ctxt)
  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
 pprStmtContext GhciStmt        = ptext (sLit "an interactive GHCi command")
 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
-pprStmtContext (MDoExpr _)     = ptext (sLit "an 'mdo' expression")
+pprStmtContext MDoExpr         = ptext (sLit "an 'mdo' expression")
 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
 pprStmtContext PArrComp        = ptext (sLit "an array comprehension")
 
@@ -1274,7 +1269,7 @@ matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (
 matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
 matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
 matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
-matchContextErrString (StmtCtxt (MDoExpr _))     = ptext (sLit "'mdo' expression")
+matchContextErrString (StmtCtxt MDoExpr)         = ptext (sLit "'mdo' expression")
 matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")
 matchContextErrString (StmtCtxt PArrComp)        = ptext (sLit "array comprehension")
 \end{code}
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 18f9abddd6..d17f85099f 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -228,7 +228,7 @@ mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
 emptyRecStmt = RecStmt { recS_stmts = [], recS_later_ids = [], recS_rec_ids = []
                        , recS_ret_fn = noSyntaxExpr, recS_mfix_fn = noSyntaxExpr
 		       , recS_bind_fn = noSyntaxExpr
-                       , recS_rec_rets = [], recS_dicts = emptyTcEvBinds }
+                       , recS_rec_rets = [] }
 
 mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
 
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 98599498ae..a0cc96417c 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1284,7 +1284,9 @@ exp10 :: { LHsExpr RdrName }
 					   return (L loc (mkHsDo DoExpr stmts body)) }
   	| 'mdo' stmtlist		{% let loc = comb2 $1 $2 in
 					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-					   return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
+                                           return (L loc (mkHsDo MDoExpr
+                                                                 [L loc (mkRecStmt stmts)]
+                                                                 body)) }
         | scc_annot exp		    		{ LL $ if opt_SccProfilingOn
 							then HsSCC (unLoc $1) $2
 							else HsPar $2 }
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 4899adb077..0b107645f3 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -773,7 +773,7 @@ rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
 rnGRHS' :: HsMatchContext Name -> GRHS RdrName -> RnM (GRHS Name, FreeVars)
 rnGRHS' ctxt (GRHS guards rhs)
   = do	{ pattern_guards_allowed <- xoptM Opt_PatternGuards
-	; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
+        ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $ \ _ ->
 				    rnLExpr rhs
 
 	; unless (pattern_guards_allowed || is_standard_guard guards')
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 310d075d41..4b5071f8d1 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -221,7 +221,7 @@ rnExpr (HsLet binds expr)
     return (HsLet binds' expr', fvExpr)
 
 rnExpr (HsDo do_or_lc stmts body _)
-  = do 	{ ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
+  = do  { ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $ \ _ ->
 				    rnLExpr body
 	; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
 
@@ -637,16 +637,7 @@ rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG"
 %************************************************************************
 
 \begin{code}
-rnStmts :: HsStmtContext Name -> [LStmt RdrName] 
-	-> RnM (thing, FreeVars)
-	-> RnM (([LStmt Name], thing), FreeVars)
--- Variables bound by the Stmts, and mentioned in thing_inside,
--- do not appear in the result FreeVars
-
-rnStmts (MDoExpr _) stmts thing_inside = rnMDoStmts    stmts thing_inside
-rnStmts ctxt        stmts thing_inside = rnNormalStmts ctxt stmts (\ _ -> thing_inside)
-
-rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
+rnStmts :: HsStmtContext Name -> [LStmt RdrName]
 	      -> ([Name] -> RnM (thing, FreeVars))
 	      -> RnM (([LStmt Name], thing), FreeVars)	
 -- Variables bound by the Stmts, and mentioned in thing_inside,
@@ -654,15 +645,15 @@ rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
 --
 -- Renaming a single RecStmt can give a sequence of smaller Stmts
 
-rnNormalStmts _ [] thing_inside 
+rnStmts _ [] thing_inside
   = do { (res, fvs) <- thing_inside []
        ; return (([], res), fvs) }
 
-rnNormalStmts ctxt (stmt@(L loc _) : stmts) thing_inside
+rnStmts ctxt (stmt@(L loc _) : stmts) thing_inside
   = do { ((stmts1, (stmts2, thing)), fvs) 
             <- setSrcSpan loc           $
                rnStmt ctxt stmt         $ \ bndrs1 ->
-               rnNormalStmts ctxt stmts $ \ bndrs2 ->
+               rnStmts ctxt stmts $ \ bndrs2 ->
                thing_inside (bndrs1 ++ bndrs2)
 	; return (((stmts1 ++ stmts2), thing), fvs) }
 
@@ -710,7 +701,7 @@ rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
 	-- 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 rec_stmts	$ \ segs -> do
+        ; rnRecStmtsAndThen rec_stmts   $ \ segs -> do
 
 	{ let bndrs = nameSetToList $ foldr (unionNameSets . (\(ds,_,_,_) -> ds)) 
                                             emptyNameSet segs
@@ -753,7 +744,7 @@ rnStmt ctxt (L loc (TransformStmt stmts _ using by)) thing_inside
        ; (using', fvs1) <- rnLExpr using
 
        ; ((stmts', (by', used_bndrs, thing)), fvs2)
-             <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
+             <- rnStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
                 do { (by', fvs_by) <- case by of
                                         Nothing -> return (Nothing, emptyFVs)
                                         Just e  -> do { (e', fvs) <- rnLExpr e; return (Just e', fvs) }
@@ -779,7 +770,7 @@ rnStmt ctxt (L loc (GroupStmt stmts _ by using)) thing_inside
          -- Rename the stmts and the 'by' expression
 	 -- Keep track of the variables mentioned in the 'by' expression
        ; ((stmts', (by', used_bndrs, thing)), fvs2) 
-             <- rnNormalStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
+             <- rnStmts (TransformStmtCtxt ctxt) stmts $ \ bndrs ->
                 do { (by',   fvs_by) <- mapMaybeFvRn rnLExpr by
                    ; (thing, fvs_thing) <- thing_inside bndrs
                    ; let fvs = fvs_by `plusFV` fvs_thing
@@ -816,7 +807,7 @@ rnParallelStmts ctxt segs thing_inside
 
     rn_segs env bndrs_so_far ((stmts,_) : segs) 
       = do { ((stmts', (used_bndrs, segs', thing)), fvs)
-                    <- rnNormalStmts ctxt stmts $ \ bndrs ->
+                    <- rnStmts ctxt stmts $ \ bndrs ->
                        setLocalRdrEnv env       $ do
                        { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs
 		       ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
@@ -864,28 +855,13 @@ type Segment stmts = (Defs,
 		      stmts)	-- Either Stmt or [Stmt]
 
 
-----------------------------------------------------
-
-rnMDoStmts :: [LStmt RdrName]
-	   -> RnM (thing, FreeVars)
-	   -> RnM (([LStmt Name], thing), FreeVars)	
-rnMDoStmts stmts thing_inside
-  = rn_rec_stmts_and_then stmts $ \ segs -> do
-    { (thing, fvs_later) <- thing_inside
-    ; let   segs_w_fwd_refs = addFwdRefs segs
-	    grouped_segs = glomSegments segs_w_fwd_refs
-	    (stmts', fvs) = segsToStmts emptyRecStmt grouped_segs fvs_later
-    ; return ((stmts', thing), fvs) }
-
----------------------------------------------
-
 -- wrapper that does both the left- and right-hand sides
-rn_rec_stmts_and_then :: [LStmt RdrName]
+rnRecStmtsAndThen :: [LStmt RdrName]
                          -- assumes that the FreeVars returned includes
                          -- the FreeVars of the Segments
                       -> ([Segment (LStmt Name)] -> RnM (a, FreeVars))
                       -> RnM (a, FreeVars)
-rn_rec_stmts_and_then s cont
+rnRecStmtsAndThen s cont
   = do	{ -- (A) Make the mini fixity env for all of the stmts
 	  fix_env <- makeMiniFixityEnv (collectRecStmtsFixities s)
 
@@ -1000,7 +976,7 @@ rn_rec_stmt _ (L _ (LetStmt binds@(HsIPBinds _))) _
 
 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
+      -- fixities and unused are handled above in rnRecStmtsAndThen
       rnLocalValBindsRHS (mkNameSet all_bndrs) binds'
   return [(duDefs du_binds, allUses du_binds, 
 	   emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
@@ -1173,9 +1149,9 @@ checkLetStmt _ctxt 	     _binds	       = return ()
 
 ---------
 checkRecStmt :: HsStmtContext Name -> RnM ()
-checkRecStmt (MDoExpr {}) = return ()	-- Recursive stmt ok in 'mdo'
-checkRecStmt (DoExpr {})  = return ()	-- and in 'do'
-checkRecStmt ctxt	  = addErr msg
+checkRecStmt MDoExpr = return ()      -- Recursive stmt ok in 'mdo'
+checkRecStmt DoExpr  = return ()      -- and in 'do'
+checkRecStmt ctxt    = addErr msg
   where
     msg = ptext (sLit "Illegal 'rec' stmt in") <+> pprStmtContext ctxt
 
diff --git a/compiler/rename/RnExpr.lhs-boot b/compiler/rename/RnExpr.lhs-boot
index 5fba8c35fa..8870017a3a 100644
--- a/compiler/rename/RnExpr.lhs-boot
+++ b/compiler/rename/RnExpr.lhs-boot
@@ -11,7 +11,7 @@ rnLExpr :: LHsExpr RdrName
 

 rnStmts :: --forall thing.

 	   HsStmtContext Name -> [LStmt RdrName] 

-	-> RnM (thing, FreeVars)

+        -> ([Name] -> RnM (thing, FreeVars))

 	-> RnM (([LStmt Name], thing), FreeVars)

 \end{code}

 

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 6b4449a107..5bc73338d2 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -580,8 +580,7 @@ zonkExpr env (HsDo do_or_lc stmts body ty)
   = zonkStmts env stmts 	`thenM` \ (new_env, new_stmts) ->
     zonkLExpr new_env body	`thenM` \ new_body ->
     zonkTcTypeToType env ty	`thenM` \ new_ty   ->
-    zonkDo env do_or_lc	 	`thenM` \ new_do_or_lc ->
-    returnM (HsDo new_do_or_lc new_stmts new_body new_ty)
+    returnM (HsDo do_or_lc new_stmts new_body new_ty)
 
 zonkExpr env (ExplicitList ty exprs)
   = zonkTcTypeToType env ty	`thenM` \ new_ty ->
@@ -689,13 +688,6 @@ zonkCoFn env (WpLet bs)     = do { (env1, bs') <- zonkTcEvBinds env bs
 				 ; return (env1, WpLet bs') }
 
 -------------------------------------------------------------------------
-zonkDo :: ZonkEnv -> HsStmtContext Name -> TcM (HsStmtContext Name)
--- Only used for 'do', so the only Ids are in a MDoExpr table
-zonkDo env (MDoExpr tbl) = do { tbl' <- mapSndM (zonkExpr env) tbl
-                              ; return (MDoExpr tbl') }
-zonkDo _   do_or_lc      = return do_or_lc
-
--------------------------------------------------------------------------
 zonkOverLit :: ZonkEnv -> HsOverLit TcId -> TcM (HsOverLit Id)
 zonkOverLit env lit@(OverLit { ol_witness = e, ol_type = ty })
   = do	{ ty' <- zonkTcTypeToType env ty
@@ -747,7 +739,7 @@ zonkStmt env (ParStmt stmts_w_bndrs)
 
 zonkStmt env (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs
                       , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id, recS_bind_fn = bind_id
-                      , recS_rec_rets = rets, recS_dicts = binds })
+                      , recS_rec_rets = rets })
   = do { new_rvs <- zonkIdBndrs env rvs
        ; new_lvs <- zonkIdBndrs env lvs
        ; new_ret_id  <- zonkExpr env ret_id
@@ -758,13 +750,11 @@ zonkStmt env (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_id
 	-- Zonk the ret-expressions in an envt that 
 	-- has the polymorphic bindings in the envt
        ; new_rets <- mapM (zonkExpr env2) rets
-       ; let env3 = extendZonkEnv env new_lvs	-- Only the lvs are needed
-       ; (env4, new_binds) <- zonkTcEvBinds env3 binds
-       ; return (env4,
+       ; return (extendZonkEnv env new_lvs,     -- Only the lvs are needed
                  RecStmt { recS_stmts = new_segStmts, recS_later_ids = new_lvs
                          , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id
                          , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id
-                         , recS_rec_rets = new_rets, recS_dicts = new_binds }) }
+                         , recS_rec_rets = new_rets }) }
 
 zonkStmt env (ExprStmt expr then_op ty)
   = zonkLExpr env expr		`thenM` \ new_expr ->
diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs
index a73b1d3a91..46b67da9be 100644
--- a/compiler/typecheck/TcMatches.lhs
+++ b/compiler/typecheck/TcMatches.lhs
@@ -17,7 +17,6 @@ import {-# SOURCE #-}	TcExpr( tcSyntaxOp, tcInferRhoNC, tcCheckId,
 
 import HsSyn
 import TcRnMonad
-import Inst
 import TcEnv
 import TcPat
 import TcMType
@@ -26,7 +25,6 @@ import TcBinds
 import TcUnify
 import Name
 import TysWiredIn
-import PrelNames
 import Id
 import TyCon
 import TysPrim
@@ -264,19 +262,10 @@ tcDoStmts DoExpr stmts body res_ty
 			     tcBody body
 	; return (HsDo DoExpr stmts' body' res_ty) }
 
-tcDoStmts ctxt@(MDoExpr _) stmts body res_ty
-  = do	{ (coi, (m_ty, elt_ty)) <- matchExpectedAppTy res_ty
- 	; let res_ty' = mkAppTy m_ty elt_ty	-- The matchExpected consumes res_ty
-	      tc_rhs rhs = tcInfer $ \ pat_ty ->
-			   tcMonoExpr rhs (mkAppTy m_ty pat_ty)
-
-	; (stmts', body') <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty' $
+tcDoStmts MDoExpr stmts body res_ty
+  = do  { (stmts', body') <- tcStmts MDoExpr tcDoStmt stmts res_ty $
 			     tcBody body
-
-	; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
-	; insts <- mapM (\name -> newMethodFromName DoOrigin name m_ty) names
-	; return $ mkHsWrapCoI coi $ 
-          HsDo (MDoExpr (names `zip` insts)) stmts' body' res_ty' }
+        ; return (HsDo MDoExpr stmts' body' res_ty) }
 
 tcDoStmts ctxt _ _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
 
@@ -571,7 +560,7 @@ tcDoStmt ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
         ; return (RecStmt { recS_stmts = stmts', recS_later_ids = later_ids
                           , recS_rec_ids = rec_ids, recS_ret_fn = ret_op' 
                           , recS_mfix_fn = mfix_op', recS_bind_fn = bind_op'
-                          , recS_rec_rets = tup_rets, recS_dicts = emptyTcEvBinds }, thing)
+                          , recS_rec_rets = tup_rets }, thing)
         }}
 
 tcDoStmt _ stmt _ _
@@ -608,7 +597,8 @@ tcMDoStmt tc_rhs _ (ExprStmt rhs _ _) res_ty thing_inside
 	; thing 	 <- thing_inside res_ty
 	; return (ExprStmt rhs' noSyntaxExpr elt_ty, thing) }
 
-tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _ _ _ _) res_ty thing_inside
+tcMDoStmt tc_rhs ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = laterNames
+                               , recS_rec_ids = recNames }) res_ty thing_inside
   = do	{ rec_tys <- newFlexiTyVarTys (length recNames) liftedTypeKind
 	; let rec_ids = zipWith mkLocalId recNames rec_tys
 	; tcExtendIdEnv rec_ids			$ do
@@ -625,11 +615,7 @@ tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _ _ _ _) res_ty thing
 		--	some of them with polymorphic things with the same Name
 		--	(see note [RecStmt] in HsExpr)
 
--- Need the bindLocalMethods if we re-add Method constraints
---	; lie_binds <- bindLocalMethods lie later_ids
-	; let lie_binds = emptyTcEvBinds
-  
-	; return (RecStmt stmts' later_ids rec_ids noSyntaxExpr noSyntaxExpr noSyntaxExpr rec_rets lie_binds, thing)
+        ; return (RecStmt stmts' later_ids rec_ids noSyntaxExpr noSyntaxExpr noSyntaxExpr rec_rets, thing)
 	}}
 
 tcMDoStmt _ _ stmt _ _
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 60f0fe93dd..893365e911 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -1082,7 +1082,8 @@ tcRnStmt hsc_env ictxt rdr_stmt
     setInteractiveContext hsc_env ictxt $ do {
 
     -- Rename; use CmdLineMode because tcRnStmt is only used interactively
-    (([rn_stmt], _), fvs) <- rnStmts GhciStmt [rdr_stmt] (return ((), emptyFVs)) ;
+    (([rn_stmt], _), fvs) <- rnStmts GhciStmt [rdr_stmt] $ \_ ->
+                             return ((), emptyFVs) ;
     traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
     failIfErrsM ;
     rnDump (ppr rn_stmt) ;