summaryrefslogtreecommitdiff
path: root/pretyping/retyping.ml
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping/retyping.ml')
-rw-r--r--pretyping/retyping.ml15
1 files changed, 8 insertions, 7 deletions
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 7fb4f7ba..502e238b 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -1,13 +1,11 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id: retyping.ml 14641 2011-11-06 11:59:10Z herbelin $ *)
-
open Util
open Term
open Inductive
@@ -48,8 +46,8 @@ let retype ?(polyprop=true) sigma =
let rec type_of env cstr=
match kind_of_term cstr with
| Meta n ->
- (try strip_outer_cast (Evd.meta_ftype sigma n).Evd.rebus
- with Not_found -> anomaly ("type_of: unknown meta " ^ string_of_int n))
+ (try strip_outer_cast (Evd.meta_ftype sigma n).Evd.rebus
+ with Not_found -> anomaly ("type_of: unknown meta " ^ string_of_int n))
| Rel n ->
let (_,_,ty) = lookup_rel n env in
lift n ty
@@ -129,10 +127,13 @@ let retype ?(polyprop=true) sigma =
match kind_of_term c with
| Ind ind ->
let (_,mip) = lookup_mind_specif env ind in
- Inductive.type_of_inductive_knowing_parameters ~polyprop env mip argtyps
+ (try Inductive.type_of_inductive_knowing_parameters
+ ~polyprop env mip argtyps
+ with Reduction.NotArity -> anomaly "type_of: Not an arity")
| Const cst ->
let t = constant_type env cst in
- Typeops.type_of_constant_knowing_parameters env t argtyps
+ (try Typeops.type_of_constant_knowing_parameters env t argtyps
+ with Reduction.NotArity -> anomaly "type_of: Not an arity")
| Var id -> type_of_var env id
| Construct cstr -> type_of_constructor env cstr
| _ -> assert false