aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel/type_errors.ml
diff options
context:
space:
mode:
authorGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2000-09-10 07:19:28 +0000
committerGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2000-09-10 07:19:28 +0000
commit79dc33cbc403ebab0bd1fe815c13f740f0a1b850 (patch)
treee38e167003d7dd97d95a59ea7c026a1629b346f8 /kernel/type_errors.ml
parentc0ff579606f2eba24bc834316d8bb7bcc076000d (diff)
Ajout d'un LetIn primitif.
Abstraction de constr via kind_of_constr dans une bonne partie du code. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@591 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel/type_errors.ml')
-rw-r--r--kernel/type_errors.ml24
1 files changed, 21 insertions, 3 deletions
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml
index 518809392..34dee81c8 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -9,6 +9,24 @@ open Environ
(* Type errors. *)
+type guard_error =
+ (* Fixpoints *)
+ | NotEnoughAbstractionInFixBody
+ | RecursionNotOnInductiveType
+ | RecursionOnIllegalTerm
+ | NotEnoughArgumentsForFixCall
+ (* CoFixpoints *)
+ | CodomainNotInductiveType of constr
+ | NestedRecursiveOccurrences
+ | UnguardedRecursiveCall of constr
+ | RecCallInTypeOfAbstraction of constr
+ | RecCallInNonRecArgOfConstructor of constr
+ | RecCallInTypeOfDef of constr
+ | RecCallInCaseFun of constr
+ | RecCallInCaseArg of constr
+ | RecCallInCasePred of constr
+ | NotGuardedForm
+
type type_error =
| UnboundRel of int
| NotAType of unsafe_judgment
@@ -24,7 +42,7 @@ type type_error =
| CantApplyBadType of (int * constr * constr)
* unsafe_judgment * unsafe_judgment list
| CantApplyNonFunctional of unsafe_judgment * unsafe_judgment list
- | IllFormedRecBody of std_ppcmds * name list * int * constr array
+ | IllFormedRecBody of guard_error * name list * int * constr array
| IllTypedRecBody of int * name list * unsafe_judgment array
* typed_type array
| NotInductive of constr
@@ -82,8 +100,8 @@ let error_cant_apply_not_functional k env rator randl =
let error_cant_apply_bad_type k env sigma t rator randl =
raise(TypeError (k, env_ise sigma env, CantApplyBadType (t,rator,randl)))
-let error_ill_formed_rec_body k env str lna i vdefs =
- raise (TypeError (k, env, IllFormedRecBody (str,lna,i,vdefs)))
+let error_ill_formed_rec_body k env why lna i vdefs =
+ raise (TypeError (k, env, IllFormedRecBody (why,lna,i,vdefs)))
let error_ill_typed_rec_body k env i lna vdefj vargs =
raise (TypeError (k, env, IllTypedRecBody (i,lna,vdefj,vargs)))