diff options
Diffstat (limited to 'kernel/type_errors.ml')
| -rw-r--r-- | kernel/type_errors.ml | 38 |
1 files changed, 20 insertions, 18 deletions
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml index 320a303695..05b6e2675e 100644 --- a/kernel/type_errors.ml +++ b/kernel/type_errors.ml @@ -13,6 +13,7 @@ open Names open Term open Sign open Environ +open Reduction (* Type errors. *) @@ -39,10 +40,10 @@ type type_error = | NotAType of unsafe_judgment | BadAssumption of constr | ReferenceVariables of identifier - | ElimArity of inductive * constr list * constr * constr * constr + | ElimArity of inductive * constr list * constr * unsafe_judgment * (constr * constr * string) option - | CaseNotInductive of constr * constr - | NumberBranches of constr * constr * int + | CaseNotInductive of unsafe_judgment + | NumberBranches of unsafe_judgment * int | IllFormedBranch of constr * int * constr * constr | Generalization of (name * types) * unsafe_judgment | ActualType of constr * constr * constr @@ -55,11 +56,11 @@ type type_error = exception TypeError of path_kind * env * type_error -let env_ise sigma env = - map_context (Reduction.nf_ise1 sigma) env +let nfj {uj_val=c;uj_type=ct} = + {uj_val=c;uj_type=nf_betaiota ct} -let error_unbound_rel k env sigma n = - raise (TypeError (k, env_ise sigma env, UnboundRel n)) +let error_unbound_rel k env n = + raise (TypeError (k, env, UnboundRel n)) let error_not_type k env c = raise (TypeError (k, env, NotAType c)) @@ -70,20 +71,21 @@ let error_assumption k env c = let error_reference_variables k env id = raise (TypeError (k, env, ReferenceVariables id)) -let error_elim_arity k env ind aritylst c p pt okinds = - raise (TypeError (k, env, ElimArity (ind,aritylst,c,p,pt,okinds))) +let error_elim_arity k env ind aritylst c pj okinds = + raise (TypeError (k, env, ElimArity (ind,aritylst,c,pj,okinds))) -let error_case_not_inductive k env c ct = - raise (TypeError (k, env, CaseNotInductive (c,ct))) +let error_case_not_inductive k env j = + raise (TypeError (k, env, CaseNotInductive j)) -let error_number_branches k env c ct expn = - raise (TypeError (k, env, NumberBranches (c,ct,expn))) +let error_number_branches k env cj expn = + raise (TypeError (k, env, NumberBranches (nfj cj,expn))) let error_ill_formed_branch k env c i actty expty = - raise (TypeError (k, env, IllFormedBranch (c,i,actty,expty))) + raise (TypeError (k, env, + IllFormedBranch (c,i,nf_betaiota actty, nf_betaiota expty))) -let error_generalization k env sigma nvar c = - raise (TypeError (k, env_ise sigma env, Generalization (nvar,c))) +let error_generalization k env nvar c = + raise (TypeError (k, env, Generalization (nvar,c))) let error_actual_type k env c actty expty = raise (TypeError (k, env, ActualType (c,actty,expty))) @@ -91,8 +93,8 @@ let error_actual_type k env c actty expty = let error_cant_apply_not_functional k env rator randl = raise (TypeError (k, env, CantApplyNonFunctional (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_cant_apply_bad_type k env t rator randl = + raise(TypeError (k, env, CantApplyBadType (t,rator,randl))) let error_ill_formed_rec_body k env why lna i vdefs = raise (TypeError (k, env, IllFormedRecBody (why,lna,i,vdefs))) |
