+ -- LetStmt
+tcStmtAndThen combine do_or_lc m_ty (LetStmt binds) thing_inside
+ = tcBindsAndThen -- No error context, but a binding group is
+ (glue_binds combine) -- rather a large thing for an error context anyway
+ binds
+ thing_inside
+
+tcStmtAndThen combine do_or_lc m_ty@(m,elt_ty) stmt@(BindStmt pat exp src_loc) thing_inside
+ = tcAddSrcLoc src_loc $
+ tcAddErrCtxt (stmtCtxt do_or_lc stmt) $
+ newTyVarTy liftedTypeKind `thenNF_Tc` \ pat_ty ->
+ tcMonoExpr exp (m pat_ty) `thenTc` \ (exp', exp_lie) ->
+ tcMatchPats [pat] (mkFunTy pat_ty (m elt_ty)) (\ _ ->
+ tcPopErrCtxt thing_inside
+ ) `thenTc` \ ([pat'], thing, lie, dict_binds) ->
+ returnTc (combine (BindStmt pat' exp' src_loc)
+ (glue_binds combine Recursive dict_binds thing),
+ lie `plusLIE` exp_lie)
+
+
+ -- ParStmt
+tcStmtAndThen combine do_or_lc m_ty (ParStmtOut bndr_stmts_s) thing_inside
+ = loop bndr_stmts_s `thenTc` \ ((pairs', thing), lie) ->
+ returnTc (combine (ParStmtOut pairs') thing, lie)
+ where
+ loop []
+ = thing_inside `thenTc` \ (thing, stmts_lie) ->
+ returnTc (([], thing), stmts_lie)
+
+ loop ((bndrs,stmts) : pairs)
+ = tcStmtsAndThen
+ combine_par (DoCtxt ListComp) m_ty stmts
+ -- Notice we pass on m_ty; the result type is used only
+ -- to get escaping type variables for checkExistentialPat
+ (tcLookupLocalIds bndrs `thenNF_Tc` \ bndrs' ->
+ loop pairs `thenTc` \ ((pairs', thing), lie) ->
+ returnTc (([], (bndrs', pairs', thing)), lie)) `thenTc` \ ((stmts', (bndrs', pairs', thing)), lie) ->
+
+ returnTc ( ((bndrs',stmts') : pairs', thing), lie)
+
+ combine_par stmt (stmts, thing) = (stmt:stmts, thing)
+
+ -- ExprStmt
+tcStmtAndThen combine do_or_lc m_ty@(m, res_elt_ty) stmt@(ExprStmt exp _ locn) thing_inside
+ = tcSetErrCtxt (stmtCtxt do_or_lc stmt) (
+ if isDoExpr do_or_lc then
+ newTyVarTy openTypeKind `thenNF_Tc` \ any_ty ->
+ tcMonoExpr exp (m any_ty) `thenNF_Tc` \ (exp', lie) ->
+ returnTc (ExprStmt exp' any_ty locn, lie)
+ else
+ tcMonoExpr exp boolTy `thenNF_Tc` \ (exp', lie) ->
+ returnTc (ExprStmt exp' boolTy locn, lie)
+ ) `thenTc` \ (stmt', stmt_lie) ->
+
+ thing_inside `thenTc` \ (thing, stmts_lie) ->
+
+ returnTc (combine stmt' thing, stmt_lie `plusLIE` stmts_lie)
+
+
+ -- Result statements
+tcStmtAndThen combine do_or_lc m_ty@(m, res_elt_ty) stmt@(ResultStmt exp locn) thing_inside
+ = tcSetErrCtxt (stmtCtxt do_or_lc stmt) (
+ if isDoExpr do_or_lc then
+ tcMonoExpr exp (m res_elt_ty)
+ else
+ tcMonoExpr exp res_elt_ty
+ ) `thenTc` \ (exp', stmt_lie) ->
+
+ thing_inside `thenTc` \ (thing, stmts_lie) ->
+
+ returnTc (combine (ResultStmt exp' locn) thing,
+ stmt_lie `plusLIE` stmts_lie)
+
+
+------------------------------
+glue_binds combine is_rec binds thing
+ | nullMonoBinds binds = thing
+ | otherwise = combine (LetStmt (mkMonoBind binds [] is_rec)) thing