-mkCaseAltMsg :: PlainCoreCaseAlternatives -> ErrMsg
-mkCaseAltMsg alts sty
- = ppAbove (ppStr "In some case alternatives, type of alternatives not all same:")
- (ppr sty alts)
-
-mkCaseDataConMsg :: PlainCoreExpr -> ErrMsg
-mkCaseDataConMsg expr sty
- = ppAbove (ppStr "A case scrutinee not a type-constructor type:")
- (pp_expr sty expr)
-
-mkCasePrimMsg :: Bool -> TyCon -> ErrMsg
-mkCasePrimMsg True tycon sty
- = ppAbove (ppStr "A primitive case on a non-primitive type:")
- (ppr sty tycon)
-mkCasePrimMsg False tycon sty
- = ppAbove (ppStr "An algebraic case on a primitive type:")
- (ppr sty tycon)
-
-mkCaseAbstractMsg :: TyCon -> ErrMsg
-mkCaseAbstractMsg tycon sty
- = ppAbove (ppStr "An algebraic case on an abstract type:")
- (ppr sty tycon)
-
-mkDefltMsg :: PlainCoreCaseDefault -> ErrMsg
-mkDefltMsg deflt sty
- = ppAbove (ppStr "Binder in default case of a case expression doesn't match type of scrutinee:")
- (ppr sty deflt)
-
-mkFunAppMsg :: UniType -> [UniType] -> PlainCoreExpr -> ErrMsg
-mkFunAppMsg fun_ty arg_tys expr sty
- = ppAboves [ppStr "In a function application, function type doesn't match arg types:",
- ppHang (ppStr "Function type:") 4 (ppr sty fun_ty),
- ppHang (ppStr "Arg types:") 4 (ppAboves (map (ppr sty) arg_tys)),
- ppHang (ppStr "Expression:") 4 (pp_expr sty expr)]
-
-mkUnappTyMsg :: Id -> UniType -> ErrMsg
-mkUnappTyMsg var ty sty
- = ppAboves [ppStr "Variable has a for-all type, but isn't applied to any types.",
- ppBeside (ppStr "Var: ") (ppr sty var),
- ppBeside (ppStr "Its type: ") (ppr sty ty)]
-
-mkAlgAltMsg1 :: UniType -> ErrMsg
-mkAlgAltMsg1 ty sty
- = ppAbove (ppStr "In some case statement, type of scrutinee is not a data type:")
- (ppr sty ty)
-
-mkAlgAltMsg2 :: UniType -> Id -> ErrMsg
-mkAlgAltMsg2 ty con sty
- = ppAboves [
- ppStr "In some algebraic case alternative, constructor is not a constructor of scrutinee type:",
- ppr sty ty,
- ppr sty con
- ]
-
-mkAlgAltMsg3 :: Id -> [Id] -> ErrMsg
-mkAlgAltMsg3 con alts sty
- = ppAboves [
- ppStr "In some algebraic case alternative, number of arguments doesn't match constructor:",
- ppr sty con,
- ppr sty alts
+------------------------------------------------------
+-- Messages for case expressions
+
+mkConAppMsg :: CoreExpr -> Message
+mkConAppMsg e
+ = hang (text "Application of newtype constructor:")
+ 4 (ppr e)
+
+mkConAltMsg :: Con -> Message
+mkConAltMsg con
+ = text "PrimOp in case pattern:" <+> ppr con
+
+mkNullAltsMsg :: CoreExpr -> Message
+mkNullAltsMsg e
+ = hang (text "Case expression with no alternatives:")
+ 4 (ppr e)
+
+mkDefaultArgsMsg :: [IdOrTyVar] -> Message
+mkDefaultArgsMsg args
+ = hang (text "DEFAULT case with binders")
+ 4 (ppr args)
+
+mkCaseAltMsg :: CoreExpr -> Message
+mkCaseAltMsg e
+ = hang (text "Type of case alternatives not the same:")
+ 4 (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]
+
+badAltsMsg :: CoreExpr -> Message
+badAltsMsg e
+ = hang (text "Case statement scrutinee is not a data type:")
+ 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