+\begin{code}
+------------------------------------------------------
+-- Messages for case expressions
+
+mkNullAltsMsg :: CoreExpr -> Message
+mkNullAltsMsg e
+ = hang (text "Case expression with no alternatives:")
+ 4 (ppr e)
+
+mkDefaultArgsMsg :: [Var] -> Message
+mkDefaultArgsMsg args
+ = hang (text "DEFAULT case with binders")
+ 4 (ppr args)
+
+mkCaseAltMsg :: CoreExpr -> Type -> Type -> Message
+mkCaseAltMsg e ty1 ty2
+ = hang (text "Type of case alternatives not the same as the annotation on case:")
+ 4 (vcat [ppr ty1, ppr ty2, ppr e])
+
+mkScrutMsg :: Id -> Type -> Message
+mkScrutMsg var scrut_ty
+ = vcat [text "Result binder in case doesn't match scrutinee:" <+> ppr var,
+ text "Result binder type:" <+> ppr (idType var),
+ text "Scrutinee type:" <+> ppr scrut_ty]
+
+
+mkNonDefltMsg e
+ = hang (text "Case expression with DEFAULT not at the beginnning") 4 (ppr e)
+mkNonIncreasingAltsMsg e
+ = hang (text "Case expression with badly-ordered alternatives") 4 (ppr e)
+
+nonExhaustiveAltsMsg :: CoreExpr -> Message
+nonExhaustiveAltsMsg e
+ = hang (text "Case expression with non-exhaustive alternatives") 4 (ppr e)
+
+mkBadPatMsg :: Type -> Type -> Message
+mkBadPatMsg con_result_ty scrut_ty
+ = vcat [
+ text "In a case alternative, pattern result type doesn't match scrutinee type:",
+ text "Pattern result type:" <+> ppr con_result_ty,
+ text "Scrutinee type:" <+> ppr scrut_ty
+ ]
+
+mkBadAltMsg :: Type -> CoreAlt -> Message
+mkBadAltMsg scrut_ty alt
+ = vcat [ text "Data alternative when scrutinee is not a tycon application",
+ text "Scrutinee type:" <+> ppr scrut_ty,
+ text "Alternative:" <+> pprCoreAlt alt ]
+
+------------------------------------------------------
+-- Other error messages
+
+mkAppMsg :: Type -> Type -> CoreExpr -> Message
+mkAppMsg fun_ty arg_ty arg
+ = vcat [ptext SLIT("Argument value doesn't match argument type:"),
+ hang (ptext SLIT("Fun type:")) 4 (ppr fun_ty),
+ hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
+ hang (ptext SLIT("Arg:")) 4 (ppr arg)]
+
+mkKindErrMsg :: TyVar -> Type -> Message
+mkKindErrMsg tyvar arg_ty
+ = vcat [ptext SLIT("Kinds don't match in type application:"),
+ hang (ptext SLIT("Type variable:"))
+ 4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)),
+ hang (ptext SLIT("Arg type:"))
+ 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
+
+mkTyAppMsg :: Type -> Type -> Message
+mkTyAppMsg ty arg_ty
+ = vcat [text "Illegal type application:",
+ hang (ptext SLIT("Exp type:"))
+ 4 (ppr ty <+> dcolon <+> ppr (typeKind ty)),
+ hang (ptext SLIT("Arg type:"))
+ 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
+
+mkRhsMsg :: Id -> Type -> Message
+mkRhsMsg binder ty
+ = vcat
+ [hsep [ptext SLIT("The type of this binder doesn't match the type of its RHS:"),
+ ppr binder],
+ hsep [ptext SLIT("Binder's type:"), ppr (idType binder)],
+ hsep [ptext SLIT("Rhs type:"), ppr ty]]
+
+mkRhsPrimMsg :: Id -> CoreExpr -> Message
+mkRhsPrimMsg binder rhs
+ = vcat [hsep [ptext SLIT("The type of this binder is primitive:"),
+ ppr binder],
+ hsep [ptext SLIT("Binder's type:"), ppr (idType binder)]