- = tcExpr_id op `thenTc` \ (op', lie1, op_ty) ->
- split_fun_ty op_ty 2 {- two args -} `thenTc` \ ([arg1_ty, arg2_ty], op_res_ty) ->
- tcArg op (arg1, arg1_ty, 1) `thenTc` \ (arg1',lie2a) ->
- tcArg op (arg2, arg2_ty, 2) `thenTc` \ (arg2',lie2b) ->
- tcAddErrCtxt (exprCtxt in_expr) $
- tcSubExp res_ty op_res_ty `thenTc` \ (co_fn, lie3) ->
- returnTc (OpApp arg1' op' fix arg2',
- lie1 `plusLIE` lie2a `plusLIE` lie2b `plusLIE` lie3)
+ = tcInferRho op `thenM` \ (op', op_ty) ->
+ split_fun_ty op_ty 2 {- two args -} `thenM` \ ([arg1_ty, arg2_ty], op_res_ty) ->
+ tcArg op (arg1, arg1_ty, 1) `thenM` \ arg1' ->
+ tcArg op (arg2, arg2_ty, 2) `thenM` \ arg2' ->
+ addErrCtxt (exprCtxt in_expr) $
+ tcSubExp res_ty op_res_ty `thenM` \ co_fn ->
+ returnM (OpApp arg1' op' fix arg2')
+\end{code}
+
+\begin{code}
+tcMonoExpr (HsLet binds expr) res_ty
+ = tcBindsAndThen
+ HsLet
+ binds -- Bindings to check
+ (tcMonoExpr expr res_ty)
+
+tcMonoExpr in_expr@(HsCase scrut matches src_loc) res_ty
+ = addSrcLoc src_loc $
+ addErrCtxt (caseCtxt in_expr) $
+
+ -- Typecheck the case alternatives first.
+ -- The case patterns tend to give good type info to use
+ -- when typechecking the scrutinee. For example
+ -- case (map f) of
+ -- (x:xs) -> ...
+ -- will report that map is applied to too few arguments
+
+ tcMatchesCase matches res_ty `thenM` \ (scrut_ty, matches') ->
+
+ addErrCtxt (caseScrutCtxt scrut) (
+ tcCheckRho scrut scrut_ty
+ ) `thenM` \ scrut' ->
+
+ returnM (HsCase scrut' matches' src_loc)
+
+tcMonoExpr (HsIf pred b1 b2 src_loc) res_ty
+ = addSrcLoc src_loc $
+ addErrCtxt (predCtxt pred) (
+ tcCheckRho pred boolTy ) `thenM` \ pred' ->
+
+ zapExpectedType res_ty `thenM` \ res_ty' ->
+ -- C.f. the call to zapToType in TcMatches.tcMatches
+
+ tcCheckRho b1 res_ty' `thenM` \ b1' ->
+ tcCheckRho b2 res_ty' `thenM` \ b2' ->
+ returnM (HsIf pred' b1' b2' src_loc)
+
+tcMonoExpr (HsDo do_or_lc stmts method_names _ src_loc) res_ty
+ = addSrcLoc src_loc $
+ zapExpectedType res_ty `thenM` \ res_ty' ->
+ -- All comprehensions yield a monotype
+ tcDoStmts do_or_lc stmts method_names res_ty' `thenM` \ (stmts', methods') ->
+ returnM (HsDo do_or_lc stmts' methods' res_ty' src_loc)
+
+tcMonoExpr in_expr@(ExplicitList _ exprs) res_ty -- Non-empty list
+ = zapToListTy res_ty `thenM` \ elt_ty ->
+ mappM (tc_elt elt_ty) exprs `thenM` \ exprs' ->
+ returnM (ExplicitList elt_ty exprs')
+ where
+ tc_elt elt_ty expr
+ = addErrCtxt (listCtxt expr) $
+ tcCheckRho expr elt_ty
+
+tcMonoExpr in_expr@(ExplicitPArr _ exprs) res_ty -- maybe empty
+ = zapToPArrTy res_ty `thenM` \ elt_ty ->
+ mappM (tc_elt elt_ty) exprs `thenM` \ exprs' ->
+ returnM (ExplicitPArr elt_ty exprs')
+ where
+ tc_elt elt_ty expr
+ = addErrCtxt (parrCtxt expr) $
+ tcCheckRho expr elt_ty
+
+tcMonoExpr (ExplicitTuple exprs boxity) res_ty
+ = zapToTupleTy boxity (length exprs) res_ty `thenM` \ arg_tys ->
+ tcCheckRhos exprs arg_tys `thenM` \ exprs' ->
+ returnM (ExplicitTuple exprs' boxity)
+
+tcMonoExpr (HsProc pat cmd loc) res_ty
+ = addSrcLoc loc $
+ tcProc pat cmd res_ty `thenM` \ (pat', cmd') ->
+ returnM (HsProc pat' cmd' loc)