- -> TcM (([TcStmt], [(Name, TcId)]), LIE)
-
-tcStmts do_or_lc m elt_ty loc (ParStmtOut bndrstmtss : stmts)
- = let stmtss = map snd bndrstmtss in
- mapAndUnzip3Tc (tcParStep loc) stmtss `thenTc` \ (stmtss', val_envs, lies) ->
- let outstmts = zip (map (map snd) val_envs) stmtss'
- lie = plusLIEs lies
- new_val_env = concat val_envs
- in
- tcExtendLocalValEnv new_val_env (
- tcStmts do_or_lc m elt_ty loc stmts) `thenTc` \ ((stmts', rest_val_env), stmts_lie) ->
- returnTc ((ParStmtOut outstmts : stmts', rest_val_env ++ new_val_env), lie `plusLIE` stmts_lie)
-
-tcStmts do_or_lc m elt_ty loc (stmt@(ReturnStmt exp) : stmts)
- = ASSERT( null stmts )
- tcSetErrCtxt (stmtCtxt do_or_lc stmt) $
- tcExpr exp elt_ty `thenTc` \ (exp', exp_lie) ->
- returnTc (([ReturnStmt exp'], []), exp_lie)
-
- -- ExprStmt at the end
-tcStmts do_or_lc m elt_ty loc [stmt@(ExprStmt exp src_loc)]
- = tcSetErrCtxt (stmtCtxt do_or_lc stmt) $
- tcExpr exp (m elt_ty) `thenTc` \ (exp', exp_lie) ->
- returnTc (([ExprStmt exp' src_loc], []), exp_lie)
-
- -- ExprStmt not at the end
-tcStmts do_or_lc m elt_ty loc (stmt@(ExprStmt exp src_loc) : stmts)
- = ASSERT( isDoStmt do_or_lc )
- tcAddSrcLoc src_loc (
- tcSetErrCtxt (stmtCtxt do_or_lc stmt) $
- -- exp has type (m tau) for some tau (doesn't matter what)
- newTyVarTy openTypeKind `thenNF_Tc` \ any_ty ->
- tcExpr exp (m any_ty)
- ) `thenTc` \ (exp', exp_lie) ->
- tcStmts do_or_lc m elt_ty loc stmts `thenTc` \ ((stmts', rest_val_env), stmts_lie) ->
- returnTc ((ExprStmt exp' src_loc : stmts', rest_val_env),
- exp_lie `plusLIE` stmts_lie)
-
-tcStmts do_or_lc m elt_ty loc (stmt@(GuardStmt exp src_loc) : stmts)
- = ASSERT( not (isDoStmt do_or_lc) )
- tcSetErrCtxt (stmtCtxt do_or_lc stmt) (
- tcAddSrcLoc src_loc $
- tcExpr exp boolTy
- ) `thenTc` \ (exp', exp_lie) ->
- tcStmts do_or_lc m elt_ty loc stmts `thenTc` \ ((stmts', rest_val_env), stmts_lie) ->
- -- ZZ is this right?
- returnTc ((GuardStmt exp' src_loc : stmts', rest_val_env),
- exp_lie `plusLIE` stmts_lie)
-
-tcStmts do_or_lc m elt_ty loc (stmt@(BindStmt pat exp src_loc) : stmts)