aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'kernel')
-rw-r--r--kernel/inductive.ml9
-rw-r--r--kernel/inductive.mli2
-rw-r--r--kernel/type_errors.ml7
-rw-r--r--kernel/type_errors.mli9
4 files changed, 18 insertions, 9 deletions
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index d7181299e1..c9399925bb 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -222,14 +222,13 @@ let is_info_arity env c =
let error_elim_expln env kp ki =
if is_info_arity env kp && not (is_info_arity env ki) then
- "non-informative objects may not construct informative ones."
+ NonInformativeToInformative
else
match (kind_of_term kp,kind_of_term ki) with
- | Sort (Type _), Sort (Prop _) ->
- "strong elimination on non-small inductive types leads to paradoxes."
- | _ -> "wrong arity"
+ | Sort (Type _), Sort (Prop _) -> StrongEliminationOnNonSmallType
+ | _ -> WrongArity
-exception Arity of (constr * constr * string) option
+exception Arity of (constr * constr * arity_error) option
let is_correct_arity env kelim (c,pj) indf t =
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index 7e08a31c00..720ae3e4a7 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -46,7 +46,7 @@ val type_of_constructor : env -> constructor -> types
val arities_of_constructors : env -> inductive -> types array
-exception Arity of (constr * constr * string) option
+exception Arity of (constr * constr * Type_errors.arity_error) option
(* [type_case_branches env (I,args) (p:A) c] computes useful types
about the following Cases expression:
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml
index f1eb32b5bc..fc98a2ef16 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -34,6 +34,11 @@ type guard_error =
| RecCallInCasePred of constr
| NotGuardedForm
+type arity_error =
+ | NonInformativeToInformative
+ | StrongEliminationOnNonSmallType
+ | WrongArity
+
type type_error =
| UnboundRel of int
| UnboundVar of variable
@@ -41,7 +46,7 @@ type type_error =
| BadAssumption of unsafe_judgment
| ReferenceVariables of constr
| ElimArity of inductive * types list * constr * unsafe_judgment
- * (constr * constr * string) option
+ * (constr * constr * arity_error) option
| CaseNotInductive of unsafe_judgment
| WrongCaseInfo of inductive * case_info
| NumberBranches of unsafe_judgment * int
diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli
index 99b46877a8..a18ffd7e53 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -36,6 +36,11 @@ type guard_error =
| RecCallInCasePred of constr
| NotGuardedForm
+type arity_error =
+ | NonInformativeToInformative
+ | StrongEliminationOnNonSmallType
+ | WrongArity
+
type type_error =
| UnboundRel of int
| UnboundVar of variable
@@ -43,7 +48,7 @@ type type_error =
| BadAssumption of unsafe_judgment
| ReferenceVariables of constr
| ElimArity of inductive * types list * constr * unsafe_judgment
- * (constr * constr * string) option
+ * (constr * constr * arity_error) option
| CaseNotInductive of unsafe_judgment
| WrongCaseInfo of inductive * case_info
| NumberBranches of unsafe_judgment * int
@@ -71,7 +76,7 @@ val error_reference_variables : env -> constr -> 'a
val error_elim_arity :
env -> inductive -> types list -> constr
- -> unsafe_judgment -> (constr * constr * string) option -> 'a
+ -> unsafe_judgment -> (constr * constr * arity_error) option -> 'a
val error_case_not_inductive : env -> unsafe_judgment -> 'a