summaryrefslogtreecommitdiff
path: root/tactics/equality.ml
diff options
context:
space:
mode:
authorGravatar Stephane Glondu <steph@glondu.net>2011-12-25 13:19:42 +0100
committerGravatar Stephane Glondu <steph@glondu.net>2011-12-25 13:19:42 +0100
commit300293c119981054c95182a90c829058530a6b6f (patch)
treed7303613741c5796b58ced7db24ec7203327dbb2 /tactics/equality.ml
parent9d27ae09786866b6e3d7b79d1fa7667e5e2aa309 (diff)
Imported Upstream version 8.3.pl3upstream/8.3.pl3
Diffstat (limited to 'tactics/equality.ml')
-rw-r--r--tactics/equality.ml17
1 files changed, 14 insertions, 3 deletions
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 411ccc0e..a25f88e3 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -1,12 +1,12 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(* $Id: equality.ml 13874 2011-03-05 16:41:53Z herbelin $ *)
+(* $Id: equality.ml 14641 2011-11-06 11:59:10Z herbelin $ *)
open Pp
open Util
@@ -681,10 +681,21 @@ let gen_absurdity id gl =
absurd_term=False
*)
+let ind_scheme_of_eq lbeq =
+ let ind = destInd lbeq.eq in
+ let (mib,mip) = Global.lookup_inductive ind in
+ let kind = inductive_sort_family mip in
+ (* use ind rather than case by compatibility *)
+ let kind =
+ if kind = InProp then Elimschemes.ind_scheme_kind_from_prop
+ else Elimschemes.ind_scheme_kind_from_type in
+ mkConst (find_scheme kind ind)
+
+
let discrimination_pf e (t,t1,t2) discriminator lbeq =
let i = build_coq_I () in
let absurd_term = build_coq_False () in
- let eq_elim = lbeq.ind in
+ let eq_elim = ind_scheme_of_eq lbeq in
(applist (eq_elim, [t;t1;mkNamedLambda e t discriminator;i;t2]), absurd_term)
exception NotDiscriminable