+\begin{code}
+tcMonoExpr (HsLet binds expr) res_ty
+ = tcBindsAndThen
+ combiner
+ binds -- Bindings to check
+ (tcMonoExpr expr res_ty)
+ where
+ combiner is_rec bind expr = HsLet (mkMonoBind bind [] is_rec) expr
+
+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
+ --
+ -- Not only that, but it's better to check the matches on their
+ -- own, so that we get the expected results for scoped type variables.
+ -- f x = case x of
+ -- (p::a, q::b) -> (q,p)
+ -- The above should work: the match (p,q) -> (q,p) is polymorphic as
+ -- claimed by the pattern signatures. But if we typechecked the
+ -- match with x in scope and x's type as the expected type, we'd be hosed.
+
+ tcMatchesCase matches res_ty `thenM` \ (scrut_ty, matches') ->
+
+ addErrCtxt (caseScrutCtxt scrut) (
+ tcMonoExpr 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) (
+ tcMonoExpr pred boolTy ) `thenM` \ pred' ->
+
+ zapToType res_ty `thenM` \ res_ty' ->
+ -- C.f. the call to zapToType in TcMatches.tcMatches
+
+ tcMonoExpr b1 res_ty' `thenM` \ b1' ->
+ tcMonoExpr 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 $
+ tcDoStmts do_or_lc stmts method_names res_ty `thenM` \ (binds, stmts', methods') ->
+ returnM (mkHsLet binds (HsDo do_or_lc stmts' methods' res_ty src_loc))
+
+tcMonoExpr in_expr@(ExplicitList _ exprs) res_ty -- Non-empty list
+ = unifyListTy 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) $
+ tcMonoExpr expr elt_ty
+
+tcMonoExpr in_expr@(ExplicitPArr _ exprs) res_ty -- maybe empty
+ = unifyPArrTy 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) $
+ tcMonoExpr expr elt_ty
+
+tcMonoExpr (ExplicitTuple exprs boxity) res_ty
+ = unifyTupleTy boxity (length exprs) res_ty `thenM` \ arg_tys ->
+ tcMonoExprs exprs arg_tys `thenM` \ exprs' ->
+ returnM (ExplicitTuple exprs' boxity)
+\end{code}
+
+
+%************************************************************************
+%* *
+ Foreign calls
+%* *
+%************************************************************************
+