Add 'rec' to stmts in a 'do', and deprecate 'mdo'

[ghc-hetmet.git] / compiler / typecheck / TcHsSyn.lhs

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index de572ba..fbe3c9f 100644 (file)
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -682,21 +682,26 @@ zonkStmt env (ParStmt stmts_w_bndrs)
     zonk_branch (stmts, bndrs) = zonkStmts env stmts   `thenM` \ (env1, new_stmts) ->
                                 returnM (new_stmts, zonkIdOccs env1 bndrs)
 
-zonkStmt env (RecStmt segStmts lvs rvs rets binds)
-  = zonkIdBndrs env rvs                `thenM` \ new_rvs ->
-    let
-       env1 = extendZonkEnv env new_rvs
-    in
-    zonkStmts env1 segStmts    `thenM` \ (env2, new_segStmts) ->
+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 })
+  = do { new_rvs <- zonkIdBndrs env rvs
+       ; new_lvs <- zonkIdBndrs env lvs
+       ; new_ret_id  <- zonkExpr env ret_id
+       ; new_mfix_id <- zonkExpr env mfix_id
+       ; new_bind_id <- zonkExpr env bind_id
+       ; let env1 = extendZonkEnv env new_rvs
+       ; (env2, new_segStmts) <- zonkStmts env1 segStmts
        -- Zonk the ret-expressions in an envt that 
        -- has the polymorphic bindings in the envt
-    mapM (zonkExpr env2) rets  `thenM` \ new_rets ->
-    let
-       new_lvs = zonkIdOccs env2 lvs
-       env3 = extendZonkEnv env new_lvs        -- Only the lvs are needed
-    in
-    zonkRecMonoBinds env3 binds        `thenM` \ (env4, new_binds) ->
-    returnM (env4, RecStmt new_segStmts new_lvs new_rvs new_rets new_binds)
+       ; new_rets <- mapM (zonkExpr env2) rets
+       ; let env3 = extendZonkEnv env new_lvs  -- Only the lvs are needed
+       ; (env4, new_binds) <- zonkRecMonoBinds env3 binds
+       ; return (env4,
+                 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 }) }
 
 zonkStmt env (ExprStmt expr then_op ty)
   = zonkLExpr env expr         `thenM` \ new_expr ->