+tcDoStmt ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
+ , recS_rec_ids = rec_names, recS_ret_fn = ret_op
+ , recS_mfix_fn = mfix_op, recS_bind_fn = bind_op })
+ res_ty thing_inside
+ = do { let tup_names = rec_names ++ filterOut (`elem` rec_names) later_names
+ ; tup_elt_tys <- newFlexiTyVarTys (length tup_names) liftedTypeKind
+ ; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys
+ tup_ty = mkBoxedTupleTy tup_elt_tys
+
+ ; tcExtendIdEnv tup_ids $ do
+ { ((stmts', (ret_op', tup_rets)), stmts_ty)
+ <- withBox liftedTypeKind $ \ stmts_ty ->
+ tcStmts ctxt tcDoStmt stmts stmts_ty $ \ inner_res_ty ->
+ do { tup_rets <- zipWithM tc_ret tup_names tup_elt_tys
+ ; ret_op' <- tcSyntaxOp DoOrigin ret_op (mkFunTy tup_ty inner_res_ty)
+ ; return (ret_op', tup_rets) }
+
+ ; (mfix_op', mfix_res_ty) <- withBox liftedTypeKind $ \ mfix_res_ty ->
+ tcSyntaxOp DoOrigin mfix_op
+ (mkFunTy (mkFunTy tup_ty stmts_ty) mfix_res_ty)
+
+ ; (bind_op', new_res_ty) <- withBox liftedTypeKind $ \ new_res_ty ->
+ tcSyntaxOp DoOrigin bind_op
+ (mkFunTys [mfix_res_ty, mkFunTy tup_ty new_res_ty] res_ty)
+
+ ; (thing,lie) <- getLIE (thing_inside new_res_ty)
+ ; lie_binds <- bindInstsOfLocalFuns lie tup_ids
+
+ ; let rec_ids = takeList rec_names tup_ids
+ ; later_ids <- tcLookupLocalIds later_names
+ ; traceTc (text "tcdo" <+> vcat [ppr rec_ids <+> ppr (map idType rec_ids),
+ ppr later_ids <+> ppr (map idType later_ids)])
+ ; 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 = lie_binds }, thing)
+ }}
+ where
+ -- Unify the types of the "final" Ids with those of "knot-tied" Ids
+ tc_ret rec_name mono_ty
+ = do { poly_id <- tcLookupId rec_name
+ -- poly_id may have a polymorphic type
+ -- but mono_ty is just a monomorphic type variable
+ ; co_fn <- tcSubExp DoOrigin (idType poly_id) mono_ty
+ ; return (mkHsWrap co_fn (HsVar poly_id)) }