Merge remote-tracking branch 'upstream/master' into fixdoc

197 files changed, 7774 insertions, 2877 deletions

diff --git a/.gitignore b/.gitignore
index a07b811..b661a7a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,11 +11,13 @@ Make*.coq.bak
 mathcomp/ssreflect/ssreflect.ml4
 mathcomp/ssreflect/ssrmatching.ml4
 mathcomp/ssreflect/ssrmatching.mli
-mathcomp/ssreflect/ssreflect.mllib
+mathcomp/ssreflect/ssreflect_plugin.mllib
+mathcomp/ssreflect/ssreflect_plugin.mlpack
 mathcomp/ssreflect.ml4
 mathcomp/ssrmatching.ml4
 mathcomp/ssrmatching.mli
-mathcomp/ssreflect.mllib
+mathcomp/ssreflect_plugin.mllib
+mathcomp/ssreflect_plugin.mlpack
 mathcomp-*.tar.gz
 *#
 htmldoc/mathcomp.*html
diff --git a/etc/ChangeLog b/etc/ChangeLog
index ee28d7d..e33edb4 100644
--- a/etc/ChangeLog
+++ b/etc/ChangeLog
@@ -1,3 +1,16 @@
+25/08/2016 - refactoring of algC and complex in ssrnum  - development version
+	* ssrnum's interface numClosedFieldType factors some theory from
+	  both complex and algC. Because of that Re, Im, 'i, conjC, n.-root
+	  and sqrtC are not specialized to algC anymore. In case of
+	  ambiguity, they should be instanciated with algC using typing
+	  constraints. Moreoever some lemmas from the theory like conjCK
+	  have an extra nonmaximal implicit argument (C :
+	  numClosedFieldType) which could break some proofs. Additionally,
+	  ad-hoc constructions from complex.v like -*+ or complex.Re are now
+	  deprecated and one should rely solely on the ssrnum interface. The
+	  next revision might definietly hide those constructions under a
+	  module.
+
 24/11/2015 - major reorganization of the archive - version 1.6
 	* Files split into subdirectories: ssreflect, algebra, fingroup,
 	  solvable, field and character. In this way the user can decide
diff --git a/mathcomp/Make b/mathcomp/Make
index a235149..ef657d5 100644
--- a/mathcomp/Make
+++ b/mathcomp/Make
@@ -128,7 +128,6 @@ ssreflect/seq.v
 ssreflect/ssrbool.v
 ssreflect/ssreflect.v
 ssreflect/ssrfun.v
-ssreflect/ssrmatching.v
 ssreflect/ssrnat.v
 ssreflect/tuple.v
 ssrtest/absevarprop.v
@@ -172,11 +171,7 @@ ssrtest/view_case.v
 ssrtest/wlogletin.v
 ssrtest/wlog_suff.v
 ssrtest/wlong_intro.v
-ssrtest/tacnotationpattern.v
 ssreflect.ml4
-ssreflect.mllib
-ssrmatching.ml4
-ssrmatching.mli
 
 -I .
 -R . mathcomp
diff --git a/mathcomp/algebra/finalg.v b/mathcomp/algebra/finalg.v
index 1c98465..0cf29b2 100644
--- a/mathcomp/algebra/finalg.v
+++ b/mathcomp/algebra/finalg.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/fraction.v b/mathcomp/algebra/fraction.v
index cfa13ed..8cf811a 100644
--- a/mathcomp/algebra/fraction.v
+++ b/mathcomp/algebra/fraction.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/intdiv.v b/mathcomp/algebra/intdiv.v
index 2871ff5..7c99443 100644
--- a/mathcomp/algebra/intdiv.v
+++ b/mathcomp/algebra/intdiv.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/interval.v b/mathcomp/algebra/interval.v
index 6806094..56dec94 100644
--- a/mathcomp/algebra/interval.v
+++ b/mathcomp/algebra/interval.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/matrix.v b/mathcomp/algebra/matrix.v
index 4469266..2aa117d 100644
--- a/mathcomp/algebra/matrix.v
+++ b/mathcomp/algebra/matrix.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/mxalgebra.v b/mathcomp/algebra/mxalgebra.v
index a0fa1c6..3b3ca5d 100644
--- a/mathcomp/algebra/mxalgebra.v
+++ b/mathcomp/algebra/mxalgebra.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/mxpoly.v b/mathcomp/algebra/mxpoly.v
index f64ad9a..1301a94 100644
--- a/mathcomp/algebra/mxpoly.v
+++ b/mathcomp/algebra/mxpoly.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/poly.v b/mathcomp/algebra/poly.v
index 1209289..22caa4a 100644
--- a/mathcomp/algebra/poly.v
+++ b/mathcomp/algebra/poly.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -2541,6 +2541,32 @@ Definition prim_rootP := prim_rootP.
 
 End UnityRootTheory.
 
+Section DecField.
+
+Variable F : decFieldType.
+
+Lemma dec_factor_theorem (p : {poly F}) :
+  {s : seq F & {q : {poly F} | p = q * \prod_(x <- s) ('X - x%:P)
+                             /\ (q != 0 -> forall x, ~~ root q x)}}.
+Proof.
+pose polyT (p : seq F) := (foldr (fun c f => f * 'X_0 + c%:T) (0%R)%:T p)%T.
+have eval_polyT (q : {poly F}) x : GRing.eval [:: x] (polyT q) = q.[x].
+  by rewrite /horner; elim: (val q) => //= ? ? ->.
+elim: size {-2}p (leqnn (size p)) => {p} [p|n IHn p].
+  by move=> /size_poly_leq0P->; exists [::], 0; rewrite mul0r eqxx.
+have /decPcases /= := @satP F [::] ('exists 'X_0, polyT p == 0%T).
+case: ifP => [_ /sig_eqW[x]|_ noroot]; last first.
+  exists [::], p; rewrite big_nil mulr1; split => // p_neq0 x.
+  by apply/negP=> /rootP rpx; apply noroot; exists x; rewrite eval_polyT.
+rewrite eval_polyT => /rootP /factor_theorem /sig_eqW [q ->].
+have [->|q_neq0] := eqVneq q 0; first by exists [::], 0; rewrite !mul0r eqxx.
+rewrite size_mul ?polyXsubC_eq0 // ?size_XsubC addn2 /= ltnS => sq_le_n.
+have [] // := IHn q => s [r [-> nr]]; exists (s ++ [::x]), r.
+by rewrite big_cat /= big_seq1 mulrA.
+Qed.
+
+End DecField.
+
 Module PreClosedField.
 Section UseAxiom.
 
@@ -2590,15 +2616,12 @@ Proof. exact: PreClosedField.closed_nonrootP. Qed.
 Lemma closed_field_poly_normal p :
   {r : seq F | p = lead_coef p *: \prod_(z <- r) ('X - z%:P)}.
 Proof.
-apply: sig_eqW; elim: {p}_.+1 {-2}p (ltnSn (size p)) => // n IHn p le_p_n.
-have [/size1_polyC-> | p_gt1] := leqP (size p) 1.
-  by exists nil; rewrite big_nil lead_coefC alg_polyC.
-have [|x /factor_theorem[q Dp]] := closed_rootP p _; first by rewrite gtn_eqF.
-have nz_p: p != 0 by rewrite -size_poly_eq0 -(subnKC p_gt1).
-have:= nz_p; rewrite Dp mulf_eq0 lead_coefM => /norP[nz_q nz_Xx].
-rewrite ltnS polySpred // Dp size_mul // size_XsubC addn2 in le_p_n.
-have [r {1}->] := IHn q le_p_n; exists (x :: r).
-by rewrite lead_coefXsubC mulr1 big_cons -scalerAl mulrC.
+apply: sig_eqW; have [r [q [->]]] /= := dec_factor_theorem p.
+have [->|] := altP eqP; first by exists [::]; rewrite mul0r lead_coef0 scale0r.
+have [[x rqx ? /(_ isT x) /negP /(_ rqx)] //|] := altP (closed_rootP q).
+rewrite negbK => /size_poly1P [c c_neq0-> _ _]; exists r.
+rewrite mul_polyC lead_coefZ (monicP _) ?mulr1 //.
+by rewrite monic_prod => // i; rewrite monicXsubC.
 Qed.
 
 End ClosedField.
diff --git a/mathcomp/algebra/polyXY.v b/mathcomp/algebra/polyXY.v
index a2acd5f..82a4afb 100644
--- a/mathcomp/algebra/polyXY.v
+++ b/mathcomp/algebra/polyXY.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/polydiv.v b/mathcomp/algebra/polydiv.v
index 1782d95..b5e1068 100644
--- a/mathcomp/algebra/polydiv.v
+++ b/mathcomp/algebra/polydiv.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/rat.v b/mathcomp/algebra/rat.v
index 9012291..d004748 100644
--- a/mathcomp/algebra/rat.v
+++ b/mathcomp/algebra/rat.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -11,8 +11,6 @@ Require Import bigop ssralg div ssrnum ssrint.
 (* structure of archimedean, real field, with int and nat declared as closed  *)
 (* subrings.                                                                  *)
 (*          rat == the type of rational number, with single constructor Rat   *)
-(*      Rat p h == the element of type rat build from p a pair of integers and*)
-(*                 h a proof of (0 < p.2) && coprime `|p.1| `|p.2|            *)
 (*         n%:Q == explicit cast from int to rat, postfix notation for the    *)
 (*                 ratz constant                                              *)
 (*       numq r == numerator of (r : rat)                                     *)
diff --git a/mathcomp/algebra/ring_quotient.v b/mathcomp/algebra/ring_quotient.v
index 1b9433e..8d8eaaf 100644
--- a/mathcomp/algebra/ring_quotient.v
+++ b/mathcomp/algebra/ring_quotient.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/ssralg.v b/mathcomp/algebra/ssralg.v
index a494f3f..9d93608 100644
--- a/mathcomp/algebra/ssralg.v
+++ b/mathcomp/algebra/ssralg.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -5107,6 +5107,12 @@ Variable F : closedFieldType.
 Lemma solve_monicpoly : ClosedField.axiom F.
 Proof. by case: F => ? []. Qed.
 
+Lemma imaginary_exists : {i : F | i ^+ 2 = -1}.
+Proof.
+have /sig_eqW[i Di2] := @solve_monicpoly 2 (nth 0 [:: -1]) isT.
+by exists i; rewrite Di2 !big_ord_recl big_ord0 mul0r mulr1 !addr0.
+Qed.
+
 End ClosedFieldTheory.
 
 Module SubType.
@@ -5741,6 +5747,7 @@ Definition rmorph_alg := rmorph_alg.
 Definition lrmorphismP := lrmorphismP.
 Definition can2_lrmorphism := can2_lrmorphism.
 Definition bij_lrmorphism := bij_lrmorphism.
+Definition imaginary_exists := imaginary_exists.
 
 Notation null_fun V := (null_fun V) (only parsing).
 Notation in_alg A := (in_alg_loc A).
diff --git a/mathcomp/algebra/ssrint.v b/mathcomp/algebra/ssrint.v
index a8b9a04..eb66940 100644
--- a/mathcomp/algebra/ssrint.v
+++ b/mathcomp/algebra/ssrint.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/ssrnum.v b/mathcomp/algebra/ssrnum.v
index b1c1746..219f804 100644
--- a/mathcomp/algebra/ssrnum.v
+++ b/mathcomp/algebra/ssrnum.v
@@ -1,8 +1,8 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
-Require Import ssrfun ssrbool eqtype ssrnat seq div choice fintype.
+Require Import ssrfun ssrbool eqtype ssrnat seq div choice fintype path.
 From mathcomp
 Require Import bigop ssralg finset fingroup zmodp poly.
 
@@ -60,17 +60,24 @@ Require Import bigop ssralg finset fingroup zmodp poly.
 (*                  == clone of a canonical archiFieldType structure on T     *)
 (*                                                                            *)
 (*   * RealClosedField (Real Field with the real closed axiom)                *)
-(*    realClosedFieldType                                                     *)
-(*                  == interface for a real closed field.                     *)
-(*   RealClosedFieldType T r                                                  *)
-(*                  == packs the real closed axiom r into a                   *)
-(*                     realClodedFieldType. The  carrier T must have a real   *)
+(*    rcfType       == interface for a real closed field.                     *)
+(*   RcfType T r    == packs the real closed axiom r into a                   *)
+(*                     rcfType. The  carrier T must have a real               *)
 (*                     field type structure.                                  *)
-(*  [realClosedFieldType of T for S ]                                         *)
-(*                  == T-clone of the realClosedFieldType structure  S.       *)
-(*  [realClosedFieldype of T]                                                 *)
-(*                  == clone of a canonical realClosedFieldType structure on  *)
+(*  [rcfType of T]  == clone of a canonical realClosedFieldType structure on  *)
 (*                     T.                                                     *)
+(*  [rcfType of T for S ]                                                     *)
+(*                  == T-clone of the realClosedFieldType structure  S.       *)
+(*                                                                            *)
+(*   * NumClosedField (Partially ordered Closed Field with conjugation)       *)
+(*    numClosedFieldType       == interface for a closed field with conj.     *)
+(*  NumClosedFieldType T r    == packs the real closed axiom r into a         *)
+(*                     numClosedFieldType. The  carrier T must have a closed  *)
+(*                     field type structure.                                  *)
+(*  [numClosedFieldType of T]  == clone of a canonical numClosedFieldType     *)
+(*                               structure on  T                              *)
+(*  [numClosedFieldType of T for S ]                                          *)
+(*                  == T-clone of the realClosedFieldType structure  S.       *)
 (*                                                                            *)
 (* Over these structures, we have the following operations                    *)
 (*            `|x| == norm of x.                                              *)
@@ -89,6 +96,18 @@ Require Import bigop ssralg finset fingroup zmodp poly.
 (*                     and n such that `|x| < n%:R.                           *)
 (*       Num.sqrt x == in a real-closed field, a positive square root of x if *)
 (*                     x >= 0, or 0 otherwise.                                *)
+(* For numeric algebraically closed fields we provide the generic definitions *)
+(*         'i == the imaginary number (:= sqrtC (-1)).                        *)
+(*      'Re z == the real component of z.                                     *)
+(*      'Im z == the imaginary component of z.                                *)
+(*        z^* == the complex conjugate of z (:= conjC z).                     *)
+(*    sqrtC z == a nonnegative square root of z, i.e., 0 <= sqrt x if 0 <= x. *)
+(*  n.-root z == more generally, for n > 0, an nth root of z, chosen with a   *)
+(*               minimal non-negative argument for n > 1 (i.e., with a        *)
+(*               maximal real part subject to a nonnegative imaginary part).  *)
+(*               Note that n.-root (-1) is a primitive 2nth root of unity,    *)
+(*               an thus not equal to -1 for n odd > 1 (this will be shown in *)
+(*               file cyclotomic.v).                                          *)
 (*                                                                            *)
 (*  There are now three distinct uses of the symbols <, <=, > and >=:         *)
 (*    0-ary, unary (prefix) and binary (infix).                               *)
@@ -401,9 +420,17 @@ Module ClosedField.
 
 Section ClassDef.
 
+Record imaginary_mixin_of (R : numDomainType) := ImaginaryMixin {
+  imaginary : R;
+  conj_op : {rmorphism R -> R};
+  _ : imaginary ^+ 2 = - 1;
+  _ : forall x, x * conj_op x = `|x| ^+ 2;
+}.
+
 Record class_of R := Class {
   base : GRing.ClosedField.class_of R;
-  mixin : mixin_of (ring_for R base)
+  mixin : mixin_of (ring_for R base);
+  conj_mixin : imaginary_mixin_of (num_for R (NumDomain.Class mixin))
 }.
 Definition base2 R (c : class_of R) := NumField.Class (mixin c).
 Local Coercion base : class_of >-> GRing.ClosedField.class_of.
@@ -419,7 +446,8 @@ Definition pack :=
   fun bT b & phant_id (GRing.ClosedField.class bT)
                       (b : GRing.ClosedField.class_of T) =>
   fun mT m & phant_id (NumField.class mT) (@NumField.Class T b m) =>
-  Pack (@Class T b m) T.
+  fun mc => Pack (@Class T b m mc) T.
+Definition clone := fun b & phant_id class (b : class_of T) => Pack b T.
 
 Definition eqType := @Equality.Pack cT xclass xT.
 Definition choiceType := @Choice.Pack cT xclass xT.
@@ -431,6 +459,7 @@ Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass xT.
 Definition idomainType := @GRing.IntegralDomain.Pack cT xclass xT.
 Definition numDomainType := @NumDomain.Pack cT xclass xT.
 Definition fieldType := @GRing.Field.Pack cT xclass xT.
+Definition numFieldType := @NumField.Pack cT xclass xT.
 Definition decFieldType := @GRing.DecidableField.Pack cT xclass xT.
 Definition closedFieldType := @GRing.ClosedField.Pack cT xclass xT.
 Definition join_dec_numDomainType := @NumDomain.Pack decFieldType xclass xT.
@@ -467,6 +496,8 @@ Coercion fieldType : type >-> GRing.Field.type.
 Canonical fieldType.
 Coercion decFieldType : type >-> GRing.DecidableField.type.
 Canonical decFieldType.
+Coercion numFieldType : type >-> NumField.type.
+Canonical numFieldType.
 Coercion closedFieldType : type >-> GRing.ClosedField.type.
 Canonical closedFieldType.
 Canonical join_dec_numDomainType.
@@ -474,7 +505,11 @@ Canonical join_dec_numFieldType.
 Canonical join_numDomainType.
 Canonical join_numFieldType.
 Notation numClosedFieldType := type.
-Notation "[ 'numClosedFieldType' 'of' T ]" := (@pack T _ _ id _ _ id)
+Notation NumClosedFieldType T m := (@pack T _ _ id _ _ id m).
+Notation "[ 'numClosedFieldType' 'of' T 'for' cT ]" := (@clone T cT _ id)
+  (at level 0, format "[ 'numClosedFieldType'  'of'  T  'for' cT ]") :
+                                                         form_scope.
+Notation "[ 'numClosedFieldType' 'of' T ]" := (@clone T _ _ id)
   (at level 0, format "[ 'numClosedFieldType'  'of'  T ]") : form_scope.
 End Exports.
 
@@ -4085,6 +4120,682 @@ Qed.
 
 End RealClosedFieldTheory.
 
+Definition conjC {C : numClosedFieldType} : {rmorphism C -> C} :=
+ ClosedField.conj_op (ClosedField.conj_mixin (ClosedField.class C)).
+Notation "z ^*" := (@conjC _ z) (at level 2, format "z ^*") : ring_scope.
+
+Definition imaginaryC {C : numClosedFieldType} : C :=
+ ClosedField.imaginary (ClosedField.conj_mixin (ClosedField.class C)).
+Notation "'i" := (@imaginaryC _) (at level 0) : ring_scope.
+
+Section ClosedFieldTheory.
+
+Variable C : numClosedFieldType.
+Implicit Types a x y z : C.
+
+Definition normCK x : `|x| ^+ 2 = x * x^*.
+Proof. by case: C x => ? [? ? []]. Qed.
+
+Lemma sqrCi : 'i ^+ 2 = -1 :> C.
+Proof. by case: C => ? [? ? []]. Qed.
+
+Lemma conjCK : involutive (@conjC C).
+Proof.
+have JE x : x^* = `|x|^+2 / x.
+  have [->|x_neq0] := eqVneq x 0; first by rewrite rmorph0 invr0 mulr0.
+  by apply: (canRL (mulfK _)) => //; rewrite mulrC -normCK.
+move=> x; have [->|x_neq0] := eqVneq x 0; first by rewrite !rmorph0.
+rewrite !JE normrM normfV exprMn normrX normr_id.
+rewrite invfM exprVn mulrA -[X in X * _]mulrA -invfM -exprMn.
+by rewrite divff ?mul1r ?invrK // !expf_eq0 normr_eq0 //.
+Qed.
+
+Let Re2 z := z + z^*.
+Definition nnegIm z := (0 <= imaginaryC * (z^* - z)).
+Definition argCle y z := nnegIm z ==> nnegIm y && (Re2 z <= Re2 y).
+
+CoInductive rootC_spec n (x : C) : Type :=
+  RootCspec (y : C) of if (n > 0)%N then y ^+ n = x else y = 0
+                        & forall z, (n > 0)%N -> z ^+ n = x -> argCle y z.
+
+Fact rootC_subproof n x : rootC_spec n x.
+Proof.
+have realRe2 u : Re2 u \is Num.real.
+  rewrite realEsqr expr2 {2}/Re2 -{2}[u]conjCK addrC -rmorphD -normCK.
+  by rewrite exprn_ge0 ?normr_ge0.
+have argCle_total : total argCle.
+  move=> u v; rewrite /total /argCle.
+  by do 2!case: (nnegIm _) => //; rewrite ?orbT //= real_leVge.
+have argCle_trans : transitive argCle.
+  move=> u v w /implyP geZuv /implyP geZvw; apply/implyP.
+  by case/geZvw/andP=> /geZuv/andP[-> geRuv] /ler_trans->.
+pose p := 'X^n - (x *+ (n > 0))%:P; have [r0 Dp] := closed_field_poly_normal p.
+have sz_p: size p = n.+1.
+  rewrite size_addl ?size_polyXn // ltnS size_opp size_polyC mulrn_eq0.
+  by case: posnP => //; case: negP.
+pose r := sort argCle r0; have r_arg: sorted argCle r by apply: sort_sorted.
+have{Dp} Dp: p = \prod_(z <- r) ('X - z%:P).
+  rewrite Dp lead_coefE sz_p coefB coefXn coefC -mulrb -mulrnA mulnb lt0n andNb.
+  rewrite subr0 eqxx scale1r; apply: eq_big_perm.
+  by rewrite perm_eq_sym perm_sort.
+have mem_rP z: (n > 0)%N -> reflect (z ^+ n = x) (z \in r).
+  move=> n_gt0; rewrite -root_prod_XsubC -Dp rootE !hornerE hornerXn n_gt0.
+  by rewrite subr_eq0; apply: eqP.
+exists r`_0 => [|z n_gt0 /(mem_rP z n_gt0) r_z].
+  have sz_r: size r = n by apply: succn_inj; rewrite -sz_p Dp size_prod_XsubC.
+  case: posnP => [n0 | n_gt0]; first by rewrite nth_default // sz_r n0.
+  by apply/mem_rP=> //; rewrite mem_nth ?sz_r.
+case: {Dp mem_rP}r r_z r_arg => // y r1; rewrite inE => /predU1P[-> _|r1z].
+  by apply/implyP=> ->; rewrite lerr.
+by move/(order_path_min argCle_trans)/allP->.
+Qed.
+
+Definition nthroot n x := let: RootCspec y _ _ := rootC_subproof n x in y.
+Notation "n .-root" := (nthroot n) (at level 2, format "n .-root") : ring_core_scope.
+Notation "n .-root" := (nthroot n) (only parsing) : ring_scope.
+Notation sqrtC := 2.-root.
+
+Definition Re x := (x + x^*) / 2%:R.
+Definition Im x := 'i * (x^* - x) / 2%:R.
+Notation "'Re z" := (Re z) (at level 10, z at level 8) : ring_scope.
+Notation "'Im z" := (Im z) (at level 10, z at level 8) : ring_scope.
+
+Let nz2 : 2%:R != 0 :> C. Proof. by rewrite pnatr_eq0. Qed.
+
+Lemma normCKC x : `|x| ^+ 2 = x^* * x. Proof. by rewrite normCK mulrC. Qed.
+
+Lemma mul_conjC_ge0 x : 0 <= x * x^*.
+Proof. by rewrite -normCK exprn_ge0 ?normr_ge0. Qed.
+
+Lemma mul_conjC_gt0 x : (0 < x * x^*) = (x != 0).
+Proof.
+have [->|x_neq0] := altP eqP; first by rewrite rmorph0 mulr0.
+by rewrite -normCK exprn_gt0 ?normr_gt0.
+Qed.
+
+Lemma mul_conjC_eq0 x : (x * x^* == 0) = (x == 0).
+Proof. by rewrite -normCK expf_eq0 normr_eq0. Qed.
+
+Lemma conjC_ge0 x : (0 <= x^*) = (0 <= x).
+Proof.
+wlog suffices: x / 0 <= x -> 0 <= x^*.
+  by move=> IH; apply/idP/idP=> /IH; rewrite ?conjCK.
+rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite rmorph0.
+by rewrite -(pmulr_rge0 _ x_gt0) mul_conjC_ge0.
+Qed.
+
+Lemma conjC_nat n : (n%:R)^* = n%:R :> C. Proof. exact: rmorph_nat. Qed.
+Lemma conjC0 : 0^* = 0 :> C. Proof. exact: rmorph0. Qed.
+Lemma conjC1 : 1^* = 1 :> C. Proof. exact: rmorph1. Qed.
+Lemma conjC_eq0 x : (x^* == 0) = (x == 0). Proof. exact: fmorph_eq0. Qed.
+
+Lemma invC_norm x : x^-1 = `|x| ^- 2 * x^*.
+Proof.
+have [-> | nx_x] := eqVneq x 0; first by rewrite conjC0 mulr0 invr0.
+by rewrite normCK invfM divfK ?conjC_eq0.
+Qed.
+
+(* Real number subset. *)
+
+Lemma CrealE x : (x \is real) = (x^* == x).
+Proof.
+rewrite realEsqr ger0_def normrX normCK.
+by have [-> | /mulfI/inj_eq-> //] := eqVneq x 0; rewrite rmorph0 !eqxx.
+Qed.
+
+Lemma CrealP {x} : reflect (x^* = x) (x \is real).
+Proof. by rewrite CrealE; apply: eqP. Qed.
+
+Lemma conj_Creal x : x \is real -> x^* = x.
+Proof. by move/CrealP. Qed.
+
+Lemma conj_normC z : `|z|^* = `|z|.
+Proof. by rewrite conj_Creal ?normr_real. Qed.
+
+Lemma geC0_conj x : 0 <= x -> x^* = x.
+Proof. by move=> /ger0_real/CrealP. Qed.
+
+Lemma geC0_unit_exp x n : 0 <= x -> (x ^+ n.+1 == 1) = (x == 1).
+Proof. by move=> x_ge0; rewrite pexpr_eq1. Qed.
+
+(* Elementary properties of roots. *)
+
+Ltac case_rootC := rewrite /nthroot; case: (rootC_subproof _ _).
+
+Lemma root0C x : 0.-root x = 0. Proof. by case_rootC. Qed.
+
+Lemma rootCK n : (n > 0)%N -> cancel n.-root (fun x => x ^+ n).
+Proof. by case: n => //= n _ x; case_rootC. Qed.
+
+Lemma root1C x : 1.-root x = x. Proof. exact: (@rootCK 1). Qed.
+
+Lemma rootC0 n : n.-root 0 = 0.
+Proof.
+have [-> | n_gt0] := posnP n; first by rewrite root0C.
+by have /eqP := rootCK n_gt0 0; rewrite expf_eq0 n_gt0 /= => /eqP.
+Qed.
+
+Lemma rootC_inj n : (n > 0)%N -> injective n.-root.
+Proof. by move/rootCK/can_inj. Qed.
+
+Lemma eqr_rootC n : (n > 0)%N -> {mono n.-root : x y / x == y}.
+Proof. by move/rootC_inj/inj_eq. Qed.
+
+Lemma rootC_eq0 n x : (n > 0)%N -> (n.-root x == 0) = (x == 0).
+Proof. by move=> n_gt0; rewrite -{1}(rootC0 n) eqr_rootC. Qed.
+
+(* Rectangular coordinates. *)
+
+Lemma nonRealCi : ('i : C) \isn't real.
+Proof. by rewrite realEsqr sqrCi oppr_ge0 ltr_geF ?ltr01. Qed.
+
+Lemma neq0Ci : 'i != 0 :> C.
+Proof. by apply: contraNneq nonRealCi => ->; apply: real0. Qed.
+
+Lemma normCi : `|'i| = 1 :> C.
+Proof.
+apply/eqP; rewrite -(@pexpr_eq1 _ _ 2) ?normr_ge0 //.
+by rewrite -normrX sqrCi normrN1.
+Qed.
+
+Lemma invCi : 'i^-1 = - 'i :> C.
+Proof. by rewrite -div1r -[1]opprK -sqrCi mulNr mulfK ?neq0Ci. Qed.
+
+Lemma conjCi : 'i^* = - 'i :> C.
+Proof. by rewrite -invCi invC_norm normCi expr1n invr1 mul1r. Qed.
+
+Lemma Crect x : x = 'Re x + 'i * 'Im x.
+Proof.
+rewrite 2!mulrA -expr2 sqrCi mulN1r opprB -mulrDl addrACA subrr addr0.
+by rewrite -mulr2n -mulr_natr mulfK.
+Qed.
+
+Lemma Creal_Re x : 'Re x \is real.
+Proof. by rewrite CrealE fmorph_div rmorph_nat rmorphD conjCK addrC. Qed.
+
+Lemma Creal_Im x : 'Im x \is real.
+Proof.
+rewrite CrealE fmorph_div rmorph_nat rmorphM rmorphB conjCK.
+by rewrite conjCi -opprB mulrNN.
+Qed.
+Hint Resolve Creal_Re Creal_Im.
+
+Fact Re_is_additive : additive Re.
+Proof. by move=> x y; rewrite /Re rmorphB addrACA -opprD mulrBl. Qed.
+Canonical Re_additive := Additive Re_is_additive.
+
+Fact Im_is_additive : additive Im.
+Proof.
+by move=> x y; rewrite /Im rmorphB opprD addrACA -opprD mulrBr mulrBl.
+Qed.
+Canonical Im_additive := Additive Im_is_additive.
+
+Lemma Creal_ImP z : reflect ('Im z = 0) (z \is real).
+Proof.
+rewrite CrealE -subr_eq0 -(can_eq (mulKf neq0Ci)) mulr0.
+by rewrite -(can_eq (divfK nz2)) mul0r; apply: eqP.
+Qed.
+
+Lemma Creal_ReP z : reflect ('Re z = z) (z \in real).
+Proof.
+rewrite (sameP (Creal_ImP z) eqP) -(can_eq (mulKf neq0Ci)) mulr0.
+by rewrite -(inj_eq (addrI ('Re z))) addr0 -Crect eq_sym; apply: eqP.
+Qed.
+
+Lemma ReMl : {in real, forall x, {morph Re : z / x * z}}.
+Proof.
+by move=> x Rx z /=; rewrite /Re rmorphM (conj_Creal Rx) -mulrDr -mulrA.
+Qed.
+
+Lemma ReMr : {in real, forall x, {morph Re : z / z * x}}.
+Proof. by move=> x Rx z /=; rewrite mulrC ReMl // mulrC. Qed.
+
+Lemma ImMl : {in real, forall x, {morph Im : z / x * z}}.
+Proof.
+by move=> x Rx z; rewrite /Im rmorphM (conj_Creal Rx) -mulrBr mulrCA !mulrA.
+Qed.
+
+Lemma ImMr : {in real, forall x, {morph Im : z / z * x}}.
+Proof. by move=> x Rx z /=; rewrite mulrC ImMl // mulrC. Qed.
+
+Lemma Re_i : 'Re 'i = 0. Proof. by rewrite /Re conjCi subrr mul0r. Qed.
+
+Lemma Im_i : 'Im 'i = 1.
+Proof.
+rewrite /Im conjCi -opprD mulrN -mulr2n mulrnAr ['i * _]sqrCi.
+by rewrite mulNrn opprK divff.
+Qed.
+
+Lemma Re_conj z : 'Re z^* = 'Re z.
+Proof. by rewrite /Re addrC conjCK. Qed.
+
+Lemma Im_conj z : 'Im z^* = - 'Im z.
+Proof. by rewrite /Im -mulNr -mulrN opprB conjCK. Qed.
+
+Lemma Re_rect : {in real &, forall x y, 'Re (x + 'i * y) = x}.
+Proof.
+move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ReP x Rx).
+by rewrite ReMr // Re_i mul0r addr0.
+Qed.
+
+Lemma Im_rect : {in real &, forall x y, 'Im (x + 'i * y) = y}.
+Proof.
+move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ImP x Rx) add0r.
+by rewrite ImMr // Im_i mul1r.
+Qed.
+
+Lemma conjC_rect : {in real &, forall x y, (x + 'i * y)^* = x - 'i * y}.
+Proof.
+by move=> x y Rx Ry; rewrite /= rmorphD rmorphM conjCi mulNr !conj_Creal.
+Qed.
+
+Lemma addC_rect x1 y1 x2 y2 :
+  (x1 + 'i * y1) + (x2 + 'i * y2) = x1 + x2 + 'i * (y1 + y2).
+Proof. by rewrite addrACA -mulrDr. Qed.
+
+Lemma oppC_rect x y : - (x + 'i * y)  = - x + 'i * (- y).
+Proof. by rewrite mulrN -opprD. Qed.
+
+Lemma subC_rect x1 y1 x2 y2 :
+  (x1 + 'i * y1) - (x2 + 'i * y2) = x1 - x2 + 'i * (y1 - y2).
+Proof. by rewrite oppC_rect addC_rect. Qed.
+
+Lemma mulC_rect x1 y1 x2 y2 :
+  (x1 + 'i * y1) * (x2 + 'i * y2)
+      = x1 * x2 - y1 * y2 + 'i * (x1 * y2 + x2 * y1).
+Proof.
+rewrite mulrDl !mulrDr mulrCA -!addrA mulrAC -mulrA; congr (_ + _).
+by rewrite mulrACA -expr2 sqrCi mulN1r addrA addrC.
+Qed.
+
+Lemma normC2_rect :
+  {in real &, forall x y, `|x + 'i * y| ^+ 2 = x ^+ 2 + y ^+ 2}.
+Proof.
+move=> x y Rx Ry; rewrite /= normCK rmorphD rmorphM conjCi !conj_Creal //.
+by rewrite mulrC mulNr -subr_sqr exprMn sqrCi mulN1r opprK.
+Qed.
+
+Lemma normC2_Re_Im z : `|z| ^+ 2 = 'Re z ^+ 2 + 'Im z ^+ 2.
+Proof. by rewrite -normC2_rect -?Crect. Qed.
+
+Lemma invC_rect :
+  {in real &, forall x y, (x + 'i * y)^-1  = (x - 'i * y) / (x ^+ 2 + y ^+ 2)}.
+Proof.
+by move=> x y Rx Ry; rewrite /= invC_norm conjC_rect // mulrC normC2_rect.
+Qed.
+
+Lemma lerif_normC_Re_Creal z : `|'Re z| <= `|z| ?= iff (z \is real).
+Proof.
+rewrite -(mono_in_lerif ler_sqr); try by rewrite qualifE normr_ge0.
+rewrite normCK conj_Creal // normC2_Re_Im -expr2.
+rewrite addrC -lerif_subLR subrr (sameP (Creal_ImP _) eqP) -sqrf_eq0 eq_sym.
+by apply: lerif_eq; rewrite -realEsqr.
+Qed.
+
+Lemma lerif_Re_Creal z : 'Re z <= `|z| ?= iff (0 <= z).
+Proof.
+have ubRe: 'Re z <= `|'Re z| ?= iff (0 <= 'Re z).
+  by rewrite ger0_def eq_sym; apply/lerif_eq/real_ler_norm.
+congr (_ <= _ ?= iff _): (lerif_trans ubRe (lerif_normC_Re_Creal z)).
+apply/andP/idP=> [[zRge0 /Creal_ReP <- //] | z_ge0].
+by have Rz := ger0_real z_ge0; rewrite (Creal_ReP _ _).
+Qed.
+
+(* Equality from polar coordinates, for the upper plane. *)
+Lemma eqC_semipolar x y :
+  `|x| = `|y| -> 'Re x = 'Re y -> 0 <= 'Im x * 'Im y -> x = y.
+Proof.
+move=> eq_norm eq_Re sign_Im.
+rewrite [x]Crect [y]Crect eq_Re; congr (_ + 'i * _).
+have /eqP := congr1 (fun z => z ^+ 2) eq_norm.
+rewrite !normC2_Re_Im eq_Re (can_eq (addKr _)) eqf_sqr => /pred2P[] // eq_Im.
+rewrite eq_Im mulNr -expr2 oppr_ge0 real_exprn_even_le0 //= in sign_Im.
+by rewrite eq_Im (eqP sign_Im) oppr0.
+Qed.
+
+(* Nth roots. *)
+
+Let argCleP y z :
+  reflect (0 <= 'Im z -> 0 <= 'Im y /\ 'Re z <= 'Re y) (argCle y z).
+Proof.
+suffices dIm x: nnegIm x = (0 <= 'Im x).
+  rewrite /argCle !dIm ler_pmul2r ?invr_gt0 ?ltr0n //.
+  by apply: (iffP implyP) => geZyz /geZyz/andP.
+by rewrite /('Im x) pmulr_lge0 ?invr_gt0 ?ltr0n //; congr (0 <= _ * _).
+Qed.
+(* case Du: sqrCi => [u u2N1] /=. *)
+(* have/eqP := u2N1; rewrite -sqrCi eqf_sqr => /pred2P[] //. *)
+(* have:= conjCi; rewrite /'i; case_rootC => /= v v2n1 min_v conj_v Duv. *)
+(* have{min_v} /idPn[] := min_v u isT u2N1; rewrite negb_imply /nnegIm Du /= Duv. *)
+(* rewrite rmorphN conj_v opprK -opprD mulrNN mulNr -mulr2n mulrnAr -expr2 v2n1. *)
+(* by rewrite mulNrn opprK ler0n oppr_ge0 (ler_nat _ 2 0). *)
+
+
+Lemma rootC_Re_max n x y :
+  (n > 0)%N -> y ^+ n = x -> 0 <= 'Im y -> 'Re y <= 'Re (n.-root x).
+Proof.
+by move=> n_gt0 yn_x leI0y; case_rootC=> z /= _ /(_ y n_gt0 yn_x)/argCleP[].
+Qed.
+
+Let neg_unity_root n : (n > 1)%N -> exists2 w : C, w ^+ n = 1 & 'Re w < 0.
+Proof.
+move=> n_gt1; have [|w /eqP pw_0] := closed_rootP (\poly_(i < n) (1 : C)) _.
+  by rewrite size_poly_eq ?oner_eq0 // -(subnKC n_gt1).
+rewrite horner_poly (eq_bigr _ (fun _ _ => mul1r _)) in pw_0.
+have wn1: w ^+ n = 1 by apply/eqP; rewrite -subr_eq0 subrX1 pw_0 mulr0.
+suffices /existsP[i ltRwi0]: [exists i : 'I_n, 'Re (w ^+ i) < 0].
+  by exists (w ^+ i) => //; rewrite exprAC wn1 expr1n.
+apply: contra_eqT (congr1 Re pw_0); rewrite negb_exists => /forallP geRw0.
+rewrite raddf_sum raddf0 /= (bigD1 (Ordinal (ltnW n_gt1))) //=.
+rewrite (Creal_ReP _ _) ?rpred1 // gtr_eqF ?ltr_paddr ?ltr01 //=.
+by apply: sumr_ge0 => i _; rewrite real_lerNgt ?rpred0.
+Qed.
+
+Lemma Im_rootC_ge0 n x : (n > 1)%N -> 0 <= 'Im (n.-root x).
+Proof.
+set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1.
+apply: wlog_neg; rewrite -real_ltrNge ?rpred0 // => ltIy0.
+suffices [z zn_x leI0z]: exists2 z, z ^+ n = x & 'Im z >= 0.
+  by rewrite /y; case_rootC => /= y1 _ /(_ z n_gt0 zn_x)/argCleP[].
+have [w wn1 ltRw0] := neg_unity_root n_gt1.
+wlog leRI0yw: w wn1 ltRw0 / 0 <= 'Re y * 'Im w.
+  move=> IHw; have: 'Re y * 'Im w \is real by rewrite rpredM.
+  case/real_ger0P=> [|/ltrW leRIyw0]; first exact: IHw.
+  apply: (IHw w^*); rewrite ?Re_conj ?Im_conj ?mulrN ?oppr_ge0 //.
+  by rewrite -rmorphX wn1 rmorph1.
+exists (w * y); first by rewrite exprMn wn1 mul1r rootCK.
+rewrite [w]Crect [y]Crect mulC_rect.
+by rewrite Im_rect ?rpredD ?rpredN 1?rpredM // addr_ge0 // ltrW ?nmulr_rgt0.
+Qed.
+
+Lemma rootC_lt0 n x : (1 < n)%N -> (n.-root x < 0) = false.
+Proof.
+set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1.
+apply: negbTE; apply: wlog_neg => /negbNE lt0y; rewrite ler_gtF //.
+have Rx: x \is real by rewrite -[x](rootCK n_gt0) rpredX // ltr0_real.
+have Re_y: 'Re y = y by apply/Creal_ReP; rewrite ltr0_real.
+have [z zn_x leR0z]: exists2 z, z ^+ n = x & 'Re z >= 0.
+  have [w wn1 ltRw0] := neg_unity_root n_gt1.
+  exists (w * y); first by rewrite exprMn wn1 mul1r rootCK.
+  by rewrite ReMr ?ltr0_real // ltrW // nmulr_lgt0.
+without loss leI0z: z zn_x leR0z / 'Im z >= 0.
+  move=> IHz; have: 'Im z \is real by [].
+  case/real_ger0P=> [|/ltrW leIz0]; first exact: IHz.
+  apply: (IHz z^*); rewrite ?Re_conj ?Im_conj ?oppr_ge0 //.
+  by rewrite -rmorphX zn_x conj_Creal.
+by apply: ler_trans leR0z _; rewrite -Re_y ?rootC_Re_max ?ltr0_real.
+Qed.
+
+Lemma rootC_ge0 n x : (n > 0)%N -> (0 <= n.-root x) = (0 <= x).
+Proof.
+set y := n.-root x => n_gt0.
+apply/idP/idP=> [/(exprn_ge0 n) | x_ge0]; first by rewrite rootCK.
+rewrite -(ger_lerif (lerif_Re_Creal y)).
+have Ray: `|y| \is real by apply: normr_real.
+rewrite -(Creal_ReP _ Ray) rootC_Re_max ?(Creal_ImP _ Ray) //.
+by rewrite -normrX rootCK // ger0_norm.
+Qed.
+
+Lemma rootC_gt0 n x : (n > 0)%N -> (n.-root x > 0) = (x > 0).
+Proof. by move=> n_gt0; rewrite !lt0r rootC_ge0 ?rootC_eq0. Qed.
+
+Lemma rootC_le0 n x : (1 < n)%N -> (n.-root x <= 0) = (x == 0).
+Proof.
+by move=> n_gt1; rewrite ler_eqVlt rootC_lt0 // orbF rootC_eq0 1?ltnW.
+Qed.
+
+Lemma ler_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x <= y}}.
+Proof.
+move=> n_gt0 x x_ge0 y; have [y_ge0 | not_y_ge0] := boolP (0 <= y).
+  by rewrite -(ler_pexpn2r n_gt0) ?qualifE ?rootC_ge0 ?rootCK.
+rewrite (contraNF (@ler_trans _ _ 0 _ _)) ?rootC_ge0 //.
+by rewrite (contraNF (ler_trans x_ge0)).
+Qed.
+
+Lemma ler_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x <= y}}.
+Proof. by move=> n_gt0 x y x_ge0 _; apply: ler_rootCl. Qed.
+
+Lemma ltr_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x < y}}.
+Proof. by move=> n_gt0 x x_ge0 y; rewrite !ltr_def ler_rootCl ?eqr_rootC. Qed.
+
+Lemma ltr_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x < y}}.
+Proof. by move/ler_rootC/lerW_mono_in. Qed.
+
+Lemma exprCK n x : (0 < n)%N -> 0 <= x -> n.-root (x ^+ n) = x.
+Proof.
+move=> n_gt0 x_ge0; apply/eqP.
+by rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?exprn_ge0 ?rootCK.
+Qed.
+
+Lemma norm_rootC n x : `|n.-root x| = n.-root `|x|.
+Proof.
+have [-> | n_gt0] := posnP n; first by rewrite !root0C normr0.
+apply/eqP; rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?normr_ge0 //.
+by rewrite -normrX !rootCK.
+Qed.
+
+Lemma rootCX n x k : (n > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k.
+Proof.
+move=> n_gt0 x_ge0; apply/eqP.
+by rewrite -(eqr_expn2 n_gt0) ?(exprn_ge0, rootC_ge0) // 1?exprAC !rootCK.
+Qed.
+
+Lemma rootC1 n : (n > 0)%N -> n.-root 1 = 1.
+Proof. by move/(rootCX 0)/(_ ler01). Qed.
+
+Lemma rootCpX n x k : (k > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k.
+Proof.
+by case: n => [|n] k_gt0; [rewrite !root0C expr0n gtn_eqF | apply: rootCX].
+Qed.
+
+Lemma rootCV n x : (n > 0)%N -> 0 <= x -> n.-root x^-1 = (n.-root x)^-1.
+Proof.
+move=> n_gt0 x_ge0; apply/eqP.
+by rewrite -(eqr_expn2 n_gt0) ?(invr_ge0, rootC_ge0) // !exprVn !rootCK.
+Qed.
+
+Lemma rootC_eq1 n x : (n > 0)%N -> (n.-root x == 1) = (x == 1).
+Proof. by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) eqr_rootC. Qed.
+
+Lemma rootC_ge1 n x : (n > 0)%N -> (n.-root x >= 1) = (x >= 1).
+Proof.
+by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) ler_rootCl // qualifE ler01.
+Qed.
+
+Lemma rootC_gt1 n x : (n > 0)%N -> (n.-root x > 1) = (x > 1).
+Proof. by move=> n_gt0; rewrite !ltr_def rootC_eq1 ?rootC_ge1. Qed.
+
+Lemma rootC_le1 n x : (n > 0)%N -> 0 <= x -> (n.-root x <= 1) = (x <= 1).
+Proof. by move=> n_gt0 x_ge0; rewrite -{1}(rootC1 n_gt0) ler_rootCl. Qed.
+
+Lemma rootC_lt1 n x : (n > 0)%N -> 0 <= x -> (n.-root x < 1) = (x < 1).
+Proof. by move=> n_gt0 x_ge0; rewrite !ltr_neqAle rootC_eq1 ?rootC_le1. Qed.
+
+Lemma rootCMl n x z : 0 <= x -> n.-root (x * z) = n.-root x * n.-root z.
+Proof.
+rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite !(mul0r, rootC0).
+have [| n_gt1 | ->] := ltngtP n 1; last by rewrite !root1C.
+  by case: n => //; rewrite !root0C mul0r.
+have [x_ge0 n_gt0] := (ltrW x_gt0, ltnW n_gt1).
+have nx_gt0: 0 < n.-root x by rewrite rootC_gt0.
+have Rnx: n.-root x \is real by rewrite ger0_real ?ltrW.
+apply: eqC_semipolar; last 1 first; try apply/eqP.
+- by rewrite ImMl // !(Im_rootC_ge0, mulr_ge0, rootC_ge0).
+- by rewrite -(eqr_expn2 n_gt0) ?normr_ge0 // -!normrX exprMn !rootCK.
+rewrite eqr_le; apply/andP; split; last first.
+  rewrite rootC_Re_max ?exprMn ?rootCK ?ImMl //.
+  by rewrite mulr_ge0 ?Im_rootC_ge0 ?ltrW.
+rewrite -[n.-root _](mulVKf (negbT (gtr_eqF nx_gt0))) !(ReMl Rnx) //.
+rewrite ler_pmul2l // rootC_Re_max ?exprMn ?exprVn ?rootCK ?mulKf ?gtr_eqF //.
+by rewrite ImMl ?rpredV // mulr_ge0 ?invr_ge0 ?Im_rootC_ge0 ?ltrW.
+Qed.
+
+Lemma rootCMr n x z : 0 <= x -> n.-root (z * x) = n.-root z * n.-root x.
+Proof. by move=> x_ge0; rewrite mulrC rootCMl // mulrC. Qed.
+
+Lemma imaginaryCE : 'i = sqrtC (-1).
+Proof.
+have : sqrtC (-1) ^+ 2 - 'i ^+ 2 == 0 by rewrite sqrCi rootCK // subrr.
+rewrite subr_sqr mulf_eq0 subr_eq0 addr_eq0; have [//|_/= /eqP sCN1E] := eqP.
+by have := @Im_rootC_ge0 2 (-1) isT; rewrite sCN1E raddfN /= Im_i ler0N1.
+Qed.
+
+(* More properties of n.-root will be established in cyclotomic.v. *)
+
+(* The proper form of the Arithmetic - Geometric Mean inequality. *)
+
+Lemma lerif_rootC_AGM (I : finType) (A : pred I) (n := #|A|) E :
+    {in A, forall i, 0 <= E i} ->
+  n.-root (\prod_(i in A) E i) <= (\sum_(i in A) E i) / n%:R
+                             ?= iff [forall i in A, forall j in A, E i == E j].
+Proof.
+move=> Ege0; have [n0 | n_gt0] := posnP n.
+  rewrite n0 root0C invr0 mulr0; apply/lerif_refl/forall_inP=> i.
+  by rewrite (card0_eq n0).
+rewrite -(mono_in_lerif (ler_pexpn2r n_gt0)) ?rootCK //=; first 1 last.
+- by rewrite qualifE rootC_ge0 // prodr_ge0.
+- by rewrite rpred_div ?rpred_nat ?rpred_sum.
+exact: lerif_AGM.
+Qed.
+
+(* Square root. *)
+
+Lemma sqrtC0 : sqrtC 0 = 0. Proof. exact: rootC0. Qed.
+Lemma sqrtC1 : sqrtC 1 = 1. Proof. exact: rootC1. Qed.
+Lemma sqrtCK x : sqrtC x ^+ 2 = x. Proof. exact: rootCK. Qed.
+Lemma sqrCK x : 0 <= x -> sqrtC (x ^+ 2) = x. Proof. exact: exprCK. Qed.
+
+Lemma sqrtC_ge0 x : (0 <= sqrtC x) = (0 <= x). Proof. exact: rootC_ge0. Qed.
+Lemma sqrtC_eq0 x : (sqrtC x == 0) = (x == 0). Proof. exact: rootC_eq0. Qed.
+Lemma sqrtC_gt0 x : (sqrtC x > 0) = (x > 0). Proof. exact: rootC_gt0. Qed.
+Lemma sqrtC_lt0 x : (sqrtC x < 0) = false. Proof. exact: rootC_lt0. Qed.
+Lemma sqrtC_le0 x : (sqrtC x <= 0) = (x == 0). Proof. exact: rootC_le0. Qed.
+
+Lemma ler_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x <= y}}.
+Proof. exact: ler_rootC. Qed.
+Lemma ltr_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x < y}}.
+Proof. exact: ltr_rootC. Qed.
+Lemma eqr_sqrtC : {mono sqrtC : x y / x == y}.
+Proof. exact: eqr_rootC. Qed.
+Lemma sqrtC_inj : injective sqrtC.
+Proof. exact: rootC_inj. Qed.
+Lemma sqrtCM : {in Num.nneg &, {morph sqrtC : x y / x * y}}.
+Proof. by move=> x y _; apply: rootCMr. Qed.
+
+Lemma sqrCK_P x : reflect (sqrtC (x ^+ 2) = x) ((0 <= 'Im x) && ~~ (x < 0)).
+Proof.
+apply: (iffP andP) => [[leI0x not_gt0x] | <-]; last first.
+  by rewrite sqrtC_lt0 Im_rootC_ge0.
+have /eqP := sqrtCK (x ^+ 2); rewrite eqf_sqr => /pred2P[] // defNx.
+apply: sqrCK; rewrite -real_lerNgt ?rpred0 // in not_gt0x;
+apply/Creal_ImP/ler_anti;
+by rewrite leI0x -oppr_ge0 -raddfN -defNx Im_rootC_ge0.
+Qed.
+
+Lemma normC_def x : `|x| = sqrtC (x * x^*).
+Proof. by rewrite -normCK sqrCK ?normr_ge0. Qed.
+
+Lemma norm_conjC x : `|x^*| = `|x|.
+Proof. by rewrite !normC_def conjCK mulrC. Qed.
+
+Lemma normC_rect :
+  {in real &, forall x y, `|x + 'i * y| = sqrtC (x ^+ 2 + y ^+ 2)}.
+Proof. by move=> x y Rx Ry; rewrite /= normC_def -normCK normC2_rect. Qed.
+
+Lemma normC_Re_Im z : `|z| = sqrtC ('Re z ^+ 2 + 'Im z ^+ 2).
+Proof. by rewrite normC_def -normCK normC2_Re_Im. Qed.
+
+(* Norm sum (in)equalities. *)
+
+Lemma normC_add_eq x y :
+    `|x + y| = `|x| + `|y| ->
+  {t : C | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}.
+Proof.
+move=> lin_xy; apply: sig2_eqW; pose u z := if z == 0 then 1 else z / `|z|.
+have uE z: (`|u z| = 1) * (`|z| * u z = z).
+  rewrite /u; have [->|nz_z] := altP eqP; first by rewrite normr0 normr1 mul0r.
+  by rewrite normf_div normr_id mulrCA divff ?mulr1 ?normr_eq0.
+have [->|nz_x] := eqVneq x 0; first by exists (u y); rewrite uE ?normr0 ?mul0r.
+exists (u x); rewrite uE // /u (negPf nz_x); congr (_ , _).
+have{lin_xy} def2xy: `|x| * `|y| *+ 2 = x * y ^* + y * x ^*.
+  apply/(addrI (x * x^*))/(addIr (y * y^*)); rewrite -2!{1}normCK -sqrrD.
+  by rewrite addrA -addrA -!mulrDr -mulrDl -rmorphD -normCK lin_xy.
+have def_xy: x * y^* = y * x^*.
+  apply/eqP; rewrite -subr_eq0 -[_ == 0](@expf_eq0 _ _ 2).
+  rewrite (canRL (subrK _) (subr_sqrDB _ _)) opprK -def2xy exprMn_n exprMn.
+  by rewrite mulrN mulrAC mulrA -mulrA mulrACA -!normCK mulNrn addNr.
+have{def_xy def2xy} def_yx: `|y * x| = y * x^*.
+  by apply: (mulIf nz2); rewrite !mulr_natr mulrC normrM def2xy def_xy.
+rewrite -{1}(divfK nz_x y) invC_norm mulrCA -{}def_yx !normrM invfM.
+by rewrite mulrCA divfK ?normr_eq0 // mulrAC mulrA.
+Qed.
+
+Lemma normC_sum_eq (I : finType) (P : pred I) (F : I -> C) :
+     `|\sum_(i | P i) F i| = \sum_(i | P i) `|F i| ->
+   {t : C | `|t| == 1 & forall i, P i -> F i = `|F i| * t}.
+Proof.
+have [i /andP[Pi nzFi] | F0] := pickP [pred i | P i & F i != 0]; last first.
+  exists 1 => [|i Pi]; first by rewrite normr1.
+  by case/nandP: (F0 i) => [/negP[]// | /negbNE/eqP->]; rewrite normr0 mul0r.
+rewrite !(bigD1 i Pi) /= => norm_sumF; pose Q j := P j && (j != i).
+rewrite -normr_eq0 in nzFi; set c := F i / `|F i|; exists c => [|j Pj].
+  by rewrite normrM normfV normr_id divff.
+have [Qj | /nandP[/negP[]// | /negbNE/eqP->]] := boolP (Q j); last first.
+  by rewrite mulrC divfK.
+have: `|F i + F j| = `|F i| + `|F j|.
+  do [rewrite !(bigD1 j Qj) /=; set z := \sum_(k | _) `|_|] in norm_sumF.
+  apply/eqP; rewrite eqr_le ler_norm_add -(ler_add2r z) -addrA -norm_sumF addrA.
+  by rewrite (ler_trans (ler_norm_add _ _)) // ler_add2l ler_norm_sum.
+by case/normC_add_eq=> k _ [/(canLR (mulKf nzFi)) <-]; rewrite -(mulrC (F i)).
+Qed.
+
+Lemma normC_sum_eq1 (I : finType) (P : pred I) (F : I -> C) :
+    `|\sum_(i | P i) F i| = (\sum_(i | P i) `|F i|) ->
+     (forall i, P i -> `|F i| = 1) ->
+   {t : C | `|t| == 1 & forall i, P i -> F i = t}.
+Proof.
+case/normC_sum_eq=> t t1 defF normF.
+by exists t => // i Pi; rewrite defF // normF // mul1r.
+Qed.
+
+Lemma normC_sum_upper (I : finType) (P : pred I) (F G : I -> C) :
+     (forall i, P i -> `|F i| <= G i) ->
+     \sum_(i | P i) F i = \sum_(i | P i) G i ->
+   forall i, P i -> F i = G i.
+Proof.
+set sumF := \sum_(i | _) _; set sumG := \sum_(i | _) _ => leFG eq_sumFG.
+have posG i: P i -> 0 <= G i by move/leFG; apply: ler_trans; apply: normr_ge0.
+have norm_sumG: `|sumG| = sumG by rewrite ger0_norm ?sumr_ge0.
+have norm_sumF: `|sumF| = \sum_(i | P i) `|F i|.
+  apply/eqP; rewrite eqr_le ler_norm_sum eq_sumFG norm_sumG -subr_ge0 -sumrB.
+  by rewrite sumr_ge0 // => i Pi; rewrite subr_ge0 ?leFG.
+have [t _ defF] := normC_sum_eq norm_sumF.
+have [/(psumr_eq0P posG) G0 i Pi | nz_sumG] := eqVneq sumG 0.
+  by apply/eqP; rewrite G0 // -normr_eq0 eqr_le normr_ge0 -(G0 i Pi) leFG.
+have t1: t = 1.
+  apply: (mulfI nz_sumG); rewrite mulr1 -{1}norm_sumG -eq_sumFG norm_sumF.
+  by rewrite mulr_suml -(eq_bigr _ defF).
+have /psumr_eq0P eqFG i: P i -> 0 <= G i - F i.
+  by move=> Pi; rewrite subr_ge0 defF // t1 mulr1 leFG.
+move=> i /eqFG/(canRL (subrK _))->; rewrite ?add0r //.
+by rewrite sumrB -/sumF eq_sumFG subrr.
+Qed.
+
+Lemma normC_sub_eq x y :
+  `|x - y| = `|x| - `|y| -> {t | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}.
+Proof.
+rewrite -{-1}(subrK y x) => /(canLR (subrK _))/esym-Dx; rewrite Dx.
+by have [t ? [Dxy Dy]] := normC_add_eq Dx; exists t; rewrite // mulrDl -Dxy -Dy.
+Qed.
+
+End ClosedFieldTheory.
+
+Notation "n .-root" := (@nthroot _ n) (at level 2, format "n .-root") : ring_scope.
+Notation sqrtC := 2.-root.
+Notation "'i" := (@imaginaryC _) (at level 0) : ring_scope.
+Notation "'Re z" := (Re z) (at level 10, z at level 8) : ring_scope.
+Notation "'Im z" := (Im z) (at level 10, z at level 8) : ring_scope.
+
 End Theory.
 
 Module RealMixin.
@@ -4225,3 +4936,4 @@ Export Num.Syntax Num.PredInstances.
 Notation RealLeMixin := Num.RealMixin.Le.
 Notation RealLtMixin := Num.RealMixin.Lt.
 Notation RealLeAxiom R := (Num.RealMixin.Real (Phant R) (erefl _)).
+Notation ImaginaryMixin := Num.ClosedField.ImaginaryMixin.
diff --git a/mathcomp/algebra/vector.v b/mathcomp/algebra/vector.v
index e1d721e..da6dc59 100644
--- a/mathcomp/algebra/vector.v
+++ b/mathcomp/algebra/vector.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/algebra/zmodp.v b/mathcomp/algebra/zmodp.v
index 543b9e5..ec9750a 100644
--- a/mathcomp/algebra/zmodp.v
+++ b/mathcomp/algebra/zmodp.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/algnum_basic.v b/mathcomp/attic/algnum_basic.v
index 334a3e5..48adbb3 100644
--- a/mathcomp/attic/algnum_basic.v
+++ b/mathcomp/attic/algnum_basic.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/amodule.v b/mathcomp/attic/amodule.v
index 1a0371f..f4f80d0 100644
--- a/mathcomp/attic/amodule.v
+++ b/mathcomp/attic/amodule.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/fib.v b/mathcomp/attic/fib.v
index ab43137..def96bb 100644
--- a/mathcomp/attic/fib.v
+++ b/mathcomp/attic/fib.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/forms.v b/mathcomp/attic/forms.v
index cd7fa23..3ea6ab1 100644
--- a/mathcomp/attic/forms.v
+++ b/mathcomp/attic/forms.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/galgebra.v b/mathcomp/attic/galgebra.v
index 2b34dca..5e12b38 100644
--- a/mathcomp/attic/galgebra.v
+++ b/mathcomp/attic/galgebra.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/multinom.v b/mathcomp/attic/multinom.v
index cc9d9d8..175da6c 100644
--- a/mathcomp/attic/multinom.v
+++ b/mathcomp/attic/multinom.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/quote.v b/mathcomp/attic/quote.v
index ff2d191..cdf73bc 100644
--- a/mathcomp/attic/quote.v
+++ b/mathcomp/attic/quote.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/attic/tutorial.v b/mathcomp/attic/tutorial.v
index 9733cc8..332d841 100644
--- a/mathcomp/attic/tutorial.v
+++ b/mathcomp/attic/tutorial.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/all_character.v b/mathcomp/character/all_character.v
index 936fa6c..03f1b57 100644
--- a/mathcomp/character/all_character.v
+++ b/mathcomp/character/all_character.v
@@ -1,7 +1,7 @@
-Require Export character.
-Require Export classfun.
-Require Export inertia.
-Require Export integral_char.
-Require Export mxabelem.
-Require Export mxrepresentation.
-Require Export vcharacter.
+From mathcomp Require Export character.
+From mathcomp Require Export classfun.
+From mathcomp Require Export inertia.
+From mathcomp Require Export integral_char.
+From mathcomp Require Export mxabelem.
+From mathcomp Require Export mxrepresentation.
+From mathcomp Require Export vcharacter.
diff --git a/mathcomp/character/character.v b/mathcomp/character/character.v
index 89c7697..0738b14 100644
--- a/mathcomp/character/character.v
+++ b/mathcomp/character/character.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/classfun.v b/mathcomp/character/classfun.v
index 4c27bd7..54cbc41 100644
--- a/mathcomp/character/classfun.v
+++ b/mathcomp/character/classfun.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -969,7 +969,8 @@ Lemma cfCauchySchwarz_sqrt phi psi :
   `|'[phi, psi]| <= sqrtC '[phi] * sqrtC '[psi] ?= iff ~~ free (phi :: psi).
 Proof.
 rewrite -(sqrCK (normr_ge0 _)) -sqrtCM ?qualifE ?cfnorm_ge0 //.
-rewrite (mono_in_lerif ler_sqrtC) 1?rpredM ?qualifE ?normr_ge0 ?cfnorm_ge0 //.
+rewrite (mono_in_lerif (@ler_sqrtC _)) 1?rpredM ?qualifE;
+rewrite ?normr_ge0 ?cfnorm_ge0 //.
 exact: cfCauchySchwarz.
 Qed.
 
diff --git a/mathcomp/character/inertia.v b/mathcomp/character/inertia.v
index f06ae9e..3890fdd 100644
--- a/mathcomp/character/inertia.v
+++ b/mathcomp/character/inertia.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/integral_char.v b/mathcomp/character/integral_char.v
index 4320307..ad2980f 100644
--- a/mathcomp/character/integral_char.v
+++ b/mathcomp/character/integral_char.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/mxabelem.v b/mathcomp/character/mxabelem.v
index aa14808..c178d75 100644
--- a/mathcomp/character/mxabelem.v
+++ b/mathcomp/character/mxabelem.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/mxrepresentation.v b/mathcomp/character/mxrepresentation.v
index 7eef614..6dd4eec 100644
--- a/mathcomp/character/mxrepresentation.v
+++ b/mathcomp/character/mxrepresentation.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/character/vcharacter.v b/mathcomp/character/vcharacter.v
index a1bc40e..5b1ff05 100644
--- a/mathcomp/character/vcharacter.v
+++ b/mathcomp/character/vcharacter.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/algC.v b/mathcomp/field/algC.v
index b465542..2e8ce3f 100644
--- a/mathcomp/field/algC.v
+++ b/mathcomp/field/algC.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -17,6 +17,14 @@ Require Import algebraics_fundamentals.
 (* algebraic contents of the Fundamenta Theorem of Algebra.                   *)
 (*       algC == the closed, countable field of algebraic numbers.            *)
 (*  algCeq, algCring, ..., algCnumField == structures for algC.               *)
+(* The ssrnum interfaces are implemented for algC as follows:                 *)
+(*     x <= y <=> (y - x) is a nonnegative real                               *)
+(*      x < y <=> (y - x) is a (strictly) positive real                       *)
+(*       `|z| == the complex norm of z, i.e., sqrtC (z * z^* ).               *)
+(*      Creal == the subset of real numbers (:= Num.real for algC).           *)
+(*         'i == the imaginary number (:= sqrtC (-1)).                        *)
+(*      'Re z == the real component of z.                                     *)
+(*      'Im z == the imaginary component of z.                                *)
 (*        z^* == the complex conjugate of z (:= conjC z).                     *)
 (*    sqrtC z == a nonnegative square root of z, i.e., 0 <= sqrt x if 0 <= x. *)
 (*  n.-root z == more generally, for n > 0, an nth root of z, chosen with a   *)
@@ -25,15 +33,7 @@ Require Import algebraics_fundamentals.
 (*               Note that n.-root (-1) is a primitive 2nth root of unity,    *)
 (*               an thus not equal to -1 for n odd > 1 (this will be shown in *)
 (*               file cyclotomic.v).                                          *)
-(* The ssrnum interfaces are implemented for algC as follows:                 *)
-(*     x <= y <=> (y - x) is a nonnegative real                               *)
-(*      x < y <=> (y - x) is a (strictly) positive real                       *)
-(*       `|z| == the complex norm of z, i.e., sqrtC (z * z^* ).               *)
-(*      Creal == the subset of real numbers (:= Num.real for algC).           *)
 (* In addition, we provide:                                                   *)
-(*         'i == the imaginary number (:= sqrtC (-1)).                        *)
-(*      'Re z == the real component of z.                                     *)
-(*      'Im z == the imaginary component of z.                                *)
 (*       Crat == the subset of rational numbers.                              *)
 (*       Cint == the subset of integers.                                      *)
 (*       Cnat == the subset of natural integers.                              *)
@@ -237,9 +237,8 @@ Parameter numMixin : Num.mixin_of ringType.
 Canonical numDomainType := NumDomainType type numMixin.
 Canonical numFieldType := [numFieldType of type].
 
-Parameter conj : {rmorphism type -> type}.
-Axiom conjK : involutive conj.
-Axiom normK : forall x, `|x| ^+ 2 = x * conj x.
+Parameter conjMixin : Num.ClosedField.imaginary_mixin_of numDomainType.
+Canonical numClosedFieldType := NumClosedFieldType type conjMixin.
 
 Axiom algebraic : integralRange (@ratr unitRingType).
 
@@ -446,6 +445,11 @@ rewrite -(fmorph_root CtoL_rmorphism) -map_poly_comp; congr (root _ _): pu0.
 by apply/esym/eq_map_poly; apply: fmorph_eq_rat.
 Qed.
 
+Definition conjMixin :=
+  ImaginaryMixin (svalP (imaginary_exists closedFieldType))
+                 (fun x => esym (normK x)).
+Canonical numClosedFieldType := NumClosedFieldType type conjMixin.
+
 End Implementation.
 
 Definition divisor := Implementation.type.
@@ -464,47 +468,7 @@ Local Notation ZtoC := (intr : int -> algC).
 Local Notation Creal := (Num.real : qualifier 0 algC).
 
 Fact algCi_subproof : {i : algC | i ^+ 2 = -1}.
-Proof. exact: imaginary_exists. Qed.
-
-Let Re2 z := z + z^*.
-Definition nnegIm z := 0 <= sval algCi_subproof * (z^* - z).
-Definition argCle y z := nnegIm z ==> nnegIm y && (Re2 z <= Re2 y).
-
-CoInductive rootC_spec n (x : algC) : Type :=
-  RootCspec (y : algC) of if (n > 0)%N then y ^+ n = x else y = 0
-                        & forall z, (n > 0)%N -> z ^+ n = x -> argCle y z.
-
-Fact rootC_subproof n x : rootC_spec n x.
-Proof.
-have realRe2 u : Re2 u \is Creal.
-  rewrite realEsqr expr2 {2}/Re2 -{2}[u]conjK addrC -rmorphD -normK.
-  by rewrite exprn_ge0 ?normr_ge0.
-have argCtotal : total argCle.
-  move=> u v; rewrite /total /argCle.
-  by do 2!case: (nnegIm _) => //; rewrite ?orbT //= real_leVge.
-have argCtrans : transitive argCle.
-  move=> u v w /implyP geZuv /implyP geZvw; apply/implyP.
-  by case/geZvw/andP=> /geZuv/andP[-> geRuv] /ler_trans->.
-pose p := 'X^n - (x *+ (n > 0))%:P; have [r0 Dp] := closed_field_poly_normal p.
-have sz_p: size p = n.+1.
-  rewrite size_addl ?size_polyXn // ltnS size_opp size_polyC mulrn_eq0.
-  by case: posnP => //; case: negP.
-pose r := sort argCle r0; have r_arg: sorted argCle r by apply: sort_sorted.
-have{Dp} Dp: p = \prod_(z <- r) ('X - z%:P).
-  rewrite Dp lead_coefE sz_p coefB coefXn coefC -mulrb -mulrnA mulnb lt0n andNb.
-  rewrite subr0 eqxx scale1r; apply: eq_big_perm.
-  by rewrite perm_eq_sym perm_sort.
-have mem_rP z: (n > 0)%N -> reflect (z ^+ n = x) (z \in r).
-  move=> n_gt0; rewrite -root_prod_XsubC -Dp rootE !hornerE hornerXn n_gt0.
-  by rewrite subr_eq0; apply: eqP.
-exists r`_0 => [|z n_gt0 /(mem_rP z n_gt0) r_z].
-  have sz_r: size r = n by apply: succn_inj; rewrite -sz_p Dp size_prod_XsubC.
-  case: posnP => [n0 | n_gt0]; first by rewrite nth_default // sz_r n0.
-  by apply/mem_rP=> //; rewrite mem_nth ?sz_r.
-case: {Dp mem_rP}r r_z r_arg => // y r1; rewrite inE => /predU1P[-> _|r1z].
-  by apply/implyP=> ->; rewrite lerr.
-by move/(order_path_min argCtrans)/allP->.
-Qed.
+Proof. exact: GRing.imaginary_exists. Qed.
 
 CoInductive getCrat_spec : Type := GetCrat_spec CtoQ of cancel QtoC CtoQ.
 
@@ -559,13 +523,10 @@ Module Import Exports.
 Import Implementation Internals.
 
 Notation algC := type.
-Notation conjC := conj.
 Delimit Scope C_scope with C.
 Delimit Scope C_core_scope with Cc.
 Delimit Scope C_expanded_scope with Cx.
 Open Scope C_core_scope.
-Notation "x ^*" := (conjC x) (at level 2, format "x ^*") : C_core_scope.
-Notation "x ^*" := x^* (only parsing) : C_scope.
 
 Canonical eqType.
 Canonical choiceType.
@@ -583,6 +544,7 @@ Canonical fieldType.
 Canonical numFieldType.
 Canonical decFieldType.
 Canonical closedFieldType.
+Canonical numClosedFieldType.
 
 Notation algCeq := eqType.
 Notation algCzmod := zmodType.
@@ -591,22 +553,7 @@ Notation algCuring := unitRingType.
 Notation algCnum := numDomainType.
 Notation algCfield := fieldType.
 Notation algCnumField := numFieldType.
-
-Definition rootC n x := let: RootCspec y _ _ := rootC_subproof n x in y.
-Notation "n .-root" := (rootC n) (at level 2, format "n .-root") : C_core_scope.
-Notation "n .-root" := (rootC n) (only parsing) : C_scope.
-Notation sqrtC := 2.-root.
-
-Definition algCi := sqrtC (-1).
-Notation "'i" := algCi (at level 0) : C_core_scope.
-Notation "'i" := 'i (only parsing) : C_scope.
-
-Definition algRe x := (x + x^*) / 2%:R.
-Definition algIm x := 'i * (x^* - x) / 2%:R.
-Notation "'Re z" := (algRe z) (at level 10, z at level 8) : C_core_scope.
-Notation "'Im z" := (algIm z) (at level 10, z at level 8) : C_core_scope.
-Notation "'Re z" := ('Re z) (only parsing) : C_scope.
-Notation "'Im z" := ('Im z) (only parsing) : C_scope.
+Notation algCnumClosedField := numClosedFieldType.
 
 Notation Creal := (@Num.Def.Rreal numDomainType).
 
@@ -692,596 +639,27 @@ Let nz2 : 2%:R != 0 :> algC. Proof. by rewrite -!CintrE. Qed.
 
 (* Conjugation and norm. *)
 
-Definition conjCK : involutive conjC := Algebraics.Implementation.conjK.
-Definition normCK x : `|x| ^+ 2 = x * x^* := Algebraics.Implementation.normK x.
 Definition algC_algebraic x := Algebraics.Implementation.algebraic x.
 
-Lemma normCKC x : `|x| ^+ 2 = x^* * x. Proof. by rewrite normCK mulrC. Qed.
-
-Lemma mul_conjC_ge0 x : 0 <= x * x^*.
-Proof. by rewrite -normCK exprn_ge0 ?normr_ge0. Qed.
-
-Lemma mul_conjC_gt0 x : (0 < x * x^*) = (x != 0).
-Proof. 
-have [->|x_neq0] := altP eqP; first by rewrite rmorph0 mulr0.
-by rewrite -normCK exprn_gt0 ?normr_gt0.
-Qed.
-
-Lemma mul_conjC_eq0 x : (x * x^* == 0) = (x == 0).
-Proof. by rewrite -normCK expf_eq0 normr_eq0. Qed.
-
-Lemma conjC_ge0 x : (0 <= x^*) = (0 <= x).
-Proof.
-wlog suffices: x / 0 <= x -> 0 <= x^*.
-  by move=> IH; apply/idP/idP=> /IH; rewrite ?conjCK.
-rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite rmorph0.
-by rewrite -(pmulr_rge0 _ x_gt0) mul_conjC_ge0.
-Qed.
-
-Lemma conjC_nat n : (n%:R)^* = n%:R. Proof. exact: rmorph_nat. Qed.
-Lemma conjC0 : 0^* = 0. Proof. exact: rmorph0. Qed.
-Lemma conjC1 : 1^* = 1. Proof. exact: rmorph1. Qed.
-Lemma conjC_eq0 x : (x^* == 0) = (x == 0). Proof. exact: fmorph_eq0. Qed.
-
-Lemma invC_norm x : x^-1 = `|x| ^- 2 * x^*.
-Proof.
-have [-> | nx_x] := eqVneq x 0; first by rewrite conjC0 mulr0 invr0.
-by rewrite normCK invfM divfK ?conjC_eq0.
-Qed.
-
 (* Real number subset. *)
 
 Lemma Creal0 : 0 \is Creal. Proof. exact: rpred0. Qed.
 Lemma Creal1 : 1 \is Creal. Proof. exact: rpred1. Qed.
 Hint Resolve Creal0 Creal1. (* Trivial cannot resolve a general real0 hint. *)
 
-Lemma CrealE x : (x \is Creal) = (x^* == x).
-Proof.
-rewrite realEsqr ger0_def normrX normCK.
-by have [-> | /mulfI/inj_eq-> //] := eqVneq x 0; rewrite rmorph0 !eqxx.
-Qed.
-
-Lemma CrealP {x} : reflect (x^* = x) (x \is Creal).
-Proof. by rewrite CrealE; apply: eqP. Qed.
-
-Lemma conj_Creal x : x \is Creal -> x^* = x.
-Proof. by move/CrealP. Qed.
-
-Lemma conj_normC z : `|z|^* = `|z|.
-Proof. by rewrite conj_Creal ?normr_real. Qed.
-
-Lemma geC0_conj x : 0 <= x -> x^* = x.
-Proof. by move=> /ger0_real/CrealP. Qed.
-
-Lemma geC0_unit_exp x n : 0 <= x -> (x ^+ n.+1 == 1) = (x == 1).
-Proof. by move=> x_ge0; rewrite pexpr_eq1. Qed.
-
-(* Elementary properties of roots. *)
-
-Ltac case_rootC := rewrite /rootC; case: (rootC_subproof _ _).
-
-Lemma root0C x : 0.-root x = 0. Proof. by case_rootC. Qed.
-
-Lemma rootCK n : (n > 0)%N -> cancel n.-root (fun x => x ^+ n).
-Proof. by case: n => //= n _ x; case_rootC. Qed.
-
-Lemma root1C x : 1.-root x = x. Proof. exact: (@rootCK 1). Qed.
-
-Lemma rootC0 n : n.-root 0 = 0.
-Proof.
-have [-> | n_gt0] := posnP n; first by rewrite root0C.
-by have /eqP := rootCK n_gt0 0; rewrite expf_eq0 n_gt0 /= => /eqP.
-Qed.
-
-Lemma rootC_inj n : (n > 0)%N -> injective n.-root.
-Proof. by move/rootCK/can_inj. Qed.
-
-Lemma eqr_rootC n : (n > 0)%N -> {mono n.-root : x y / x == y}.
-Proof. by move/rootC_inj/inj_eq. Qed.
-
-Lemma rootC_eq0 n x : (n > 0)%N -> (n.-root x == 0) = (x == 0).
-Proof. by move=> n_gt0; rewrite -{1}(rootC0 n) eqr_rootC. Qed.
-
-(* Rectangular coordinates. *)
-
-Lemma sqrCi : 'i ^+ 2 = -1. Proof. exact: rootCK. Qed.
-
-Lemma nonRealCi : 'i \isn't Creal.
-Proof. by rewrite realEsqr sqrCi oppr_ge0 ltr_geF ?ltr01. Qed.
-
-Lemma neq0Ci : 'i != 0.
-Proof. by apply: contraNneq nonRealCi => ->; apply: real0. Qed.
-
-Lemma normCi : `|'i| = 1.
-Proof.
-apply/eqP; rewrite -(@pexpr_eq1 _ _ 2) ?normr_ge0 //.
-by rewrite -normrX sqrCi normrN1.
-Qed.
-
-Lemma invCi : 'i^-1 = - 'i.
-Proof. by rewrite -div1r -[1]opprK -sqrCi mulNr mulfK ?neq0Ci. Qed.
-
-Lemma conjCi : 'i^* = - 'i.
-Proof. by rewrite -invCi invC_norm normCi expr1n invr1 mul1r. Qed.
-
 Lemma algCrect x : x = 'Re x + 'i * 'Im x.
-Proof. 
-rewrite 2!mulrA -expr2 sqrCi mulN1r opprB -mulrDl addrACA subrr addr0.
-by rewrite -mulr2n -mulr_natr mulfK.
-Qed.
-
-Lemma Creal_Re x : 'Re x \is Creal.
-Proof. by rewrite CrealE fmorph_div rmorph_nat rmorphD conjCK addrC. Qed.
-
-Lemma Creal_Im x : 'Im x \is Creal.
-Proof.
-rewrite CrealE fmorph_div rmorph_nat rmorphM rmorphB conjCK.
-by rewrite conjCi -opprB mulrNN.
-Qed.
-Hint Resolve Creal_Re Creal_Im.
-
-Fact algRe_is_additive : additive algRe.
-Proof. by move=> x y; rewrite /algRe rmorphB addrACA -opprD mulrBl. Qed.
-Canonical algRe_additive := Additive algRe_is_additive.
-
-Fact algIm_is_additive : additive algIm.
-Proof.
-by move=> x y; rewrite /algIm rmorphB opprD addrACA -opprD mulrBr mulrBl.
-Qed.
-Canonical algIm_additive := Additive algIm_is_additive.
-
-Lemma Creal_ImP z : reflect ('Im z = 0) (z \is Creal).
-Proof.
-rewrite CrealE -subr_eq0 -(can_eq (mulKf neq0Ci)) mulr0.
-by rewrite -(can_eq (divfK nz2)) mul0r; apply: eqP.
-Qed.
-
-Lemma Creal_ReP z : reflect ('Re z = z) (z \in Creal).
-Proof.
-rewrite (sameP (Creal_ImP z) eqP) -(can_eq (mulKf neq0Ci)) mulr0.
-by rewrite -(inj_eq (addrI ('Re z))) addr0 -algCrect eq_sym; apply: eqP.
-Qed.
-
-Lemma algReMl : {in Creal, forall x, {morph algRe : z / x * z}}.
-Proof.
-by move=> x Rx z /=; rewrite /algRe rmorphM (conj_Creal Rx) -mulrDr -mulrA.
-Qed.
-
-Lemma algReMr : {in Creal, forall x, {morph algRe : z / z * x}}.
-Proof. by move=> x Rx z /=; rewrite mulrC algReMl // mulrC. Qed.
-
-Lemma algImMl : {in Creal, forall x, {morph algIm : z / x * z}}.
-Proof.
-by move=> x Rx z; rewrite /algIm rmorphM (conj_Creal Rx) -mulrBr mulrCA !mulrA.
-Qed.
-
-Lemma algImMr : {in Creal, forall x, {morph algIm : z / z * x}}.
-Proof. by move=> x Rx z /=; rewrite mulrC algImMl // mulrC. Qed.
-
-Lemma algRe_i : 'Re 'i = 0. Proof. by rewrite /algRe conjCi subrr mul0r. Qed.
-
-Lemma algIm_i : 'Im 'i = 1.
-Proof.
-rewrite /algIm conjCi -opprD mulrN -mulr2n mulrnAr ['i * _]sqrCi.
-by rewrite mulNrn opprK divff.
-Qed.
-
-Lemma algRe_conj z : 'Re z^* = 'Re z.
-Proof. by rewrite /algRe addrC conjCK. Qed.
-
-Lemma algIm_conj z : 'Im z^* = - 'Im z.
-Proof. by rewrite /algIm -mulNr -mulrN opprB conjCK. Qed.
-
-Lemma algRe_rect : {in Creal &, forall x y, 'Re (x + 'i * y) = x}.
-Proof.
-move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ReP x Rx).
-by rewrite algReMr // algRe_i mul0r addr0.
-Qed.
-
-Lemma algIm_rect : {in Creal &, forall x y, 'Im (x + 'i * y) = y}.
-Proof.
-move=> x y Rx Ry; rewrite /= raddfD /= (Creal_ImP x Rx) add0r.
-by rewrite algImMr // algIm_i mul1r.
-Qed.
-
-Lemma conjC_rect : {in Creal &, forall x y, (x + 'i * y)^* = x - 'i * y}.
-Proof.
-by move=> x y Rx Ry; rewrite /= rmorphD rmorphM conjCi mulNr !conj_Creal.
-Qed.
+Proof. by rewrite [LHS]Crect. Qed.
 
-Lemma addC_rect x1 y1 x2 y2 :
-  (x1 + 'i * y1) + (x2 + 'i * y2) = x1 + x2 + 'i * (y1 + y2).
-Proof. by rewrite addrACA -mulrDr. Qed.
+Lemma algCreal_Re x : 'Re x \is Creal.
+Proof. by rewrite Creal_Re. Qed.
 
-Lemma oppC_rect x y : - (x + 'i * y)  = - x + 'i * (- y).
-Proof. by rewrite mulrN -opprD. Qed.
-
-Lemma subC_rect x1 y1 x2 y2 :
-  (x1 + 'i * y1) - (x2 + 'i * y2) = x1 - x2 + 'i * (y1 - y2).
-Proof. by rewrite oppC_rect addC_rect. Qed.
-
-Lemma mulC_rect x1 y1 x2 y2 :
-  (x1 + 'i * y1) * (x2 + 'i * y2)
-      = x1 * x2 - y1 * y2 + 'i * (x1 * y2 + x2 * y1).
-Proof.
-rewrite mulrDl !mulrDr mulrCA -!addrA mulrAC -mulrA; congr (_ + _).
-by rewrite mulrACA -expr2 sqrCi mulN1r addrA addrC. 
-Qed.
-
-Lemma normC2_rect :
-  {in Creal &, forall x y, `|x + 'i * y| ^+ 2 = x ^+ 2 + y ^+ 2}.
-Proof.
-move=> x y Rx Ry; rewrite /= normCK rmorphD rmorphM conjCi !conj_Creal //.
-by rewrite mulrC mulNr -subr_sqr exprMn sqrCi mulN1r opprK.
-Qed.
-
-Lemma normC2_Re_Im z : `|z| ^+ 2 = 'Re z ^+ 2 + 'Im z ^+ 2.
-Proof. by rewrite -normC2_rect -?algCrect. Qed.
-
-Lemma invC_rect :
-  {in Creal &, forall x y, (x + 'i * y)^-1  = (x - 'i * y) / (x ^+ 2 + y ^+ 2)}.
-Proof.
-by move=> x y Rx Ry; rewrite /= invC_norm conjC_rect // mulrC normC2_rect.
-Qed.
-
-Lemma lerif_normC_Re_Creal z : `|'Re z| <= `|z| ?= iff (z \is Creal).
-Proof.
-rewrite -(mono_in_lerif ler_sqr); try by rewrite qualifE normr_ge0.
-rewrite normCK conj_Creal // normC2_Re_Im -expr2.
-rewrite addrC -lerif_subLR subrr (sameP (Creal_ImP _) eqP) -sqrf_eq0 eq_sym.
-by apply: lerif_eq; rewrite -realEsqr.
-Qed.
-
-Lemma lerif_Re_Creal z : 'Re z <= `|z| ?= iff (0 <= z).
-Proof.
-have ubRe: 'Re z <= `|'Re z| ?= iff (0 <= 'Re z).
-  by rewrite ger0_def eq_sym; apply/lerif_eq/real_ler_norm.
-congr (_ <= _ ?= iff _): (lerif_trans ubRe (lerif_normC_Re_Creal z)).
-apply/andP/idP=> [[zRge0 /Creal_ReP <- //] | z_ge0].
-by have Rz := ger0_real z_ge0; rewrite (Creal_ReP _ _).
-Qed.
-
-(* Equality from polar coordinates, for the upper plane. *)
-Lemma eqC_semipolar x y :
-  `|x| = `|y| -> 'Re x = 'Re y -> 0 <= 'Im x * 'Im y -> x = y.
-Proof.
-move=> eq_norm eq_Re sign_Im.
-rewrite [x]algCrect [y]algCrect eq_Re; congr (_ + 'i * _).
-have /eqP := congr1 (fun z => z ^+ 2) eq_norm.
-rewrite !normC2_Re_Im eq_Re (can_eq (addKr _)) eqf_sqr => /pred2P[] // eq_Im.
-rewrite eq_Im mulNr -expr2 oppr_ge0 real_exprn_even_le0 //= in sign_Im.
-by rewrite eq_Im (eqP sign_Im) oppr0.
-Qed.
-
-(* Nth roots. *)
-
-Let argCleP y z :
-  reflect (0 <= 'Im z -> 0 <= 'Im y /\ 'Re z <= 'Re y) (argCle y z).
-Proof.
-suffices dIm x: nnegIm x = (0 <= 'Im x).
-  rewrite /argCle !dIm ler_pmul2r ?invr_gt0 ?ltr0n //.
-  by apply: (iffP implyP) => geZyz /geZyz/andP.
-rewrite /('Im x) pmulr_lge0 ?invr_gt0 ?ltr0n //; congr (0 <= _ * _).
-case Du: algCi_subproof => [u u2N1] /=.
-have/eqP := u2N1; rewrite -sqrCi eqf_sqr => /pred2P[] //.
-have:= conjCi; rewrite /'i; case_rootC => /= v v2n1 min_v conj_v Duv.
-have{min_v} /idPn[] := min_v u isT u2N1; rewrite negb_imply /nnegIm Du /= Duv.
-rewrite rmorphN conj_v opprK -opprD mulrNN mulNr -mulr2n mulrnAr -expr2 v2n1.
-by rewrite mulNrn opprK ler0n oppr_ge0 (leC_nat 2 0).
-Qed.
-
-Lemma rootC_Re_max n x y :
-  (n > 0)%N -> y ^+ n = x -> 0 <= 'Im y -> 'Re y <= 'Re (n.-root%C x).
-Proof.
-by move=> n_gt0 yn_x leI0y; case_rootC=> z /= _ /(_ y n_gt0 yn_x)/argCleP[].
-Qed.
-
-Let neg_unity_root n : (n > 1)%N -> exists2 w : algC, w ^+ n = 1 & 'Re w < 0.
-Proof.
-move=> n_gt1; have [|w /eqP pw_0] := closed_rootP (\poly_(i < n) (1 : algC)) _.
-  by rewrite size_poly_eq ?oner_eq0 // -(subnKC n_gt1).
-rewrite horner_poly (eq_bigr _ (fun _ _ => mul1r _)) in pw_0.
-have wn1: w ^+ n = 1 by apply/eqP; rewrite -subr_eq0 subrX1 pw_0 mulr0.
-suffices /existsP[i ltRwi0]: [exists i : 'I_n, 'Re (w ^+ i) < 0].
-  by exists (w ^+ i) => //; rewrite exprAC wn1 expr1n.
-apply: contra_eqT (congr1 algRe pw_0); rewrite negb_exists => /forallP geRw0.
-rewrite raddf_sum raddf0 /= (bigD1 (Ordinal (ltnW n_gt1))) //=.
-rewrite (Creal_ReP _ _) ?rpred1 // gtr_eqF ?ltr_paddr ?ltr01 //=.
-by apply: sumr_ge0 => i _; rewrite real_lerNgt.
-Qed.
-
-Lemma Im_rootC_ge0 n x : (n > 1)%N -> 0 <= 'Im (n.-root x).
-Proof.
-set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1.
-apply: wlog_neg; rewrite -real_ltrNge // => ltIy0.
-suffices [z zn_x leI0z]: exists2 z, z ^+ n = x & 'Im z >= 0.
-  by rewrite /y; case_rootC => /= y1 _ /(_ z n_gt0 zn_x)/argCleP[].
-have [w wn1 ltRw0] := neg_unity_root n_gt1.
-wlog leRI0yw: w wn1 ltRw0 / 0 <= 'Re y * 'Im w. 
-  move=> IHw; have: 'Re y * 'Im w \is Creal by rewrite rpredM.
-  case/real_ger0P=> [|/ltrW leRIyw0]; first exact: IHw.
-  apply: (IHw w^*); rewrite ?algRe_conj ?algIm_conj ?mulrN ?oppr_ge0 //.
-  by rewrite -rmorphX wn1 rmorph1.
-exists (w * y); first by rewrite exprMn wn1 mul1r rootCK. 
-rewrite [w]algCrect [y]algCrect mulC_rect.
-by rewrite algIm_rect ?rpredD ?rpredN 1?rpredM // addr_ge0 // ltrW ?nmulr_rgt0.
-Qed.
-
-Lemma rootC_lt0 n x : (1 < n)%N -> (n.-root x < 0) = false.
-Proof.
-set y := n.-root x => n_gt1; have n_gt0 := ltnW n_gt1.
-apply: negbTE; apply: wlog_neg => /negbNE lt0y; rewrite ler_gtF //.
-have Rx: x \is Creal by rewrite -[x](rootCK n_gt0) rpredX // ltr0_real.
-have Re_y: 'Re y = y by apply/Creal_ReP; rewrite ltr0_real.
-have [z zn_x leR0z]: exists2 z, z ^+ n = x & 'Re z >= 0.
-  have [w wn1 ltRw0] := neg_unity_root n_gt1.
-  exists (w * y); first by rewrite exprMn wn1 mul1r rootCK. 
-  by rewrite algReMr ?ltr0_real // ltrW // nmulr_lgt0.
-without loss leI0z: z zn_x leR0z / 'Im z >= 0.
-  move=> IHz; have: 'Im z \is Creal by [].
-  case/real_ger0P=> [|/ltrW leIz0]; first exact: IHz.
-  apply: (IHz z^*); rewrite ?algRe_conj ?algIm_conj ?oppr_ge0 //.
-  by rewrite -rmorphX zn_x conj_Creal.
-by apply: ler_trans leR0z _; rewrite -Re_y ?rootC_Re_max ?ltr0_real.
-Qed.
-
-Lemma rootC_ge0 n x : (n > 0)%N -> (0 <= n.-root x) = (0 <= x).
-Proof.
-set y := n.-root x => n_gt0.
-apply/idP/idP=> [/(exprn_ge0 n) | x_ge0]; first by rewrite rootCK.
-rewrite -(ger_lerif (lerif_Re_Creal y)).
-have Ray: `|y| \is Creal by apply: normr_real.
-rewrite -(Creal_ReP _ Ray) rootC_Re_max ?(Creal_ImP _ Ray) //.
-by rewrite -normrX rootCK // ger0_norm.
-Qed.
-
-Lemma rootC_gt0 n x : (n > 0)%N -> (n.-root x > 0) = (x > 0).
-Proof. by move=> n_gt0; rewrite !lt0r rootC_ge0 ?rootC_eq0. Qed.
-
-Lemma rootC_le0 n x : (1 < n)%N -> (n.-root x <= 0) = (x == 0).
-Proof.
-by move=> n_gt1; rewrite ler_eqVlt rootC_lt0 // orbF rootC_eq0 1?ltnW.
-Qed.
-
-Lemma ler_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x <= y}}.
-Proof.
-move=> n_gt0 x x_ge0 y; have [y_ge0 | not_y_ge0] := boolP (0 <= y).
-  by rewrite -(ler_pexpn2r n_gt0) ?qualifE ?rootC_ge0 ?rootCK.
-rewrite (contraNF (@ler_trans _ _ 0 _ _)) ?rootC_ge0 //.
-by rewrite (contraNF (ler_trans x_ge0)).
-Qed.
-
-Lemma ler_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x <= y}}.
-Proof. by move=> n_gt0 x y x_ge0 _; apply: ler_rootCl. Qed.
-
-Lemma ltr_rootCl n : (n > 0)%N -> {in Num.nneg, {mono n.-root : x y / x < y}}.
-Proof. by move=> n_gt0 x x_ge0 y; rewrite !ltr_def ler_rootCl ?eqr_rootC. Qed.
-
-Lemma ltr_rootC n : (n > 0)%N -> {in Num.nneg &, {mono n.-root : x y / x < y}}.
-Proof. by move/ler_rootC/lerW_mono_in. Qed.
-
-Lemma exprCK n x : (0 < n)%N -> 0 <= x -> n.-root (x ^+ n) = x.
-Proof.
-move=> n_gt0 x_ge0; apply/eqP.
-by rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?exprn_ge0 ?rootCK.
-Qed.
-
-Lemma norm_rootC n x : `|n.-root x| = n.-root `|x|.
-Proof.
-have [-> | n_gt0] := posnP n; first by rewrite !root0C normr0.
-apply/eqP; rewrite -(eqr_expn2 n_gt0) ?rootC_ge0 ?normr_ge0 //.
-by rewrite -normrX !rootCK.
-Qed.
-
-Lemma rootCX n x k : (n > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k.
-Proof.
-move=> n_gt0 x_ge0; apply/eqP.
-by rewrite -(eqr_expn2 n_gt0) ?(exprn_ge0, rootC_ge0) // 1?exprAC !rootCK.
-Qed.
-
-Lemma rootC1 n : (n > 0)%N -> n.-root 1 = 1.
-Proof. by move/(rootCX 0)/(_ ler01). Qed.
-
-Lemma rootCpX n x k : (k > 0)%N -> 0 <= x -> n.-root (x ^+ k) = n.-root x ^+ k.
-Proof.
-by case: n => [|n] k_gt0; [rewrite !root0C expr0n gtn_eqF | apply: rootCX].
-Qed.
-
-Lemma rootCV n x : (n > 0)%N -> 0 <= x -> n.-root x^-1 = (n.-root x)^-1.
-Proof.
-move=> n_gt0 x_ge0; apply/eqP.
-by rewrite -(eqr_expn2 n_gt0) ?(invr_ge0, rootC_ge0) // !exprVn !rootCK.
-Qed.
-
-Lemma rootC_eq1 n x : (n > 0)%N -> (n.-root x == 1) = (x == 1).
-Proof. by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) eqr_rootC. Qed.
-
-Lemma rootC_ge1 n x : (n > 0)%N -> (n.-root x >= 1) = (x >= 1).
-Proof.
-by move=> n_gt0; rewrite -{1}(rootC1 n_gt0) ler_rootCl // qualifE ler01.
-Qed.
-
-Lemma rootC_gt1 n x : (n > 0)%N -> (n.-root x > 1) = (x > 1).
-Proof. by move=> n_gt0; rewrite !ltr_def rootC_eq1 ?rootC_ge1. Qed.
-
-Lemma rootC_le1 n x : (n > 0)%N -> 0 <= x -> (n.-root x <= 1) = (x <= 1).
-Proof. by move=> n_gt0 x_ge0; rewrite -{1}(rootC1 n_gt0) ler_rootCl. Qed.
-
-Lemma rootC_lt1 n x : (n > 0)%N -> 0 <= x -> (n.-root x < 1) = (x < 1).
-Proof. by move=> n_gt0 x_ge0; rewrite !ltr_neqAle rootC_eq1 ?rootC_le1. Qed.
-
-Lemma rootCMl n x z : 0 <= x -> n.-root (x * z) = n.-root x * n.-root z.
-Proof.
-rewrite le0r => /predU1P[-> | x_gt0]; first by rewrite !(mul0r, rootC0).
-have [| n_gt1 | ->] := ltngtP n 1; last by rewrite !root1C.
-  by case: n => //; rewrite !root0C mul0r.
-have [x_ge0 n_gt0] := (ltrW x_gt0, ltnW n_gt1).
-have nx_gt0: 0 < n.-root x by rewrite rootC_gt0.
-have Rnx: n.-root x \is Creal by rewrite ger0_real ?ltrW.
-apply: eqC_semipolar; last 1 first; try apply/eqP.
-- by rewrite algImMl // !(Im_rootC_ge0, mulr_ge0, rootC_ge0).
-- by rewrite -(eqr_expn2 n_gt0) ?normr_ge0 // -!normrX exprMn !rootCK.
-rewrite eqr_le; apply/andP; split; last first.
-  rewrite rootC_Re_max ?exprMn ?rootCK ?algImMl //.
-  by rewrite mulr_ge0 ?Im_rootC_ge0 ?ltrW.
-rewrite -[n.-root _](mulVKf (negbT (gtr_eqF nx_gt0))) !(algReMl Rnx) //.
-rewrite ler_pmul2l // rootC_Re_max ?exprMn ?exprVn ?rootCK ?mulKf ?gtr_eqF //.
-by rewrite algImMl ?rpredV // mulr_ge0 ?invr_ge0 ?Im_rootC_ge0 ?ltrW.
-Qed.
-
-Lemma rootCMr n x z : 0 <= x -> n.-root (z * x) = n.-root z * n.-root x.
-Proof. by move=> x_ge0; rewrite mulrC rootCMl // mulrC. Qed.
-
-(* More properties of n.-root will be established in cyclotomic.v. *)
-
-(* The proper form of the Arithmetic - Geometric Mean inequality. *)
-
-Lemma lerif_rootC_AGM (I : finType) (A : pred I) (n := #|A|) E :
-    {in A, forall i, 0 <= E i} ->
-  n.-root (\prod_(i in A) E i) <= (\sum_(i in A) E i) / n%:R
-                             ?= iff [forall i in A, forall j in A, E i == E j].
-Proof.
-move=> Ege0; have [n0 | n_gt0] := posnP n.
-  rewrite n0 root0C invr0 mulr0; apply/lerif_refl/forall_inP=> i.
-  by rewrite (card0_eq n0).
-rewrite -(mono_in_lerif (ler_pexpn2r n_gt0)) ?rootCK //=; first 1 last.
-- by rewrite qualifE rootC_ge0 // prodr_ge0.
-- by rewrite rpred_div ?rpred_nat ?rpred_sum.
-exact: lerif_AGM.
-Qed.
-
-(* Square root. *)
-
-Lemma sqrtC0 : sqrtC 0 = 0. Proof. exact: rootC0. Qed.
-Lemma sqrtC1 : sqrtC 1 = 1. Proof. exact: rootC1. Qed.
-Lemma sqrtCK x : sqrtC x ^+ 2 = x. Proof. exact: rootCK. Qed.
-Lemma sqrCK x : 0 <= x -> sqrtC (x ^+ 2) = x. Proof. exact: exprCK. Qed.
-
-Lemma sqrtC_ge0 x : (0 <= sqrtC x) = (0 <= x). Proof. exact: rootC_ge0. Qed.
-Lemma sqrtC_eq0 x : (sqrtC x == 0) = (x == 0). Proof. exact: rootC_eq0. Qed.
-Lemma sqrtC_gt0 x : (sqrtC x > 0) = (x > 0). Proof. exact: rootC_gt0. Qed.
-Lemma sqrtC_lt0 x : (sqrtC x < 0) = false. Proof. exact: rootC_lt0. Qed.
-Lemma sqrtC_le0 x : (sqrtC x <= 0) = (x == 0). Proof. exact: rootC_le0. Qed.
-
-Lemma ler_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x <= y}}.
-Proof. exact: ler_rootC. Qed.
-Lemma ltr_sqrtC : {in Num.nneg &, {mono sqrtC : x y / x < y}}.
-Proof. exact: ltr_rootC. Qed.
-Lemma eqr_sqrtC : {mono sqrtC : x y / x == y}.
-Proof. exact: eqr_rootC. Qed.
-Lemma sqrtC_inj : injective sqrtC.
-Proof. exact: rootC_inj. Qed.
-Lemma sqrtCM : {in Num.nneg &, {morph sqrtC : x y / x * y}}.
-Proof. by move=> x y _; apply: rootCMr. Qed.
-
-Lemma sqrCK_P x : reflect (sqrtC (x ^+ 2) = x) ((0 <= 'Im x) && ~~ (x < 0)).
-Proof.
-apply: (iffP andP) => [[leI0x not_gt0x] | <-]; last first.
-  by rewrite sqrtC_lt0 Im_rootC_ge0.
-have /eqP := sqrtCK (x ^+ 2); rewrite eqf_sqr => /pred2P[] // defNx.
-apply: sqrCK; rewrite -real_lerNgt // in not_gt0x; apply/Creal_ImP/ler_anti; 
-by rewrite leI0x -oppr_ge0 -raddfN -defNx Im_rootC_ge0.
-Qed.
-
-Lemma normC_def x : `|x| = sqrtC (x * x^*).
-Proof. by rewrite -normCK sqrCK ?normr_ge0. Qed.
-
-Lemma norm_conjC x : `|x^*| = `|x|.
-Proof. by rewrite !normC_def conjCK mulrC. Qed.
-
-Lemma normC_rect :
-  {in Creal &, forall x y, `|x + 'i * y| = sqrtC (x ^+ 2 + y ^+ 2)}.
-Proof. by move=> x y Rx Ry; rewrite /= normC_def -normCK normC2_rect. Qed.
-
-Lemma normC_Re_Im z : `|z| = sqrtC ('Re z ^+ 2 + 'Im z ^+ 2).
-Proof. by rewrite normC_def -normCK normC2_Re_Im. Qed.
-
-(* Norm sum (in)equalities. *)
-
-Lemma normC_add_eq x y :
-    `|x + y| = `|x| + `|y| ->
-  {t : algC | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}.
-Proof.
-move=> lin_xy; apply: sig2_eqW; pose u z := if z == 0 then 1 else z / `|z|.
-have uE z: (`|u z| = 1) * (`|z| * u z = z).
-  rewrite /u; have [->|nz_z] := altP eqP; first by rewrite normr0 normr1 mul0r.
-  by rewrite normf_div normr_id mulrCA divff ?mulr1 ?normr_eq0.
-have [->|nz_x] := eqVneq x 0; first by exists (u y); rewrite uE ?normr0 ?mul0r.
-exists (u x); rewrite uE // /u (negPf nz_x); congr (_ , _).
-have{lin_xy} def2xy: `|x| * `|y| *+ 2 = x * y ^* + y * x ^*.
-  apply/(addrI (x * x^*))/(addIr (y * y^*)); rewrite -2!{1}normCK -sqrrD.
-  by rewrite addrA -addrA -!mulrDr -mulrDl -rmorphD -normCK lin_xy.
-have def_xy: x * y^* = y * x^*.
-  apply/eqP; rewrite -subr_eq0 -[_ == 0](@expf_eq0 _ _ 2).
-  rewrite (canRL (subrK _) (subr_sqrDB _ _)) opprK -def2xy exprMn_n exprMn.
-  by rewrite mulrN mulrAC mulrA -mulrA mulrACA -!normCK mulNrn addNr.
-have{def_xy def2xy} def_yx: `|y * x| = y * x^*.
-  by apply: (mulIf nz2); rewrite !mulr_natr mulrC normrM def2xy def_xy.
-rewrite -{1}(divfK nz_x y) invC_norm mulrCA -{}def_yx !normrM invfM.
-by rewrite mulrCA divfK ?normr_eq0 // mulrAC mulrA.
-Qed.
-
-Lemma normC_sum_eq (I : finType) (P : pred I) (F : I -> algC) :
-     `|\sum_(i | P i) F i| = \sum_(i | P i) `|F i| ->
-   {t : algC | `|t| == 1 & forall i, P i -> F i = `|F i| * t}.
-Proof.
-have [i /andP[Pi nzFi] | F0] := pickP [pred i | P i & F i != 0]; last first.
-  exists 1 => [|i Pi]; first by rewrite normr1.
-  by case/nandP: (F0 i) => [/negP[]// | /negbNE/eqP->]; rewrite normr0 mul0r.
-rewrite !(bigD1 i Pi) /= => norm_sumF; pose Q j := P j && (j != i).
-rewrite -normr_eq0 in nzFi; set c := F i / `|F i|; exists c => [|j Pj].
-  by rewrite normrM normfV normr_id divff.
-have [Qj | /nandP[/negP[]// | /negbNE/eqP->]] := boolP (Q j); last first.
-  by rewrite mulrC divfK.
-have: `|F i + F j| = `|F i| + `|F j|.
-  do [rewrite !(bigD1 j Qj) /=; set z := \sum_(k | _) `|_|] in norm_sumF.
-  apply/eqP; rewrite eqr_le ler_norm_add -(ler_add2r z) -addrA -norm_sumF addrA.
-  by rewrite (ler_trans (ler_norm_add _ _)) // ler_add2l ler_norm_sum.
-by case/normC_add_eq=> k _ [/(canLR (mulKf nzFi)) <-]; rewrite -(mulrC (F i)).
-Qed.
-
-Lemma normC_sum_eq1 (I : finType) (P : pred I) (F : I -> algC) :
-    `|\sum_(i | P i) F i| = (\sum_(i | P i) `|F i|) ->
-     (forall i, P i -> `|F i| = 1) ->
-   {t : algC | `|t| == 1 & forall i, P i -> F i = t}.
-Proof.
-case/normC_sum_eq=> t t1 defF normF.
-by exists t => // i Pi; rewrite defF // normF // mul1r.
-Qed.
-
-Lemma normC_sum_upper (I : finType) (P : pred I) (F G : I -> algC) :
-     (forall i, P i -> `|F i| <= G i) ->
-     \sum_(i | P i) F i = \sum_(i | P i) G i ->
-   forall i, P i -> F i = G i.
-Proof.
-set sumF := \sum_(i | _) _; set sumG := \sum_(i | _) _ => leFG eq_sumFG.
-have posG i: P i -> 0 <= G i by move/leFG; apply: ler_trans; apply: normr_ge0.
-have norm_sumG: `|sumG| = sumG by rewrite ger0_norm ?sumr_ge0.
-have norm_sumF: `|sumF| = \sum_(i | P i) `|F i|.
-  apply/eqP; rewrite eqr_le ler_norm_sum eq_sumFG norm_sumG -subr_ge0 -sumrB.
-  by rewrite sumr_ge0 // => i Pi; rewrite subr_ge0 ?leFG.
-have [t _ defF] := normC_sum_eq norm_sumF.
-have [/(psumr_eq0P posG) G0 i Pi | nz_sumG] := eqVneq sumG 0.
-  by apply/eqP; rewrite G0 // -normr_eq0 eqr_le normr_ge0 -(G0 i Pi) leFG.
-have t1: t = 1.
-  apply: (mulfI nz_sumG); rewrite mulr1 -{1}norm_sumG -eq_sumFG norm_sumF.
-  by rewrite mulr_suml -(eq_bigr _ defF).
-have /psumr_eq0P eqFG i: P i -> 0 <= G i - F i.
-  by move=> Pi; rewrite subr_ge0 defF // t1 mulr1 leFG.
-move=> i /eqFG/(canRL (subrK _))->; rewrite ?add0r //.
-by rewrite sumrB -/sumF eq_sumFG subrr.
-Qed.
-
-Lemma normC_sub_eq x y :
-  `|x - y| = `|x| - `|y| -> {t | `|t| == 1 & (x, y) = (`|x| * t, `|y| * t)}.
-Proof.
-rewrite -{-1}(subrK y x) => /(canLR (subrK _))/esym-Dx; rewrite Dx.
-by have [t ? [Dxy Dy]] := normC_add_eq Dx; exists t; rewrite // mulrDl -Dxy -Dy.
-Qed.
+Lemma algCreal_Im x : 'Im x \is Creal.
+Proof. by rewrite Creal_Im. Qed.
+Hint Resolve algCreal_Re algCreal_Im.
 
 (* Integer subset. *)
-
 (* Not relying on the undocumented interval library, for now. *)
+
 Lemma floorC_itv x : x \is Creal -> (floorC x)%:~R <= x < (floorC x + 1)%:~R.
 Proof. by rewrite /floorC => Rx; case: (floorC_subproof x) => //= m; apply. Qed.
 
diff --git a/mathcomp/field/algebraics_fundamentals.v b/mathcomp/field/algebraics_fundamentals.v
index 5134a2f..405a5d9 100644
--- a/mathcomp/field/algebraics_fundamentals.v
+++ b/mathcomp/field/algebraics_fundamentals.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -259,12 +259,6 @@ by rewrite Dp map_monic; exists p; rewrite // -Dp root_minPoly.
 Qed.
 Prenex Implicits alg_integral.
 
-Lemma imaginary_exists (C : closedFieldType) : {i : C | i ^+ 2 = -1}.
-Proof.
-have /sig_eqW[i Di2] := @solve_monicpoly C 2 (nth 0 [:: -1]) isT.
-by exists i; rewrite Di2 big_ord_recl big_ord1 mul0r mulr1 !addr0.
-Qed.
-
 Import DefaultKeying GRing.DefaultPred.
 Implicit Arguments map_poly_inj [[F] [R] x1 x2].
 
@@ -275,7 +269,7 @@ Proof.
 have maxn3 n1 n2 n3: {m | [/\ n1 <= m, n2 <= m & n3 <= m]%N}.
   by exists (maxn n1 (maxn n2 n3)); apply/and3P; rewrite -!geq_max.
 have [C [/= QtoC algC]] := countable_algebraic_closure [countFieldType of rat].
-exists C; have [i Di2] := imaginary_exists C.
+exists C; have [i Di2] := GRing.imaginary_exists C.
 pose Qfield := fieldExtType rat; pose Cmorph (L : Qfield) := {rmorphism L -> C}.
 have charQ (L : Qfield): [char L] =i pred0 := ftrans (char_lalg L) (char_num _).
 have sepQ  (L : Qfield) (K E : {subfield L}): separable K E.
diff --git a/mathcomp/field/algnum.v b/mathcomp/field/algnum.v
index c52f871..c75bead 100644
--- a/mathcomp/field/algnum.v
+++ b/mathcomp/field/algnum.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/closed_field.v b/mathcomp/field/closed_field.v
index 9302f56..8a2e304 100644
--- a/mathcomp/field/closed_field.v
+++ b/mathcomp/field/closed_field.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/countalg.v b/mathcomp/field/countalg.v
index 527b7af..46ce3a3 100644
--- a/mathcomp/field/countalg.v
+++ b/mathcomp/field/countalg.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/cyclotomic.v b/mathcomp/field/cyclotomic.v
index 4e810b6..80bdf50 100644
--- a/mathcomp/field/cyclotomic.v
+++ b/mathcomp/field/cyclotomic.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/falgebra.v b/mathcomp/field/falgebra.v
index 317819c..58eccc2 100644
--- a/mathcomp/field/falgebra.v
+++ b/mathcomp/field/falgebra.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/fieldext.v b/mathcomp/field/fieldext.v
index 5fefc49..234183e 100644
--- a/mathcomp/field/fieldext.v
+++ b/mathcomp/field/fieldext.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/finfield.v b/mathcomp/field/finfield.v
index ebf69e7..2421b16 100644
--- a/mathcomp/field/finfield.v
+++ b/mathcomp/field/finfield.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/galois.v b/mathcomp/field/galois.v
index 2b8c382..17fefe6 100644
--- a/mathcomp/field/galois.v
+++ b/mathcomp/field/galois.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/field/separable.v b/mathcomp/field/separable.v
index cbe959b..e8b8944 100644
--- a/mathcomp/field/separable.v
+++ b/mathcomp/field/separable.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/action.v b/mathcomp/fingroup/action.v
index 6ce38b9..1bde1f7 100644
--- a/mathcomp/fingroup/action.v
+++ b/mathcomp/fingroup/action.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/automorphism.v b/mathcomp/fingroup/automorphism.v
index 5e52e5e..8813b45 100644
--- a/mathcomp/fingroup/automorphism.v
+++ b/mathcomp/fingroup/automorphism.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/fingroup.v b/mathcomp/fingroup/fingroup.v
index 01eea88..550aaaa 100644
--- a/mathcomp/fingroup/fingroup.v
+++ b/mathcomp/fingroup/fingroup.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -232,7 +232,7 @@ Structure base_type : Type := PackBase {
 (* coercion of A * B to pred_sort in x \in A * B, or rho * tau to *)
 (* ffun and Funclass in (rho * tau) x, when rho tau : perm T.     *)
 (*   Therefore we define an alias of sort for argument types, and *)
-(* make it the default coercion FinGroup.base_class >-> Sortclass *)
+(* make it the default coercion FinGroup.base_type >-> Sortclass  *)
 (* so that arguments of a functions whose parameters are of type, *)
 (* say, gT : finGroupType, can be coerced to the coercion class   *)
 (* of arg_sort. Care should be taken, however, to declare the     *)
diff --git a/mathcomp/fingroup/gproduct.v b/mathcomp/fingroup/gproduct.v
index a8d2fb2..4ee2bc8 100644
--- a/mathcomp/fingroup/gproduct.v
+++ b/mathcomp/fingroup/gproduct.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/morphism.v b/mathcomp/fingroup/morphism.v
index f4790e6..9f0a900 100644
--- a/mathcomp/fingroup/morphism.v
+++ b/mathcomp/fingroup/morphism.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/perm.v b/mathcomp/fingroup/perm.v
index 2f85d78..a306475 100644
--- a/mathcomp/fingroup/perm.v
+++ b/mathcomp/fingroup/perm.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/presentation.v b/mathcomp/fingroup/presentation.v
index afe33fa..ad712ee 100644
--- a/mathcomp/fingroup/presentation.v
+++ b/mathcomp/fingroup/presentation.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/fingroup/quotient.v b/mathcomp/fingroup/quotient.v
index 3fb0774..242b4b7 100644
--- a/mathcomp/fingroup/quotient.v
+++ b/mathcomp/fingroup/quotient.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGappendixAB.v b/mathcomp/odd_order/BGappendixAB.v
index f1ec1b2..cb104f4 100644
--- a/mathcomp/odd_order/BGappendixAB.v
+++ b/mathcomp/odd_order/BGappendixAB.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGappendixC.v b/mathcomp/odd_order/BGappendixC.v
index a64c49a..f8b9137 100644
--- a/mathcomp/odd_order/BGappendixC.v
+++ b/mathcomp/odd_order/BGappendixC.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -288,7 +288,7 @@ Proof.
 have [q_gt4 | q_le4] := ltnP 4 q.
   pose inK x := enum_rank_in (classes1 H) (x ^: H).
   have inK_E x: x \in H -> enum_val (inK x) = x ^: H.
-    by move=> Hx; rewrite enum_rankK_in ?mem_classes. 
+    by move=> Hx; rewrite enum_rankK_in ?mem_classes.
   pose j := inK s; pose k := inK (s ^+ 2)%g; pose e := gring_classM_coef j j k.
   have cPP: abelian P by rewrite -(injm_abelian inj_sigma) ?zmod_abelian.
   have Hs: s \in H by rewrite -(sdprodW defH) -[s]mulg1 mem_mulg.
@@ -355,18 +355,19 @@ have [q_gt4 | q_le4] := ltnP 4 q.
       by rewrite sub_cent1 groupX // (subsetP cPP).
     rewrite mulrnA -second_orthogonality_relation ?groupX // big_mkcond.
     by apply: ler_sum => i _; rewrite normCK; case: ifP; rewrite ?mul_conjC_ge0.
-  have sqrtP_gt0: 0 < sqrtC #|P|%:R by rewrite sqrtC_gt0 ?gt0CG.
-  have{De ub_linH'}: `|(#|P| * e)%:R - #|U|%:R ^+ 2| <= #|P|%:R * sqrtC #|P|%:R.
+  have sqrtP_gt0: 0 < sqrtC #|P|%:R :> algC by rewrite sqrtC_gt0 ?gt0CG.
+  have{De ub_linH'}:
+    `|(#|P| * e)%:R - #|U|%:R ^+ 2| <= #|P|%:R * sqrtC #|P|%:R :> algC.
     rewrite natrM De mulrCA mulrA divfK ?neq0CG // (bigID linH) /= sum_linH.
     rewrite mulrDr addrC addKr mulrC mulr_suml /chi_s2.
     rewrite (ler_trans (ler_norm_sum _ _ _)) // -ler_pdivr_mulr // mulr_suml.
     apply: ler_trans (ub_linH' 1%N isT); apply: ler_sum => i linH'i.
     rewrite ler_pdivr_mulr // degU ?divfK ?neq0CG //.
     rewrite normrM -normrX norm_conjC ler_wpmul2l ?normr_ge0 //.
-    rewrite -ler_sqr ?qualifE ?normr_ge0 ?(@ltrW _ 0) // sqrtCK. 
+    rewrite -ler_sqr ?qualifE ?normr_ge0 ?(@ltrW _ 0) // sqrtCK.
     apply: ler_trans (ub_linH' 2 isT); rewrite (bigD1 i) ?ler_paddr //=.
     by apply: sumr_ge0 => i1 _; rewrite exprn_ge0 ?normr_ge0.
-  rewrite natrM real_ler_distl ?rpredB ?rpredM ?rpred_nat // => /andP[lb_Pe _]. 
+  rewrite natrM real_ler_distl ?rpredB ?rpredM ?rpred_nat // => /andP[lb_Pe _].
   rewrite -ltC_nat -(ltr_pmul2l (gt0CG P)) {lb_Pe}(ltr_le_trans _ lb_Pe) //.
   rewrite ltr_subr_addl (@ler_lt_trans _ ((p ^ q.-1)%:R ^+ 2)) //; last first.
     rewrite  -!natrX ltC_nat ltn_sqr oU ltn_divRL ?dvdn_pred_predX //.
diff --git a/mathcomp/odd_order/BGsection1.v b/mathcomp/odd_order/BGsection1.v
index 79bb387..7539af3 100644
--- a/mathcomp/odd_order/BGsection1.v
+++ b/mathcomp/odd_order/BGsection1.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection10.v b/mathcomp/odd_order/BGsection10.v
index 6c8e91b..5a61e25 100644
--- a/mathcomp/odd_order/BGsection10.v
+++ b/mathcomp/odd_order/BGsection10.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection11.v b/mathcomp/odd_order/BGsection11.v
index fa3cd65..fe41e8d 100644
--- a/mathcomp/odd_order/BGsection11.v
+++ b/mathcomp/odd_order/BGsection11.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection12.v b/mathcomp/odd_order/BGsection12.v
index a266ed3..1dc8454 100644
--- a/mathcomp/odd_order/BGsection12.v
+++ b/mathcomp/odd_order/BGsection12.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection13.v b/mathcomp/odd_order/BGsection13.v
index 13b7dcb..e90be7f 100644
--- a/mathcomp/odd_order/BGsection13.v
+++ b/mathcomp/odd_order/BGsection13.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection14.v b/mathcomp/odd_order/BGsection14.v
index 18d4b08..2e3f523 100644
--- a/mathcomp/odd_order/BGsection14.v
+++ b/mathcomp/odd_order/BGsection14.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection15.v b/mathcomp/odd_order/BGsection15.v
index 553feda..06d7eb9 100644
--- a/mathcomp/odd_order/BGsection15.v
+++ b/mathcomp/odd_order/BGsection15.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection16.v b/mathcomp/odd_order/BGsection16.v
index 32850e4..737a92d 100644
--- a/mathcomp/odd_order/BGsection16.v
+++ b/mathcomp/odd_order/BGsection16.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection2.v b/mathcomp/odd_order/BGsection2.v
index 9008cf8..5d7a899 100644
--- a/mathcomp/odd_order/BGsection2.v
+++ b/mathcomp/odd_order/BGsection2.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection3.v b/mathcomp/odd_order/BGsection3.v
index 03455c3..007aaf4 100644
--- a/mathcomp/odd_order/BGsection3.v
+++ b/mathcomp/odd_order/BGsection3.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection4.v b/mathcomp/odd_order/BGsection4.v
index a9b519a..217f151 100644
--- a/mathcomp/odd_order/BGsection4.v
+++ b/mathcomp/odd_order/BGsection4.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection5.v b/mathcomp/odd_order/BGsection5.v
index 50f8e21..bf84a99 100644
--- a/mathcomp/odd_order/BGsection5.v
+++ b/mathcomp/odd_order/BGsection5.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection6.v b/mathcomp/odd_order/BGsection6.v
index 6d2df4d..e344b98 100644
--- a/mathcomp/odd_order/BGsection6.v
+++ b/mathcomp/odd_order/BGsection6.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection7.v b/mathcomp/odd_order/BGsection7.v
index 6af8f7d..71e800e 100644
--- a/mathcomp/odd_order/BGsection7.v
+++ b/mathcomp/odd_order/BGsection7.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection8.v b/mathcomp/odd_order/BGsection8.v
index 9ced163..db378f3 100644
--- a/mathcomp/odd_order/BGsection8.v
+++ b/mathcomp/odd_order/BGsection8.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/BGsection9.v b/mathcomp/odd_order/BGsection9.v
index 3baa270..f649e84 100644
--- a/mathcomp/odd_order/BGsection9.v
+++ b/mathcomp/odd_order/BGsection9.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection1.v b/mathcomp/odd_order/PFsection1.v
index 7c74766..1d784ed 100644
--- a/mathcomp/odd_order/PFsection1.v
+++ b/mathcomp/odd_order/PFsection1.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection10.v b/mathcomp/odd_order/PFsection10.v
index 18fbf8c..11b3b20 100644
--- a/mathcomp/odd_order/PFsection10.v
+++ b/mathcomp/odd_order/PFsection10.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection11.v b/mathcomp/odd_order/PFsection11.v
index b966f25..c37633f 100644
--- a/mathcomp/odd_order/PFsection11.v
+++ b/mathcomp/odd_order/PFsection11.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -232,7 +232,7 @@ Lemma bounded_proper_coherent H1 :
     (#|HU : H1| <= 2 * q * #|U : C| + 1)%N.
 Proof.
 move=> nsH1_M psH1_M' cohH1; have [nsHHU _ _ _ _] := sdprod_context defHU.
-suffices: #|HU : H1|%:R - 1 <= 2%:R * #|M : HC|%:R * sqrtC #|HC : HC|%:R.
+suffices: #|HU : H1|%:R - 1 <= 2%:R * #|M : HC|%:R * sqrtC #|HC : HC|%:R :> algC.
   rewrite  indexgg sqrtC1 mulr1 -leC_nat natrD -ler_subl_addr -mulnA natrM.
   congr (_ <= _ * _%:R); apply/eqP; rewrite -(eqn_pmul2l (cardG_gt0 HC)).
   rewrite Lagrange ?normal_sub // mulnCA -(dprod_card defHC) -mulnA mulnC.
diff --git a/mathcomp/odd_order/PFsection12.v b/mathcomp/odd_order/PFsection12.v
index fa5a453..fcc35bf 100644
--- a/mathcomp/odd_order/PFsection12.v
+++ b/mathcomp/odd_order/PFsection12.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection13.v b/mathcomp/odd_order/PFsection13.v
index 1ab2aee..18e8606 100644
--- a/mathcomp/odd_order/PFsection13.v
+++ b/mathcomp/odd_order/PFsection13.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection14.v b/mathcomp/odd_order/PFsection14.v
index 5c43caa..c634ec1 100644
--- a/mathcomp/odd_order/PFsection14.v
+++ b/mathcomp/odd_order/PFsection14.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection2.v b/mathcomp/odd_order/PFsection2.v
index 04c4eba..f92bb16 100644
--- a/mathcomp/odd_order/PFsection2.v
+++ b/mathcomp/odd_order/PFsection2.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection3.v b/mathcomp/odd_order/PFsection3.v
index cb55ae4..eb5ccf8 100644
--- a/mathcomp/odd_order/PFsection3.v
+++ b/mathcomp/odd_order/PFsection3.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -1360,7 +1360,7 @@ have{oxi_00} oxi_i0 i j i0: '[xi_ i j, xi_ i0 0] = ((i == i0) && (j == 0))%:R.
   by rewrite cfdotC Xi0_X0j // conjC0.
 have [-> | nzi2] := altP (i2 =P 0); first exact: oxi_0j.
 have [-> | nzj2] := altP (j2 =P 0); first exact: oxi_i0.
-rewrite cfdotC eq_sym; apply: canLR conjCK _; rewrite rmorph_nat.
+rewrite cfdotC eq_sym; apply: canLR (@conjCK _) _; rewrite rmorph_nat.
 have [-> | nzi1] := altP (i1 =P 0); first exact: oxi_0j.
 have [-> | nzj1] := altP (j1 =P 0); first exact: oxi_i0.
 have ->: xi_ i1 j1 = beta i1 j1 + xi_ i1 0 + xi_ 0 j1 by rewrite /xi_ !ifN.
diff --git a/mathcomp/odd_order/PFsection4.v b/mathcomp/odd_order/PFsection4.v
index 01ca8a5..c897e84 100644
--- a/mathcomp/odd_order/PFsection4.v
+++ b/mathcomp/odd_order/PFsection4.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection5.v b/mathcomp/odd_order/PFsection5.v
index d318f5f..636c48c 100644
--- a/mathcomp/odd_order/PFsection5.v
+++ b/mathcomp/odd_order/PFsection5.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -492,7 +492,7 @@ Definition subcoherent S tau R :=
       (*c*) pairwise_orthogonal S,
       (*d*) {in S, forall xi : 'CF(L : {set gT}),
               [/\ {subset R xi <= 'Z[irr G]}, orthonormal (R xi)
-                & tau (xi - xi^*)%CF = \sum_(alpha <- R xi) alpha]}
+                & tau (xi - xi^*%CF) = \sum_(alpha <- R xi) alpha]}
     & (*e*) {in S &, forall xi phi : 'CF(L),
               orthogonal phi (xi :: xi^*%CF) -> orthogonal (R phi) (R xi)}].
 
@@ -621,7 +621,7 @@ have isoS1: {in S1, isometry [eta tau with eta1 |-> zeta1], to 'Z[irr G]}.
   split=> [xi eta | eta]; rewrite !in_cons /=; last first.
     by case: eqP => [-> | _  /isoS[/Ztau/zcharW]].
   do 2!case: eqP => [-> _|_  /isoS[? ?]] //; last exact: Itau.
-  by apply/(can_inj conjCK); rewrite -!cfdotC.
+  by apply/(can_inj (@conjCK _)); rewrite -!cfdotC.
 have [nu Dnu IZnu] := Zisometry_of_iso freeS1 isoS1.
 exists nu; split=> // phi; rewrite zcharD1E => /andP[].
 case/(zchar_expansion (free_uniq freeS1)) => b Zb {phi}-> phi1_0.
@@ -646,7 +646,7 @@ have N_S: {subset S <= character} by move=> _ /irrS/irrP[i ->]; apply: irr_char.
 have Z_S: {subset S <= 'Z[irr L]} by move=> chi /N_S/char_vchar.
 have o1S: orthonormal S by apply: sub_orthonormal (irr_orthonormal L).
 have [[_ dotSS] oS] := (orthonormalP o1S, orthonormal_orthogonal o1S).
-pose beta chi := tau (chi - chi^*)%CF; pose eqBP := _ =P beta _.
+pose beta chi := tau (chi - chi^*%CF); pose eqBP := _ =P beta _.
 have Zbeta: {in S, forall chi, chi - (chi^*)%CF \in 'Z[S, L^#]}.
   move=> chi Schi; rewrite /= zcharD1E rpredB ?mem_zchar ?ccS //= !cfunE.
   by rewrite subr_eq0 conj_Cnat // Cnat_char1 ?N_S.
@@ -885,7 +885,7 @@ Lemma subcoherent_norm chi psi (tau1 : {additive 'CF(L) -> 'CF(G)}) X Y :
     [/\ chi \in S, psi \in 'Z[irr L] & orthogonal (chi :: chi^*)%CF psi] ->
     let S0 := chi - psi :: chi - chi^*%CF in
     {in 'Z[S0], isometry tau1, to 'Z[irr G]} ->
-    tau1 (chi - chi^*)%CF = tau (chi - chi^*)%CF ->
+    tau1 (chi - chi^*%CF) = tau (chi - chi^*%CF) ->
     [/\ tau1 (chi - psi) = X - Y, '[X, Y] = 0 & orthogonal Y (R chi)] ->
  [/\ (*a*) '[chi] <= '[X]
    & (*b*) '[psi] <= '[Y] ->
diff --git a/mathcomp/odd_order/PFsection6.v b/mathcomp/odd_order/PFsection6.v
index 6d9ecfc..b32a57d 100644
--- a/mathcomp/odd_order/PFsection6.v
+++ b/mathcomp/odd_order/PFsection6.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -83,13 +83,13 @@ Lemma coherent_seqIndD_bound (A B C D : {group gT}) :
   (*a*) [/\ A \proper K, B \subset D, D \subset C, C \subset K
           & D / B \subset 'Z(C / B)]%g ->
   (*b*) coherent (S A) L^# tau -> \unless coherent (S B) L^# tau,
-  #|K : A|%:R - 1 <= 2%:R * #|L : C|%:R * sqrtC #|C : D|%:R.
+  #|K : A|%:R - 1 <= 2%:R * #|L : C|%:R * sqrtC #|C : D|%:R :> algC.
 Proof.
 move=> [nsAL nsBL nsCL nsDL] [ltAK sBD sDC sCK sDbZC] cohA.
 have sBC := subset_trans sBD sDC; have sBK := subset_trans sBC sCK.
 have [sAK nsBK] := (proper_sub ltAK, normalS sBK sKL nsBL).
 have{sBC} [nsAK nsBC] := (normalS sAK sKL nsAL, normalS sBC sCK nsBK).
-rewrite real_lerNgt ?rpredB ?ger0_real ?mulr_ge0 ?sqrtC_ge0 ?ler0n //.
+rewrite real_lerNgt ?rpredB ?ger0_real ?mulr_ge0 ?sqrtC_ge0 ?ler0n ?ler01 //.
 apply/unless_contra; rewrite negbK -(Lagrange_index sKL sCK) natrM => lb_KA.
 pose S2 : seq 'CF(L) := [::]; pose S1 := S2 ++ S A; rewrite -[S A]/S1 in cohA.
 have ccsS1S: cfConjC_subset S1 calS by apply: seqInd_conjC_subset1.
@@ -153,7 +153,7 @@ have sAbZH: (A / B \subset 'Z(H / B))%g.
   by apply: homg_quotientS; rewrite ?(subset_trans sHL) ?normal_norm.
 have ltAH: A \proper H.
   by rewrite properEneq sAH (contraTneq _ lbHA) // => ->; rewrite indexgg addn1.
-set x := sqrtC #|H : A|%:R.
+set x : algC := sqrtC #|H : A|%:R.
 have [nz_x x_gt0]: x != 0 /\ 0 < x by rewrite gtr_eqF sqrtC_gt0 gt0CiG.
 without loss{cohA} ubKA: / #|K : A|%:R - 1 <= 2%:R * #|L : H|%:R * x.
   have [sAK ltAK] := (subset_trans sAH sHK, proper_sub_trans ltAH sHK).
diff --git a/mathcomp/odd_order/PFsection7.v b/mathcomp/odd_order/PFsection7.v
index cea9319..455681c 100644
--- a/mathcomp/odd_order/PFsection7.v
+++ b/mathcomp/odd_order/PFsection7.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -324,7 +324,7 @@ transitivity (\sum_(x in A) \sum_(xi <- S) \sum_(mu <- S) F xi mu x).
   apply: eq_bigr => x Ax; rewrite part_a // sum_cfunE -mulrA mulr_suml.
   apply: eq_bigr => xi _; rewrite mulrA -mulr_suml rmorph_sum; congr (_ * _).
   rewrite mulr_sumr; apply: eq_bigr => mu _; rewrite !cfunE (cfdotC mu).
-  rewrite -{1}[mu x]conjCK -fmorph_div -rmorphM conjCK -4!mulrA 2!(mulrCA _^-1).
+  rewrite -{1}[mu x]conjCK -fmorph_div -rmorphM conjCK -3!mulrA 2!(mulrCA _^-1).
   by rewrite (mulrA _^-1) -invfM 2!(mulrCA (xi x)) mulrA 2!(mulrA _^*).
 rewrite exchange_big; apply: eq_bigr => xi _; rewrite exchange_big /=.
 apply: eq_big_seq => mu Smu; have Tmu := sST mu Smu.
diff --git a/mathcomp/odd_order/PFsection8.v b/mathcomp/odd_order/PFsection8.v
index fd085f6..d4ffa46 100644
--- a/mathcomp/odd_order/PFsection8.v
+++ b/mathcomp/odd_order/PFsection8.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/PFsection9.v b/mathcomp/odd_order/PFsection9.v
index 63e10bb..0cd1109 100644
--- a/mathcomp/odd_order/PFsection9.v
+++ b/mathcomp/odd_order/PFsection9.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -1953,7 +1953,7 @@ have [gtS4alpha s4gt0]: (size S4)%:R > '[alpha] /\ (size S4 > 0)%N.
       rewrite ltn_pmul2r ?expn_gt0 ?a_gt0 // -doubleS.
       by rewrite -(prednK q_gt0) expnS mul2n leq_double ltn_expl.
     rewrite mulnA leq_pmul2r ?expn_gt0 ?a_gt0 // -(subnKC q_gt2).
-    rewrite mulnCA mulnA addSn -mul_Sm_binm bin1 -mulnA leq_pmul2l //.
+    rewrite mulnCA mulnA addSn -mul_bin_diag bin1 -mulnA leq_pmul2l //.
     by rewrite mulnS -addSnnS leq_addr.
   rewrite Dp -Da_p mul2n (addnC a.*2) expnDn -(subnKC q_gt2) !addSn add0n.
   rewrite 3!big_ord_recl big_ord_recr /= !exp1n /= bin1 binn !mul1n /bump /=.
diff --git a/mathcomp/odd_order/stripped_odd_order_theorem.v b/mathcomp/odd_order/stripped_odd_order_theorem.v
index 05c24a9..19b9d0b 100644
--- a/mathcomp/odd_order/stripped_odd_order_theorem.v
+++ b/mathcomp/odd_order/stripped_odd_order_theorem.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/odd_order/wielandt_fixpoint.v b/mathcomp/odd_order/wielandt_fixpoint.v
index 4f40c11..3a9a099 100644
--- a/mathcomp/odd_order/wielandt_fixpoint.v
+++ b/mathcomp/odd_order/wielandt_fixpoint.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/bigenough.v b/mathcomp/real_closed/bigenough.v
index 621f53f..90e46e8 100644
--- a/mathcomp/real_closed/bigenough.v
+++ b/mathcomp/real_closed/bigenough.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/cauchyreals.v b/mathcomp/real_closed/cauchyreals.v
index 1986cb9..9d2dff3 100644
--- a/mathcomp/real_closed/cauchyreals.v
+++ b/mathcomp/real_closed/cauchyreals.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/complex.v b/mathcomp/real_closed/complex.v
index 9c67f32..ef32266 100644
--- a/mathcomp/real_closed/complex.v
+++ b/mathcomp/real_closed/complex.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -21,6 +21,7 @@ Import GRing.Theory Num.Theory.
 Set Implicit Arguments.
 Unset Strict Implicit.
 Unset Printing Implicit Defensive.
+Obligation Tactic := idtac.
 
 Local Open Scope ring_scope.
 
@@ -36,18 +37,22 @@ Local Notation sqrtr := Num.sqrt.
 
 CoInductive complex (R : Type) : Type := Complex { Re : R; Im : R }.
 
-Definition real_complex_def (F : ringType) (phF : phant F) (x : F) := 
+Delimit Scope complex_scope with C.
+Local Open Scope complex_scope.
+
+Definition real_complex_def (F : ringType) (phF : phant F) (x : F) :=
   Complex x 0.
 Notation real_complex F := (@real_complex_def _ (Phant F)).
 Notation "x %:C" := (real_complex _ x)
-  (at level 2, left associativity, format "x %:C")  : ring_scope.
-Notation "x +i* y" := (Complex x y) : ring_scope.
-Notation "x -i* y" := (Complex x (- y)) : ring_scope.
-Notation "x *i " := (Complex 0 x) (at level 8, format "x *i") : ring_scope.
-Notation "''i'" := (Complex 0 1) : ring_scope.
+  (at level 2, left associativity, format "x %:C")  : complex_scope.
+Notation "x +i* y" := (Complex x y) : complex_scope.
+Notation "x -i* y" := (Complex x (- y)) : complex_scope.
+Notation "x *i " := (Complex 0 x) (at level 8, format "x *i") : complex_scope.
+Notation "''i'" := (Complex 0 1) : complex_scope.
 Notation "R [i]" := (complex R)
   (at level 2, left associativity, format "R [i]").
 
+(* Module ComplexInternal. *)
 Module ComplexEqChoice.
 Section ComplexEqChoice.
 
@@ -70,11 +75,11 @@ Definition complex_choiceMixin  (R : choiceType) :=
 Definition complex_countMixin  (R : countType) :=
   PcanCountMixin (@ComplexEqChoice.complex_of_sqRK R).
 
-Canonical Structure complex_eqType (R : eqType) :=
+Canonical complex_eqType (R : eqType) :=
   EqType R[i] (complex_eqMixin R).
-Canonical Structure complex_choiceType (R : choiceType) :=
+Canonical complex_choiceType (R : choiceType) :=
   ChoiceType R[i] (complex_choiceMixin R).
-Canonical Structure complex_countType (R : countType) :=
+Canonical complex_countType (R : countType) :=
   CountType R[i] (complex_countMixin R).
 
 Lemma eq_complex : forall (R : eqType) (x y : complex R),
@@ -99,19 +104,22 @@ Definition addc (x y : R[i]) := let: a +i* b := x in let: c +i* d := y in
   (a + c) +i* (b + d).
 Definition oppc (x : R[i]) := let: a +i* b := x in (- a) +i* (- b).
 
-Lemma addcC : commutative addc.
-Proof. by move=> [a b] [c d] /=; congr (_ +i* _); rewrite addrC. Qed.
-Lemma addcA : associative addc.
-Proof. by move=> [a b] [c d] [e f] /=; rewrite !addrA. Qed.
-
-Lemma add0c : left_id C0 addc.
-Proof. by move=> [a b] /=; rewrite !add0r. Qed.
+Program Definition complex_zmodMixin := @ZmodMixin _ C0 oppc addc _ _ _ _.
+Next Obligation. by move=> [a b] [c d] [e f] /=; rewrite !addrA. Qed.
+Next Obligation. by move=> [a b] [c d] /=; congr (_ +i* _); rewrite addrC. Qed.
+Next Obligation. by move=> [a b] /=; rewrite !add0r. Qed.
+Next Obligation. by move=> [a b] /=; rewrite !addNr. Qed.
+Canonical complex_zmodType := ZmodType R[i] complex_zmodMixin.
 
-Lemma addNc : left_inverse C0 oppc addc.
-Proof. by move=> [a b] /=; rewrite !addNr. Qed.
+Definition scalec (a : R) (x : R[i]) := 
+  let: b +i* c := x in (a * b) +i* (a * c).
 
-Definition complex_ZmodMixin := ZmodMixin addcA addcC add0c addNc.
-Canonical Structure complex_ZmodType := ZmodType R[i] complex_ZmodMixin.
+Program Definition complex_lmodMixin := @LmodMixin _ _ scalec _ _ _ _.
+Next Obligation. by move=> a b [c d] /=; rewrite !mulrA. Qed.
+Next Obligation. by move=> [a b] /=; rewrite !mul1r. Qed.
+Next Obligation. by move=> a [b c] [d e] /=; rewrite !mulrDr. Qed.
+Next Obligation. by move=> [a b] c d /=; rewrite !mulrDl. Qed.
+Canonical complex_lmodType := LmodType R R[i] complex_lmodMixin.
 
 Definition mulc (x y : R[i]) := let: a +i* b := x in let: c +i* d := y in
   ((a * c) - (b * d)) +i* ((a * d) + (b * c)).
@@ -146,9 +154,8 @@ Lemma nonzero1c : C1 != C0. Proof. by rewrite eq_complex /= oner_eq0. Qed.
 
 Definition complex_comRingMixin :=
   ComRingMixin mulcA mulcC mul1c mulc_addl nonzero1c.
-Canonical Structure  complex_Ring :=
-  Eval hnf in RingType R[i] complex_comRingMixin.
-Canonical Structure complex_comRing := Eval hnf in ComRingType R[i] mulcC.
+Canonical complex_ringType :=RingType R[i] complex_comRingMixin.
+Canonical complex_comRingType := ComRingType R[i] mulcC.
 
 Lemma mulVc : forall x, x != C0 -> mulc (invc x) x = C1.
 Proof.
@@ -159,19 +166,16 @@ Qed.
 
 Lemma invc0 : invc C0 = C0. Proof. by rewrite /= !mul0r oppr0. Qed.
 
-Definition ComplexFieldUnitMixin := FieldUnitMixin mulVc invc0.
-Canonical Structure complex_unitRing :=
-  Eval hnf in UnitRingType C ComplexFieldUnitMixin.
-Canonical Structure complex_comUnitRing :=
-  Eval hnf in [comUnitRingType of R[i]].
+Definition complex_fieldUnitMixin := FieldUnitMixin mulVc invc0.
+Canonical complex_unitRingType := UnitRingType C complex_fieldUnitMixin.
+Canonical complex_comUnitRingType := Eval hnf in [comUnitRingType of R[i]].
 
-Lemma field_axiom : GRing.Field.mixin_of complex_unitRing.
+Lemma field_axiom : GRing.Field.mixin_of complex_unitRingType.
 Proof. by []. Qed.
 
 Definition ComplexFieldIdomainMixin := (FieldIdomainMixin field_axiom).
-Canonical Structure complex_iDomain :=
-  Eval hnf in IdomainType R[i] (FieldIdomainMixin field_axiom).
-Canonical Structure complex_fieldMixin := FieldType R[i] field_axiom.
+Canonical complex_idomainType := IdomainType R[i] (FieldIdomainMixin field_axiom).
+Canonical complex_fieldType := FieldType R[i] field_axiom.
 
 Ltac simpc := do ?
   [ rewrite -[(_ +i* _) - (_ +i* _)]/(_ +i* _)
@@ -184,20 +188,22 @@ split; [|split=> //] => a b /=; simpc; first by rewrite subrr.
 by rewrite !mulr0 !mul0r addr0 subr0.
 Qed.
 
-Canonical Structure real_complex_rmorphism :=
+Canonical real_complex_rmorphism :=
   RMorphism real_complex_is_rmorphism.
-Canonical Structure real_complex_additive :=
+Canonical real_complex_additive :=
   Additive real_complex_is_rmorphism.
 
-Lemma Re_is_additive : additive (@Re R).
-Proof. by case=> a1 b1; case=> a2 b2. Qed.
+Lemma Re_is_scalar : scalar (@Re R).
+Proof. by move=> a [b c] [d e]. Qed.
 
-Canonical Structure Re_additive := Additive Re_is_additive.
+Canonical Re_additive := Additive Re_is_scalar.
+Canonical Re_linear := Linear Re_is_scalar.
 
-Lemma Im_is_additive : additive (@Im R).
-Proof. by case=> a1 b1; case=> a2 b2. Qed.
+Lemma Im_is_scalar : scalar (@Im R).
+Proof. by move=> a [b c] [d e]. Qed.
 
-Canonical Structure Im_additive := Additive Im_is_additive.
+Canonical Im_additive := Additive Im_is_scalar.
+Canonical Im_linear := Linear Im_is_scalar.
 
 Definition lec (x y : R[i]) :=
   let: a +i* b := x in let: c +i* d := y in
@@ -207,7 +213,7 @@ Definition ltc (x y : R[i]) :=
   let: a +i* b := x in let: c +i* d := y in
     (d == b) && (a < c).
 
-Definition normc (x : R[i]) : R := 
+Definition normc (x : R[i]) : R :=
   let: a +i* b := x in sqrtr (a ^+ 2 + b ^+ 2).
 
 Notation normC x := (normc x)%:C.
@@ -233,14 +239,10 @@ move: x y => [a b] [c d] /= /andP[/eqP -> a_ge0] /andP[/eqP -> c_ge0].
 by rewrite eqxx ler_total.
 Qed.
 
-(* :TODO: put in ssralg ? *)
-Lemma exprM (a b : R) : (a * b) ^+ 2 = a ^+ 2 * b ^+ 2.
-Proof. by rewrite mulrACA. Qed.
-
 Lemma normcM x y : normc (x * y) = normc x * normc y.
 Proof.
 move: x y => [a b] [c d] /=; rewrite -sqrtrM ?addr_ge0 ?sqr_ge0 //.
-rewrite sqrrB sqrrD mulrDl !mulrDr -!exprM.
+rewrite sqrrB sqrrD mulrDl !mulrDr -!exprMn.
 rewrite mulrAC [b * d]mulrC !mulrA.
 suff -> : forall (u v w z t : R), (u - v + w) + (z + v + t) = u + w + (z + t).
   by rewrite addrAC !addrA.
@@ -282,56 +284,51 @@ have [huv|] := ger0P (u + v); last first.
   by move=> /ltrW /ler_trans -> //; rewrite pmulrn_lge0 // mulr_ge0 ?sqrtr_ge0.
 rewrite -(@ler_pexpn2r _ 2) -?topredE //=; last first.
   by rewrite ?(pmulrn_lge0, mulr_ge0, sqrtr_ge0) //.
-rewrite -mulr_natl !exprM !sqr_sqrtr ?(ler_paddr, sqr_ge0) //.
-rewrite -mulrnDl -mulr_natl !exprM ler_pmul2l ?exprn_gt0 ?ltr0n //.
-rewrite sqrrD mulrDl !mulrDr -!exprM addrAC.
-rewrite [_ + (b * d) ^+ 2]addrC [X in _ <= X]addrAC -!addrA !ler_add2l.
-rewrite mulrAC mulrA -mulrA mulrACA mulrC.
-by rewrite -subr_ge0 addrAC -sqrrB sqr_ge0.
+rewrite -mulr_natl !exprMn !sqr_sqrtr ?(ler_paddr, sqr_ge0) //.
+rewrite -mulrnDl -mulr_natl !exprMn ler_pmul2l ?exprn_gt0 ?ltr0n //.
+rewrite sqrrD mulrDl !mulrDr -!exprMn addrAC -!addrA ler_add2l !addrA.
+rewrite [_ + (b * d) ^+ 2]addrC -addrA ler_add2l.
+have: 0 <= (a * d - b * c) ^+ 2 by rewrite sqr_ge0.
+by rewrite sqrrB addrAC subr_ge0 [_ * c]mulrC mulrACA [d * _]mulrC.
 Qed.
 
-Definition complex_POrderedMixin := NumMixin lec_normD ltc0_add eq0_normC
+Definition complex_numMixin := NumMixin lec_normD ltc0_add eq0_normC
      ge0_lec_total normCM lec_def ltc_def.
-Canonical Structure complex_numDomainType :=
-  NumDomainType R[i] complex_POrderedMixin.
+Canonical complex_numDomainType := NumDomainType R[i] complex_numMixin.
 
 End ComplexField.
 End ComplexField.
 
-Canonical complex_ZmodType (R : rcfType) :=
-  ZmodType R[i] (ComplexField.complex_ZmodMixin R).
-Canonical complex_Ring (R : rcfType) :=
-  Eval hnf in RingType R[i] (ComplexField.complex_comRingMixin R).
-Canonical complex_comRing (R : rcfType) :=
-  Eval hnf in ComRingType R[i] (@ComplexField.mulcC R).
-Canonical complex_unitRing (R : rcfType) :=
-  Eval hnf in UnitRingType R[i] (ComplexField.ComplexFieldUnitMixin R).
-Canonical complex_comUnitRing (R : rcfType) :=
-  Eval hnf in [comUnitRingType of R[i]].
-Canonical complex_iDomain (R : rcfType) :=
-  Eval hnf in IdomainType R[i] (FieldIdomainMixin (@ComplexField.field_axiom R)).
-Canonical complex_fieldType (R : rcfType) :=
-  FieldType R[i] (@ComplexField.field_axiom R).
-Canonical complex_numDomainType (R : rcfType) :=
-  NumDomainType R[i] (ComplexField.complex_POrderedMixin R).
-Canonical complex_numFieldType (R : rcfType) :=
-  [numFieldType of complex R].
-
+Canonical ComplexField.complex_zmodType.
+Canonical ComplexField.complex_lmodType.
+Canonical ComplexField.complex_ringType.
+Canonical ComplexField.complex_comRingType.
+Canonical ComplexField.complex_unitRingType.
+Canonical ComplexField.complex_comUnitRingType.
+Canonical ComplexField.complex_idomainType.
+Canonical ComplexField.complex_fieldType.
+Canonical ComplexField.complex_numDomainType.
+Canonical complex_numFieldType (R : rcfType) := [numFieldType of complex R].
 Canonical ComplexField.real_complex_rmorphism.
 Canonical ComplexField.real_complex_additive.
 Canonical ComplexField.Re_additive.
 Canonical ComplexField.Im_additive.
 
 Definition conjc {R : ringType} (x : R[i]) := let: a +i* b := x in a -i* b.
-Notation "x ^*" := (conjc x) (at level 2, format "x ^*").
+Notation "x ^*" := (conjc x) (at level 2, format "x ^*") : complex_scope.
+Local Open Scope complex_scope.
+Delimit Scope complex_scope with C.
 
 Ltac simpc := do ?
-  [ rewrite -[(_ +i* _) - (_ +i* _)]/(_ +i* _)
-  | rewrite -[(_ +i* _) + (_ +i* _)]/(_ +i* _)
-  | rewrite -[(_ +i* _) * (_ +i* _)]/(_ +i* _)
-  | rewrite -[(_ +i* _) <= (_ +i* _)]/((_ == _) && (_ <= _))
-  | rewrite -[(_ +i* _) < (_ +i* _)]/((_ == _) && (_ < _))
-  | rewrite -[`|_ +i* _|]/(sqrtr (_ + _))%:C
+  [ rewrite -[- (_ +i* _)%C]/(_ +i* _)%C
+  | rewrite -[(_ +i* _)%C - (_ +i* _)%C]/(_ +i* _)%C
+  | rewrite -[(_ +i* _)%C + (_ +i* _)%C]/(_ +i* _)%C
+  | rewrite -[(_ +i* _)%C * (_ +i* _)%C]/(_ +i* _)%C
+  | rewrite -[(_ +i* _)%C ^*]/(_ +i* _)%C
+  | rewrite -[_ *: (_ +i* _)%C]/(_ +i* _)%C
+  | rewrite -[(_ +i* _)%C <= (_ +i* _)%C]/((_ == _) && (_ <= _))
+  | rewrite -[(_ +i* _)%C < (_ +i* _)%C]/((_ == _) && (_ < _))
+  | rewrite -[`|(_ +i* _)%C|]/(sqrtr (_ + _))%:C%C
   | rewrite (mulrNN, mulrN, mulNr, opprB, opprD, mulr0, mul0r,
     subr0, sub0r, addr0, add0r, mulr1, mul1r, subrr, opprK, oppr0,
     eqxx) ].
@@ -341,18 +338,18 @@ Section ComplexTheory.
 
 Variable R : rcfType.
 
-Lemma ReiNIm : forall x : R[i], Re (x * 'i) = - Im x.
+Lemma ReiNIm : forall x : R[i], Re (x * 'i%C) = - Im x.
 Proof. by case=> a b; simpc. Qed.
 
-Lemma ImiRe : forall x : R[i], Im (x * 'i) = Re x.
+Lemma ImiRe : forall x : R[i], Im (x * 'i%C) = Re x.
 Proof. by case=> a b; simpc. Qed.
 
-Lemma complexE x : x = (Re x)%:C + 'i * (Im x)%:C :> R[i].
+Lemma complexE x : x = (Re x)%:C + 'i%C * (Im x)%:C :> R[i].
 Proof. by case: x => *; simpc. Qed.
 
 Lemma real_complexE x : x%:C = x +i* 0 :> R[i]. Proof. done. Qed.
 
-Lemma sqr_i : 'i ^+ 2 = -1 :> R[i].
+Lemma sqr_i : 'i%C ^+ 2 = -1 :> R[i].
 Proof. by rewrite exprS; simpc; rewrite -real_complexE rmorphN. Qed.
 
 Lemma complexI : injective (real_complex R). Proof. by move=> x y []. Qed.
@@ -377,13 +374,17 @@ split=> [[a b] [c d]|] /=; first by simpc; rewrite [d - _]addrC.
 by split=> [[a b] [c d]|] /=; simpc.
 Qed.
 
+Lemma conjc_is_scalable : scalable (@conjc R).
+Proof. by move=> a [b c]; simpc. Qed.
+
 Canonical conjc_rmorphism := RMorphism conjc_is_rmorphism.
 Canonical conjc_additive := Additive conjc_is_rmorphism.
+Canonical conjc_linear := AddLinear conjc_is_scalable.
 
 Lemma conjcK : involutive (@conjc R).
 Proof. by move=> [a b] /=; rewrite opprK. Qed.
 
-Lemma mulcJ_ge0 (x : R[i]) : 0 <= x * x ^*.
+Lemma mulcJ_ge0 (x : R[i]) : 0 <= x * x^*%C.
 Proof.
 by move: x=> [a b]; simpc; rewrite mulrC addNr eqxx addr_ge0 ?sqr_ge0.
 Qed.
@@ -391,14 +392,14 @@ Qed.
 Lemma conjc_real (x : R) : x%:C^* = x%:C.
 Proof. by rewrite /= oppr0. Qed.
 
-Lemma ReJ_add (x : R[i]) : (Re x)%:C =  (x + x^*) / 2%:R.
+Lemma ReJ_add (x : R[i]) : (Re x)%:C =  (x + x^*%C) / 2%:R.
 Proof.
 case: x => a b; simpc; rewrite [0 ^+ 2]mul0r addr0 /=.
 rewrite -!mulr2n -mulr_natr -mulrA [_ * (_ / _)]mulrA.
 by rewrite divff ?mulr1 // -natrM pnatr_eq0.
 Qed.
 
-Lemma ImJ_sub (x : R[i]) : (Im x)%:C =  (x^* - x) / 2%:R * 'i.
+Lemma ImJ_sub (x : R[i]) : (Im x)%:C =  (x^*%C - x) / 2%:R * 'i%C.
 Proof.
 case: x => a b; simpc; rewrite [0 ^+ 2]mul0r addr0 /=.
 rewrite -!mulr2n -mulr_natr -mulrA [_ * (_ / _)]mulrA.
@@ -426,7 +427,7 @@ Proof. exact: (conjc_nat 1). Qed.
 Lemma conjc_eq0 : forall x : R[i], (x ^* == 0) = (x == 0).
 Proof. by move=> [a b]; rewrite !eq_complex /= eqr_oppLR oppr0. Qed.
 
-Lemma conjc_inv: forall x : R[i], (x^-1)^* = (x^* )^-1.
+Lemma conjc_inv: forall x : R[i], (x^-1)^* = (x^*%C )^-1.
 Proof. exact: fmorphV. Qed.
 
 Lemma complex_root_conj (p : {poly R[i]}) (x : R[i]) :
@@ -448,18 +449,36 @@ Qed.
 Lemma normc_def (z : R[i]) : `|z| = (sqrtr ((Re z)^+2 + (Im z)^+2))%:C.
 Proof. by case: z. Qed.
 
-Lemma add_Re2_Im2 (z : R[i]) : ((Re z)^+2 + (Im z)^+2)%:C = `|z|^+2. 
+Lemma add_Re2_Im2 (z : R[i]) : ((Re z)^+2 + (Im z)^+2)%:C = `|z|^+2.
 Proof. by rewrite normc_def -rmorphX sqr_sqrtr ?addr_ge0 ?sqr_ge0. Qed.
 
-Lemma addcJ (z : R[i]) : z + z^* = 2%:R * (Re z)%:C.
+Lemma addcJ (z : R[i]) : z + z^*%C = 2%:R * (Re z)%:C.
 Proof. by rewrite ReJ_add mulrC mulfVK ?pnatr_eq0. Qed.
 
-Lemma subcJ (z : R[i]) : z - z^* = 2%:R * (Im z)%:C * 'i.
+Lemma subcJ (z : R[i]) : z - z^*%C = 2%:R * (Im z)%:C * 'i%C.
 Proof.
 rewrite ImJ_sub mulrCA mulrA mulfVK ?pnatr_eq0 //.
-by rewrite -mulrA ['i * _]sqr_i mulrN1 opprB.
+by rewrite -mulrA ['i%C * _]sqr_i mulrN1 opprB.
 Qed.
 
+Lemma complex_real (a b : R) : a +i* b \is Num.real = (b == 0).
+Proof. 
+rewrite realE; simpc; rewrite [0 == _]eq_sym.
+by have [] := ltrgtP 0 a; rewrite ?(andbF, andbT, orbF, orbb).
+Qed.
+
+Lemma complex_realP (x : R[i]) : reflect (exists y, x = y%:C) (x \is Num.real).
+Proof.
+case: x=> [a b] /=; rewrite complex_real.
+by apply: (iffP eqP) => [->|[c []//]]; exists a.
+Qed.
+
+Lemma RRe_real (x : R[i]) : x \is Num.real -> (Re x)%:C = x.
+Proof. by move=> /complex_realP [y ->]. Qed.
+
+Lemma RIm_real (x : R[i]) : x \is Num.real -> (Im x)%:C = 0.
+Proof. by move=> /complex_realP [y ->]. Qed.
+
 End ComplexTheory.
 
 (* Section RcfDef. *)
@@ -593,13 +612,13 @@ apply/eqP/eqP=> [eqs|->]; last by rewrite sqrtc0.
 by rewrite -[x]sqr_sqrtc eqs exprS mul0r.
 Qed.
 
-Lemma normcE x : `|x| = sqrtc (x * x^*).
+Lemma normcE x : `|x| = sqrtc (x * x^*%C).
 Proof.
 case: x=> a b; simpc; rewrite [b * a]mulrC addNr sqrtc_sqrtr //.
 by simpc; rewrite /= addr_ge0 ?sqr_ge0.
 Qed.
 
-Lemma sqr_normc (x : R[i]) : (`|x| ^+ 2) = x * x^*.
+Lemma sqr_normc (x : R[i]) : (`|x| ^+ 2) = x * x^*%C.
 Proof. by rewrite normcE sqr_sqrtc. Qed.
 
 Lemma normc_ge_Re (x : R[i]) : `|Re x|%:C <= `|x|.
@@ -607,17 +626,17 @@ Proof.
 by case: x => a b; simpc; rewrite -sqrtr_sqr ler_wsqrtr // ler_addl sqr_ge0.
 Qed.
 
-Lemma normcJ (x : R[i]) :  `|x^*| = `|x|.
+Lemma normcJ (x : R[i]) :  `|x^*%C| = `|x|.
 Proof. by case: x => a b; simpc; rewrite /= sqrrN. Qed.
 
-Lemma invc_norm (x : R[i]) : x^-1 = `|x|^-2 * x^*.
+Lemma invc_norm (x : R[i]) : x^-1 = `|x|^-2 * x^*%C.
 Proof.
 case: (altP (x =P 0)) => [->|dx]; first by rewrite rmorph0 mulr0 invr0.
-apply: (mulIf dx); rewrite mulrC divff // -mulrA [_^* * _]mulrC -(sqr_normc x).
+apply: (mulIf dx); rewrite mulrC divff // -mulrA [_^*%C * _]mulrC -(sqr_normc x).
 by rewrite mulVf // expf_neq0 ?normr_eq0.
 Qed.
 
-Lemma canonical_form (a b c : R[i]) : 
+Lemma canonical_form (a b c : R[i]) :
   a != 0 ->
   let d := b ^+ 2 - 4%:R * a * c in
   let r1 := (- b - sqrtc d) / 2%:R / a in
@@ -637,7 +656,7 @@ rewrite sqr_sqrtc sqrrN /d opprB addrC addrNK -2!mulrA.
 by rewrite mulrACA -natf_div // mul1r mulrAC divff ?mul1r.
 Qed.
 
-Lemma monic_canonical_form (b c : R[i]) : 
+Lemma monic_canonical_form (b c : R[i]) :
   let d := b ^+ 2 - 4%:R * c in
   let r1 := (- b - sqrtc d) / 2%:R in
   let r2 := (- b + sqrtc d) / 2%:R in
@@ -649,12 +668,12 @@ Qed.
 Section extramx.
 (* missing lemmas from matrix.v or mxalgebra.v *)
 
-Lemma mul_mx_rowfree_eq0 (K : fieldType) (m n p: nat) 
-                         (W : 'M[K]_(m,n)) (V : 'M[K]_(n,p)) : 
+Lemma mul_mx_rowfree_eq0 (K : fieldType) (m n p: nat)
+                         (W : 'M[K]_(m,n)) (V : 'M[K]_(n,p)) :
   row_free V -> (W *m V == 0) = (W == 0).
 Proof. by move=> free; rewrite -!mxrank_eq0 mxrankMfree ?mxrank_eq0. Qed.
 
-Lemma sub_sums_genmxP (F : fieldType) (I : finType) (P : pred I) (m n : nat) 
+Lemma sub_sums_genmxP (F : fieldType) (I : finType) (P : pred I) (m n : nat)
  (A : 'M[F]_(m, n)) (B_ : I -> 'M_(m, n)) :
 reflect (exists u_ : I -> 'M_m, A = \sum_(i | P i) u_ i *m B_ i)
   (A <= \sum_(i | P i) <<B_ i>>)%MS.
@@ -706,7 +725,7 @@ rewrite eq_mviE xpair_eqE -!val_eqE /= eq_sym andbb.
 rewrite ltn_eqF // subr0 mulr1 summxE big1.
   rewrite [w as X in X *m _]mx11_scalar => ->.
   by rewrite mul_scalar_mx scale0r submx0.
-move=> [i' j'] /= /andP[lt_j'i']. 
+move=> [i' j'] /= /andP[lt_j'i'].
 rewrite xpair_eqE /= => neq'_ij.
 rewrite /= !mxvec_delta !mxE big_ord1 !mxE !eqxx !eq_mviE.
 rewrite !xpair_eqE /= [_ == i']eq_sym [_ == j']eq_sym (negPf neq'_ij) /=.
@@ -730,7 +749,7 @@ rewrite (eq_bigr (fun _ => 1%N)); last first.
   by move/eqP; rewrite oner_eq0.
 transitivity (\sum_(i < n) (\sum_(j < n | j < i) 1))%N.
   by rewrite pair_big_dep.
-apply: eq_bigr => [] [[|i] Hi] _ /=; first by rewrite big1. 
+apply: eq_bigr => [] [[|i] Hi] _ /=; first by rewrite big1.
 rewrite (eq_bigl _ _ (fun _ => ltnS _ _)).
 have [n_eq0|n_gt0] := posnP n; first by move: Hi (Hi); rewrite {1}n_eq0.
 rewrite -[n]prednK // big_ord_narrow_leq /=.
@@ -795,13 +814,13 @@ case: sp => [|sp] in Hsp *.
   move: Hsp => /eqP/size_poly1P/sig2_eqW [c c_neq0 ->].
   by exists ((-c)%:M); rewrite monicE lead_coefC => /eqP ->; apply: det_mx00.
 have addn1n n : (n + 1 = 1 + n)%N by rewrite addn1.
-exists (castmx (erefl _, addn1n _) 
+exists (castmx (erefl _, addn1n _)
        (block_mx (\row_(i < sp) - p`_(sp - i)) (-p`_0)%:M
                  1%:M                        0)).
 elim/poly_ind: p sp Hsp (addn1n _) => [|p c IHp] sp; first by rewrite size_poly0.
 rewrite size_MXaddC.
 have [->|p_neq0] //= := altP eqP; first by rewrite size_poly0; case: ifP.
-move=> [Hsp] eq_cast. 
+move=> [Hsp] eq_cast.
 rewrite monicE lead_coefDl ?size_polyC ?size_mul ?polyX_eq0 //; last first.
   by rewrite size_polyX addn2 Hsp ltnS (leq_trans (leq_b1 _)).
 rewrite lead_coefMX -monicE => p_monic.
@@ -845,7 +864,7 @@ congr (_ * 'X + c%:P * _).
   apply/matrixP => k l; rewrite !simp.
   case: splitP => k' /=; rewrite ?ord1 /bump ltnNge leq_ord add0n.
     case: splitP => [k'' /= |k'' -> //]; rewrite ord1 !simp => k_eq0 _.
-    case: splitP => l' /=; rewrite ?ord1 /bump ltnNge leq_ord add0n !simp; 
+    case: splitP => l' /=; rewrite ?ord1 /bump ltnNge leq_ord add0n !simp;
       last by move/eqP; rewrite ?addn0 ltn_eqF.
     move<-; case: splitP => l'' /=; rewrite ?ord1 ?addn0 !simp.
       by move<-; rewrite subSn ?leq_ord ?coefE.
@@ -853,7 +872,7 @@ congr (_ * 'X + c%:P * _).
     by rewrite !rmorphN ?subnn addr0.
   case: splitP => k'' /=; rewrite ?ord1 => -> // []; rewrite !simp.
   case: splitP => l' /=; rewrite /bump ltnNge leq_ord add0n !simp -?val_eqE /=;
-    last by rewrite ord1 addn0 => /eqP; rewrite ltn_eqF.  
+    last by rewrite ord1 addn0 => /eqP; rewrite ltn_eqF.
   by case: splitP => l'' /= -> <- <-; rewrite !simp // ?ord1 ?addn0 ?ltn_eqF.
 move=> {IHp Hsp p_neq0 p_monic}; rewrite add0n; set s := _ ^+ _;
 apply: (@mulfI _ s); first by rewrite signr_eq0.
@@ -958,7 +977,7 @@ Definition CommonEigenVec_def K (phK : phant K) (d r : nat) :=
   exists2 v : 'rV_m, (v != 0) & forall f, f \in sf ->
   exists a, (v <= eigenspace f a)%MS.
 Notation CommonEigenVec K d r := (@CommonEigenVec_def _ (Phant K) d r).
- 
+
 Definition Eigen1Vec_def K (phK : phant K) (d : nat) :=
   forall (m : nat) (V : 'M[K]_m), ~~ (d %| \rank V) ->
   forall (f : 'M_m), (V *m f <= V)%MS -> exists a, eigenvalue f a.
@@ -1028,7 +1047,7 @@ have [eqWV|neqWV] := altP (@eqmxP _ _ _ _ W 1%:M).
   by exists a; rewrite -eigenspace_restrict // eqWV submx1.
 have lt_WV : (\rank W < \rank V)%N.
   rewrite -[X in (_ < X)%N](@mxrank1 K) rank_ltmx //.
-  by rewrite ltmxEneq neqWV // submx1. 
+  by rewrite ltmxEneq neqWV // submx1.
 have ltZV : (\rank Z < \rank V)%N.
   rewrite -[X in (_ < X)%N]rWZ -subn_gt0 addnK lt0n mxrank_eq0 -lt0mx.
   move: a_eigen_f' => /eigenvalueP [v /eigenspaceP] sub_vW v_neq0.
@@ -1067,16 +1086,16 @@ suff: exists a, eigenvalue (restrict V f) a.
   by move=> [a /eigenvalue_restrict Hf]; exists a; apply: Hf.
 move: (\rank V) (restrict V f) => {f f_stabV V m} n f in HrV *.
 pose u := map_mx (@Re R) f; pose v := map_mx (@Im R) f.
-have fE : f = MtoC u + 'i *: MtoC v.
+have fE : f = MtoC u + 'i%C *: MtoC v.
   rewrite /u /v [f]lock; apply/matrixP => i j; rewrite !mxE /=.
   by case: (locked f i j) => a b; simpc.
 move: u v => u v in fE *.
 pose L1fun : 'M[R]_n -> _ :=
-  2%:R^-1 \*: (mulmxr u       \+ (mulmxr v \o trmx) 
+  2%:R^-1 \*: (mulmxr u       \+ (mulmxr v \o trmx)
            \+ ((mulmx (u^T)) \- (mulmx (v^T) \o trmx))).
 pose L1 := lin_mx [linear of L1fun].
 pose L2fun : 'M[R]_n -> _ :=
-  2%:R^-1 \*: (((@GRing.opp _) \o (mulmxr u \o trmx) \+ mulmxr v) 
+  2%:R^-1 \*: (((@GRing.opp _) \o (mulmxr u \o trmx) \+ mulmxr v)
            \+ ((mulmx (u^T) \o trmx)               \+ (mulmx (v^T)))).
 pose L2 := lin_mx [linear of L2fun].
 have [] := @Lemma4 _ _ 1%:M _ [::L1; L2] (erefl _).
@@ -1111,7 +1130,7 @@ do [move=> /(congr1 vec_mx); rewrite mxvecK linearZ /=] in g_eigenL2.
 move=> {L1 L2 L1fun L2fun Hg HrV}.
 set vg := vec_mx g in g_eigenL1 g_eigenL2.
 exists (a +i* b); apply/eigenvalueP.
-pose w := (MtoC vg - 'i *: MtoC vg^T).
+pose w := (MtoC vg - 'i%C *: MtoC vg^T).
 exists (nz_row w); last first.
   rewrite nz_row_eq0 subr_eq0; apply: contraNneq g_neq0 => Hvg.
   rewrite -vec_mx_eq0; apply/eqP/matrixP => i j; rewrite !mxE /=.
@@ -1124,11 +1143,11 @@ rewrite (submx_trans (nz_row_sub _)) //; apply/eigenspaceP.
 rewrite fE [a +i* b]complexE /=.
 rewrite !(mulmxDr, mulmxBl, =^~scalemxAr, =^~scalemxAl) -!map_mxM.
 rewrite !(scalerDl, scalerDr, scalerN, =^~scalemxAr, =^~scalemxAl).
-rewrite !scalerA /= mulrAC ['i * _]sqr_i ?mulN1r scaleN1r scaleNr !opprK.
-rewrite [_ * 'i]mulrC -!scalerA -!map_mxZ /=.
-do 2!rewrite [X in (_ - _) + X]addrC [_ - 'i *: _ + _]addrACA.
+rewrite !scalerA /= mulrAC ['i%C * _]sqr_i ?mulN1r scaleN1r scaleNr !opprK.
+rewrite [_ * 'i%C]mulrC -!scalerA -!map_mxZ /=.
+do 2!rewrite [X in (_ - _) + X]addrC [_ - 'i%C *: _ + _]addrACA.
 rewrite ![- _ + _]addrC -!scalerBr -!(rmorphB, rmorphD) /=.
-congr (_ + 'i *: _); congr map_mx; rewrite -[_ *: _^T]linearZ /=;
+congr (_ + 'i%C *: _); congr map_mx; rewrite -[_ *: _^T]linearZ /=;
 rewrite -g_eigenL1 -g_eigenL2 linearZ -(scalerDr, scalerBr);
 do ?rewrite ?trmxK ?trmx_mul ?[(_ + _)^T]linearD ?[(- _)^T]linearN /=;
 rewrite -[in X in _ *: (_ + X)]addrC 1?opprD 1?opprB ?mulmxN ?mulNmx;
@@ -1206,8 +1225,8 @@ move=> /(_ m.+1 1 _ f) []; last by move=> a; exists a.
 + by rewrite mxrank1 (contra (dvdn_leq _)) // -ltnNge ltn_expl.
 + by rewrite submx1.
 Qed.
-                  
-Lemma C_acf_axiom : GRing.ClosedField.axiom [ringType of R[i]].
+
+Lemma complex_acf_axiom : GRing.ClosedField.axiom [ringType of R[i]].
 Proof.
 move=> n c n_gt0; pose p := 'X^n - \poly_(i < n) c i.
 suff [x rpx] : exists x, root p x.
@@ -1223,14 +1242,67 @@ have [] := Theorem7' (companion p); first by rewrite -(subnK sp_gt1) addn2.
 by move=> x; rewrite eigenvalue_root_char companionK //; exists x.
 Qed.
 
-Definition C_decFieldMixin := closed_fields_QEMixin C_acf_axiom.
-Canonical C_decField := DecFieldType R[i] C_decFieldMixin.
-Canonical C_closedField := ClosedFieldType R[i] C_acf_axiom.
+Definition complex_decFieldMixin := closed_fields_QEMixin complex_acf_axiom.
+Canonical complex_decField := DecFieldType R[i] complex_decFieldMixin.
+Canonical complex_closedField := ClosedFieldType R[i] complex_acf_axiom.
+
+Definition complex_numClosedFieldMixin :=
+  ImaginaryMixin (sqr_i R) (fun x=> esym (sqr_normc x)).
+
+Canonical complex_numClosedFieldType :=
+  NumClosedFieldType R[i] complex_numClosedFieldMixin.
 
 End Paper_HarmDerksen.
 
 End ComplexClosed.
 
+(* End ComplexInternal. *)
+
+(* Canonical ComplexInternal.complex_eqType. *)
+(* Canonical ComplexInternal.complex_choiceType. *)
+(* Canonical ComplexInternal.complex_countType. *)
+(* Canonical ComplexInternal.complex_ZmodType. *)
+(* Canonical ComplexInternal.complex_Ring. *)
+(* Canonical ComplexInternal.complex_comRing. *)
+(* Canonical ComplexInternal.complex_unitRing. *)
+(* Canonical ComplexInternal.complex_comUnitRing. *)
+(* Canonical ComplexInternal.complex_iDomain. *)
+(* Canonical ComplexInternal.complex_fieldType. *)
+(* Canonical ComplexInternal.ComplexField.real_complex_rmorphism. *)
+(* Canonical ComplexInternal.ComplexField.real_complex_additive. *)
+(* Canonical ComplexInternal.ComplexField.Re_additive. *)
+(* Canonical ComplexInternal.ComplexField.Im_additive. *)
+(* Canonical ComplexInternal.complex_numDomainType. *)
+(* Canonical ComplexInternal.complex_numFieldType. *)
+(* Canonical ComplexInternal.conjc_rmorphism. *)
+(* Canonical ComplexInternal.conjc_additive. *)
+(* Canonical ComplexInternal.complex_decField. *)
+(* Canonical ComplexInternal.complex_closedField. *)
+(* Canonical ComplexInternal.complex_numClosedFieldType. *)
+
+(* Definition complex_algebraic_trans := ComplexInternal.complex_algebraic_trans. *)
+
+Section ComplexClosedTheory.
+
+Variable R : rcfType.
+
+Lemma complexiE : 'i%C = 'i%R :> R[i].
+Proof. by []. Qed.
+
+Lemma complexRe (x : R[i]) : (Re x)%:C = 'Re x.
+Proof.
+rewrite {1}[x]Crect raddfD /= mulrC ReiNIm rmorphB /=.
+by rewrite ?RRe_real ?RIm_real ?Creal_Im ?Creal_Re // subr0.
+Qed.
+
+Lemma complexIm (x : R[i]) : (Im x)%:C = 'Im x.
+Proof.
+rewrite {1}[x]Crect raddfD /= mulrC ImiRe rmorphD /=.
+by rewrite ?RRe_real ?RIm_real ?Creal_Im ?Creal_Re // add0r.
+Qed.
+
+End ComplexClosedTheory.
+
 Definition complexalg := realalg[i].
 
 Canonical complexalg_eqType := [eqType of complexalg].
diff --git a/mathcomp/real_closed/mxtens.v b/mathcomp/real_closed/mxtens.v
index ace09a6..5189369 100644
--- a/mathcomp/real_closed/mxtens.v
+++ b/mathcomp/real_closed/mxtens.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/ordered_qelim.v b/mathcomp/real_closed/ordered_qelim.v
index 7c7bd6a..f5d0b38 100644
--- a/mathcomp/real_closed/ordered_qelim.v
+++ b/mathcomp/real_closed/ordered_qelim.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/polyorder.v b/mathcomp/real_closed/polyorder.v
index f18ec89..f84abb6 100644
--- a/mathcomp/real_closed/polyorder.v
+++ b/mathcomp/real_closed/polyorder.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -108,10 +108,7 @@ Qed.
 Lemma muP p x n : p != 0 ->
   (('X - x%:P)^+n %| p) && ~~(('X - x%:P)^+n.+1 %| p) = (n == \mu_x p).
 Proof.
-move=> hp0; rewrite !root_le_mu//; case: (ltngtP n (\mu_x p))=> hn.
-+ by rewrite ltnW//=.
-+ by rewrite leqNgt hn.
-+ by rewrite hn leqnn.
+by move=> hp0; rewrite !root_le_mu//; case: (ltngtP n (\mu_x p)).
 Qed.
 
 Lemma mu_gt0 p x : p != 0 -> (0 < \mu_x p)%N = root p x.
diff --git a/mathcomp/real_closed/polyrcf.v b/mathcomp/real_closed/polyrcf.v
index 949dec0..9e73204 100644
--- a/mathcomp/real_closed/polyrcf.v
+++ b/mathcomp/real_closed/polyrcf.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -360,48 +360,6 @@ rewrite !mul1r mulrC -ltr_subl_addr.
 by rewrite (ler_lt_trans _ (He' y _)) // ler_sub_dist.
 Qed.
 
-(* Todo : orderedpoly !! *)
-(* Lemma deriv_expz_nat (n : nat) p : (p ^ n)^`() = (p^`() * p ^ (n.-1)) *~ n. *)
-(* Proof. *)
-(* elim: n => [|n ihn] /= in p *; first by rewrite expr0z derivC mul0zr. *)
-(* rewrite exprSz_nat derivM ihn mulzrAr mulrCA -exprSz_nat. *)
-(* by case: n {ihn}=> [|n] //; rewrite mul0zr addr0 mul1zr. *)
-(* Qed. *)
-
-(* Definition derivCE := (derivE, deriv_expz_nat). *)
-
-(* Lemma size_poly_ind : forall K : {poly R} -> Prop, *)
-(*   K 0 ->  *)
-(*   (forall p sp, size p = sp.+1 ->   *)
-(*     forall q, (size q <= sp)%N -> K q -> K p) *)
-(*   -> forall p, K p. *)
-(* Proof. *)
-(* move=> K K0 ihK p. *)
-(* move: {-2}p (leqnn (size p)); elim: (size p)=> {p} [|n ihn] p spn. *)
-(*   by move: spn; rewrite leqn0 size_poly_eq0; move/eqP->. *)
-(* case spSn: (size p == n.+1). *)
-(*   move/eqP:spSn; move/ihK=> ihKp; apply: (ihKp 0)=>//. *)
-(*   by rewrite size_poly0. *)
-(* by move:spn; rewrite leq_eqVlt spSn /= ltnS; by move/ihn.  *)
-(* Qed. *)
-
-(* Lemma size_poly_indW : forall K : {poly R} -> Prop, *)
-(*   K 0 ->  *)
-(*   (forall p sp, size p = sp.+1 ->   *)
-(*     forall q, size q = sp -> K q -> K p) *)
-(*   -> forall p, K p. *)
-(* Proof. *)
-(* move=> K K0 ihK p. *)
-(* move: {-2}p (leqnn (size p)); elim: (size p)=> {p} [|n ihn] p spn. *)
-(*   by move: spn; rewrite leqn0 size_poly_eq0; move/eqP->. *)
-(* case spSn: (size p == n.+1). *)
-(*   move/eqP:spSn; move/ihK=> ihKp; case: n ihn spn ihKp=> [|n] ihn spn ihKp. *)
-(*     by apply: (ihKp 0)=>//; rewrite size_poly0. *)
-(*   apply: (ihKp 'X^n)=>//; first by rewrite size_polyXn. *)
-(*   by apply: ihn; rewrite size_polyXn. *)
-(* by move:spn; rewrite leq_eqVlt spSn /= ltnS; by move/ihn.  *)
-(* Qed. *)
-
 Lemma poly_ltsp_roots p (rs : seq R) :
   (size rs >= size p)%N -> uniq rs -> all (root p) rs -> p = 0.
 Proof.
diff --git a/mathcomp/real_closed/qe_rcf.v b/mathcomp/real_closed/qe_rcf.v
index 82b5ea5..e1b3b97 100644
--- a/mathcomp/real_closed/qe_rcf.v
+++ b/mathcomp/real_closed/qe_rcf.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/qe_rcf_th.v b/mathcomp/real_closed/qe_rcf_th.v
index 6f50f36..3aebce4 100644
--- a/mathcomp/real_closed/qe_rcf_th.v
+++ b/mathcomp/real_closed/qe_rcf_th.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/real_closed/realalg.v b/mathcomp/real_closed/realalg.v
index 6f9cd8e..69fb9c4 100644
--- a/mathcomp/real_closed/realalg.v
+++ b/mathcomp/real_closed/realalg.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/abelian.v b/mathcomp/solvable/abelian.v
index e608c4f..d6dac93 100644
--- a/mathcomp/solvable/abelian.v
+++ b/mathcomp/solvable/abelian.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -1745,7 +1745,7 @@ pose cnt_p k := count [pred x : gT | logn p #[x] > k].
 have cnt_b b: \big[dprod/1]_(x <- b) <[x]> = G ->
   count [pred x | #[x] == p ^ k.+1]%N b = cnt_p k b - cnt_p k.+1 b.
 - move/p_bG; elim: b => //= _ b IHb /andP[/p_natP[j ->] /IHb-> {IHb}].
-  rewrite eqn_leq !leq_exp2l ?prime_gt1 // -eqn_leq pfactorK // leqNgt.
+  rewrite eqn_leq !leq_exp2l ?prime_gt1 // -eqn_leq pfactorK //.
   case: ltngtP => // _ {j}; rewrite subSn // add0n; elim: b => //= y b IHb.
   by rewrite leq_add // ltn_neqAle; case: (~~ _).
 by rewrite !cnt_b // /cnt_p !(@count_logn_dprod_cycle _ _ _ G).
diff --git a/mathcomp/solvable/alt.v b/mathcomp/solvable/alt.v
index f32a590..f43c89a 100644
--- a/mathcomp/solvable/alt.v
+++ b/mathcomp/solvable/alt.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/burnside_app.v b/mathcomp/solvable/burnside_app.v
index f5f337a..638276c 100644
--- a/mathcomp/solvable/burnside_app.v
+++ b/mathcomp/solvable/burnside_app.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/center.v b/mathcomp/solvable/center.v
index 7189758..d63c302 100644
--- a/mathcomp/solvable/center.v
+++ b/mathcomp/solvable/center.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/commutator.v b/mathcomp/solvable/commutator.v
index 674825a..f3e0779 100644
--- a/mathcomp/solvable/commutator.v
+++ b/mathcomp/solvable/commutator.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/cyclic.v b/mathcomp/solvable/cyclic.v
index 03c8bfb..8073449 100644
--- a/mathcomp/solvable/cyclic.v
+++ b/mathcomp/solvable/cyclic.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/extraspecial.v b/mathcomp/solvable/extraspecial.v
index 0df60e6..9d158cc 100644
--- a/mathcomp/solvable/extraspecial.v
+++ b/mathcomp/solvable/extraspecial.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/extremal.v b/mathcomp/solvable/extremal.v
index 5f9545d..342eeae 100644
--- a/mathcomp/solvable/extremal.v
+++ b/mathcomp/solvable/extremal.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/finmodule.v b/mathcomp/solvable/finmodule.v
index e1462be..97b2ebc 100644
--- a/mathcomp/solvable/finmodule.v
+++ b/mathcomp/solvable/finmodule.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/frobenius.v b/mathcomp/solvable/frobenius.v
index e2dba42..e4a716d 100644
--- a/mathcomp/solvable/frobenius.v
+++ b/mathcomp/solvable/frobenius.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/gfunctor.v b/mathcomp/solvable/gfunctor.v
index 40292a3..fc8385d 100644
--- a/mathcomp/solvable/gfunctor.v
+++ b/mathcomp/solvable/gfunctor.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/gseries.v b/mathcomp/solvable/gseries.v
index 73170ee..fe83ada 100644
--- a/mathcomp/solvable/gseries.v
+++ b/mathcomp/solvable/gseries.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/hall.v b/mathcomp/solvable/hall.v
index b706879..d59964b 100644
--- a/mathcomp/solvable/hall.v
+++ b/mathcomp/solvable/hall.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/jordanholder.v b/mathcomp/solvable/jordanholder.v
index 5d4d195..6a8de0e 100644
--- a/mathcomp/solvable/jordanholder.v
+++ b/mathcomp/solvable/jordanholder.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/maximal.v b/mathcomp/solvable/maximal.v
index 098a325..4255bd9 100644
--- a/mathcomp/solvable/maximal.v
+++ b/mathcomp/solvable/maximal.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/nilpotent.v b/mathcomp/solvable/nilpotent.v
index 520d691..954be43 100644
--- a/mathcomp/solvable/nilpotent.v
+++ b/mathcomp/solvable/nilpotent.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/pgroup.v b/mathcomp/solvable/pgroup.v
index fb28f3d..f3e19b3 100644
--- a/mathcomp/solvable/pgroup.v
+++ b/mathcomp/solvable/pgroup.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/primitive_action.v b/mathcomp/solvable/primitive_action.v
index 712f492..ae60ce0 100644
--- a/mathcomp/solvable/primitive_action.v
+++ b/mathcomp/solvable/primitive_action.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/solvable/sylow.v b/mathcomp/solvable/sylow.v
index 01d80e0..32f86f1 100644
--- a/mathcomp/solvable/sylow.v
+++ b/mathcomp/solvable/sylow.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/Make b/mathcomp/ssreflect/Make
index 4dd672c..a10b9c5 100644
--- a/mathcomp/ssreflect/Make
+++ b/mathcomp/ssreflect/Make
@@ -4,7 +4,6 @@ seq.v
 ssrbool.v
 ssreflect.v
 ssrfun.v
-ssrmatching.v
 ssrnat.v
 bigop.v
 binomial.v
@@ -19,9 +18,6 @@ path.v
 prime.v
 tuple.v
 
-ssreflect.mllib
-ssrmatching.mli
-ssrmatching.ml4
 ssreflect.ml4
 
 -I .
diff --git a/mathcomp/ssreflect/Makefile.coq-makefile b/mathcomp/ssreflect/Makefile.coq-makefile
index 52beace..e4f12ad 100644
--- a/mathcomp/ssreflect/Makefile.coq-makefile
+++ b/mathcomp/ssreflect/Makefile.coq-makefile
@@ -1,10 +1,22 @@
 define coqmakefile
 	(echo "Generating Makefile.coq for Coq $(V) with COQBIN=$(COQBIN)";\
 	if [ "$$OS" = "Windows_NT" ]; then LN=cp; else LN="ln -sf"; fi;\
-	$$LN $(1)/plugin/$(V)/ssreflect.mllib .;\
-	$$LN $(1)/plugin/$(V)/ssrmatching.mli .;\
-	$$LN $(1)/plugin/$(V)/ssrmatching.ml4 .;\
+	MLLIB=ssreflect_plugin.mlpack;\
+	EXTRA=;\
+	case $(V) in\
+       	v8.5*|v8.4*)\
+		$$LN $(1)/plugin/$(V)/ssrmatching.mli .;\
+		$$LN $(1)/plugin/$(V)/ssrmatching.ml4 .;\
+		$$LN $(1)/plugin/$(V)/ssrmatching.v .;\
+		$$LN $(1)/plugin/$(V)/ssreflect_plugin.mllib .;\
+		EXTRA="ssrmatching.mli ssrmatching.ml4 ssrmatching.v";\
+		MLLIB=ssreflect_plugin.mllib;\
+	;;\
+	*)\
+		$$LN $(1)/plugin/$(V)/ssreflect_plugin.mlpack .;\
+	;;\
+	esac;\
 	$$LN $(1)/plugin/$(V)/ssreflect.ml4 .;\
-	$(COQBIN)coq_makefile -f Make -o Makefile.coq)
+	$(COQBIN)coq_makefile -f Make $$MLLIB $$EXTRA -o Makefile.coq)
 endef
 
diff --git a/mathcomp/ssreflect/bigop.v b/mathcomp/ssreflect/bigop.v
index 5fed5bb..c5d2ef3 100644
--- a/mathcomp/ssreflect/bigop.v
+++ b/mathcomp/ssreflect/bigop.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/binomial.v b/mathcomp/ssreflect/binomial.v
index a136bfd..d683768 100644
--- a/mathcomp/ssreflect/binomial.v
+++ b/mathcomp/ssreflect/binomial.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -193,16 +193,14 @@ Lemma binS n m : 'C(n.+1, m.+1) = 'C(n, m.+1) + 'C(n, m). Proof. by []. Qed.
 Lemma bin1 n : 'C(n, 1) = n.
 Proof. by elim: n => //= n IHn; rewrite binS bin0 IHn addn1. Qed.
 
-Lemma bin_gt0 m n : (0 < 'C(m, n)) = (n <= m).
+Lemma bin_gt0 n m : (0 < 'C(n, m)) = (m <= n).
 Proof.
-elim: m n => [|m IHm] [|n] //.
-by rewrite binS addn_gt0 !IHm orbC ltn_neqAle andKb.
+by elim: n m => [|n IHn] [|m] //; rewrite addn_gt0 !IHn orbC ltn_neqAle andKb.
 Qed.
 
-Lemma leq_bin2l m1 m2 n : m1 <= m2 -> 'C(m1, n) <= 'C(m2, n).
+Lemma leq_bin2l n1 n2 m : n1 <= n2 -> 'C(n1, m) <= 'C(n2, m).
 Proof.
-elim: m1 m2 n => [m2 | m1 IHm [|m2] //] [|n] le_m12; rewrite ?bin0 //.
-by rewrite !binS leq_add // IHm.
+by elim: n1 n2 m  => [|n1 IHn] [|n2] [|n] le_n12 //; rewrite leq_add ?IHn.
 Qed.
 
 Lemma bin_small n m : n < m -> 'C(n, m) = 0.
@@ -211,32 +209,30 @@ Proof. by rewrite ltnNge -bin_gt0; case: posnP. Qed.
 Lemma binn n : 'C(n, n) = 1.
 Proof. by elim: n => [|n IHn] //; rewrite binS bin_small. Qed.
 
-Lemma mul_Sm_binm m n : m.+1 * 'C(m, n) = n.+1 * 'C(m.+1, n.+1).
+(* Multiply to move diagonally down and right in the Pascal triangle. *)
+Lemma mul_bin_diag n m : n * 'C(n.-1, m) = m.+1 * 'C(n, m.+1).
 Proof.
-elim: m n => [|m IHm] [|n] //; first by rewrite bin0 bin1 muln1 mul1n.
-by rewrite mulSn {2}binS mulnDr addnCA !IHm -mulnDr.
+rewrite [RHS]mulnC; elim: n m => [|[|n] IHn] [|m] //=; first by rewrite bin1.
+by rewrite mulSn [in _ * _]binS mulnDr addnCA !IHn -mulnS -mulnDl -binS.
 Qed.
 
-Lemma bin_fact m n : n <= m -> 'C(m, n) * (n`! * (m - n)`!) = m`!.
+Lemma bin_fact n m : m <= n -> 'C(n, m) * (m`! * (n - m)`!) = n`!.
 Proof.
-move/subnKC; move: (m - n) => m0 <-{m}.
-elim: n => [|n IHn]; first by rewrite bin0 !mul1n.
-by rewrite -mulnA mulnCA mulnA -mul_Sm_binm -mulnA IHn.
+elim: n m => [|n IHn] [|m] // le_m_n; first by rewrite bin0 !mul1n.
+by rewrite !factS -!mulnA mulnCA mulnA -mul_bin_diag -mulnA IHn.
 Qed.
 
-(* In fact the only exception is n = 0 and m = 1 *)
-Lemma bin_factd n m : 0 < n -> 'C(n, m)  = n`! %/ (m`! * (n - m)`!).
+(* In fact the only exception for bin_factd is n = 0 and m = 1 *)
+Lemma bin_factd n m : 0 < n -> 'C(n, m) = n`! %/ (m`! * (n - m)`!).
 Proof.
-move=> n_gt0; have [/bin_fact <-|lt_n_m] := leqP m n.
-  by rewrite mulnK // muln_gt0 !fact_gt0.
-by rewrite bin_small // divnMA !divn_small ?fact_gt0 // fact_smonotone.
+have [/bin_fact<-|*] := leqP m n; first by rewrite mulnK ?muln_gt0 ?fact_gt0.
+by rewrite divnMA bin_small ?divn_small ?fact_gt0 ?fact_smonotone.
 Qed.
 
 Lemma bin_ffact n m : 'C(n, m) * m`! = n ^_ m.
 Proof.
-apply/eqP; have [lt_n_m | le_m_n] := ltnP n m.
-  by rewrite bin_small ?ffact_small.
-by rewrite -(eqn_pmul2r (fact_gt0 (n - m))) ffact_fact // -mulnA bin_fact.
+have [lt_n_m | le_m_n] := ltnP n m; first by rewrite bin_small ?ffact_small.
+by rewrite ffact_factd // -(bin_fact le_m_n) mulnA mulnK ?fact_gt0.
 Qed.
 
 Lemma bin_ffactd n m : 'C(n, m) = n ^_ m %/ m`!.
@@ -244,26 +240,35 @@ Proof. by rewrite -bin_ffact mulnK ?fact_gt0. Qed.
 
 Lemma bin_sub n m : m <= n -> 'C(n, n - m) = 'C(n, m).
 Proof.
-move=> le_m_n; apply/eqP; move/eqP: (bin_fact (leq_subr m n)).
-by rewrite subKn // -(bin_fact le_m_n) !mulnA mulnAC !eqn_pmul2r // fact_gt0.
+by move=> le_m_n; rewrite !bin_ffactd !ffact_factd ?leq_subr // divnAC subKn.
 Qed.
 
+(* Multiply to move down in the Pascal triangle. *)
+Lemma mul_bin_down n m : n * 'C(n.-1, m) = (n - m) * 'C(n, m).
+Proof.
+case: n => //= n; have [lt_n_m | le_m_n] := ltnP n m.
+  by rewrite (eqnP lt_n_m) mulnC bin_small.
+by rewrite -!['C(_, m)]bin_sub ?leqW ?subSn ?mul_bin_diag.
+Qed.
+
+(* Multiply to move left in the Pascal triangle. *)
+Lemma mul_bin_left n m : m.+1 * 'C(n, m.+1) = (n - m) * 'C(n, m).
+Proof. by rewrite -mul_bin_diag mul_bin_down. Qed.
+
 Lemma binSn n : 'C(n.+1, n) = n.+1.
 Proof. by rewrite -bin_sub ?leqnSn // subSnn bin1. Qed.
 
 Lemma bin2 n : 'C(n, 2) = (n * n.-1)./2.
-Proof.
-by case: n => //= n; rewrite -{3}[n]bin1 mul_Sm_binm mul2n half_double.
-Qed.
+Proof. by rewrite -[n.-1]bin1 mul_bin_diag -divn2 mulKn. Qed.
 
 Lemma bin2odd n : odd n -> 'C(n, 2) = n * n.-1./2.
 Proof. by case: n => // n oddn; rewrite bin2 -!divn2 muln_divA ?dvdn2. Qed.
 
 Lemma prime_dvd_bin k p : prime p -> 0 < k < p -> p %| 'C(p, k).
 Proof.
-move=> p_pr /andP[k_gt0 lt_k_p]; have def_p := ltn_predK lt_k_p.
-have: p %| p * 'C(p.-1, k.-1) by rewrite dvdn_mulr.
-by rewrite -def_p mul_Sm_binm def_p prednK // Euclid_dvdM // gtnNdvd.
+move=> p_pr /andP[k_gt0 lt_k_p].
+suffices /Gauss_dvdr<-: coprime p (p - k) by rewrite -mul_bin_down dvdn_mulr.
+by rewrite prime_coprime // dvdn_subr 1?ltnW // gtnNdvd.
 Qed.
 
 Lemma triangular_sum n : \sum_(0 <= i < n) i = 'C(n, 2).
diff --git a/mathcomp/ssreflect/choice.v b/mathcomp/ssreflect/choice.v
index 4146634..a696bbd 100644
--- a/mathcomp/ssreflect/choice.v
+++ b/mathcomp/ssreflect/choice.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/div.v b/mathcomp/ssreflect/div.v
index 8179f57..723946d 100644
--- a/mathcomp/ssreflect/div.v
+++ b/mathcomp/ssreflect/div.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/eqtype.v b/mathcomp/ssreflect/eqtype.v
index 85e531c..e11fd9f 100644
--- a/mathcomp/ssreflect/eqtype.v
+++ b/mathcomp/ssreflect/eqtype.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -177,8 +177,8 @@ Hint Resolve eq_refl eq_sym.
 
 Section Contrapositives.
 
-Variable T : eqType.
-Implicit Types (A : pred T) (b : bool) (x : T).
+Variables (T1 T2 : eqType).
+Implicit Types (A : pred T1) (b : bool) (x : T1) (z : T2).
 
 Lemma contraTeq b x y : (x != y -> ~~ b) -> b -> x = y.
 Proof. by move=> imp hyp; apply/eqP; apply: contraTT hyp. Qed.
@@ -207,10 +207,10 @@ Proof. by move=> imp /eqP; apply: contraTF. Qed.
 Lemma contra_eqT b x y : (~~ b -> x != y) -> x = y -> b.
 Proof. by move=> imp /eqP; apply: contraLR. Qed.
 
-Lemma contra_eq x1 y1 x2 y2 : (x2 != y2 -> x1 != y1) -> x1 = y1 -> x2 = y2.
+Lemma contra_eq z1 z2 x1 x2 : (x1 != x2 -> z1 != z2) -> z1 = z2 -> x1 = x2.
 Proof. by move=> imp /eqP; apply: contraTeq. Qed.
 
-Lemma contra_neq x1 y1 x2 y2 : (x2 = y2 -> x1 = y1) -> x1 != y1 -> x2 != y2.
+Lemma contra_neq z1 z2 x1 x2 : (x1 = x2 -> z1 = z2) -> z1 != z2 -> x1 != x2.
 Proof. by move=> imp; apply: contraNneq => /imp->. Qed.
 
 Lemma memPn A x : reflect {in A, forall y, y != x} (x \notin A).
@@ -230,8 +230,8 @@ Proof. by rewrite eq_sym; apply: ifN. Qed.
 
 End Contrapositives.
 
-Implicit Arguments memPn [T A x].
-Implicit Arguments memPnC [T A x].
+Implicit Arguments memPn [T1 A x].
+Implicit Arguments memPnC [T1 A x].
 
 Theorem eq_irrelevance (T : eqType) x y : forall e1 e2 : x = y :> T, e1 = e2.
 Proof.
diff --git a/mathcomp/ssreflect/finfun.v b/mathcomp/ssreflect/finfun.v
index 09f94f0..e00ddef 100644
--- a/mathcomp/ssreflect/finfun.v
+++ b/mathcomp/ssreflect/finfun.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/fingraph.v b/mathcomp/ssreflect/fingraph.v
index 54dde32..5a87c6c 100644
--- a/mathcomp/ssreflect/fingraph.v
+++ b/mathcomp/ssreflect/fingraph.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/finset.v b/mathcomp/ssreflect/finset.v
index 6fa29ff..feac3ab 100644
--- a/mathcomp/ssreflect/finset.v
+++ b/mathcomp/ssreflect/finset.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/fintype.v b/mathcomp/ssreflect/fintype.v
index 94fa2d8..215c69b 100644
--- a/mathcomp/ssreflect/fintype.v
+++ b/mathcomp/ssreflect/fintype.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/generic_quotient.v b/mathcomp/ssreflect/generic_quotient.v
index d78e0d8..5533832 100644
--- a/mathcomp/ssreflect/generic_quotient.v
+++ b/mathcomp/ssreflect/generic_quotient.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 (* -*- coding : utf-8 -*- *)
 
diff --git a/mathcomp/ssreflect/path.v b/mathcomp/ssreflect/path.v
index ec81f81..f5eb77b 100644
--- a/mathcomp/ssreflect/path.v
+++ b/mathcomp/ssreflect/path.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/plugin/trunk/ssreflect.ml4 b/mathcomp/ssreflect/plugin/trunk/ssreflect.ml4
index 6d512b1..72161e7 100644
--- a/mathcomp/ssreflect/plugin/trunk/ssreflect.ml4
+++ b/mathcomp/ssreflect/plugin/trunk/ssreflect.ml4
@@ -1,34 +1,35 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 (* This line is read by the Makefile's dist target: do not remove. *)
-DECLARE PLUGIN "ssreflect"
+DECLARE PLUGIN "ssreflect_plugin"
 let ssrversion = "1.6";;
 let ssrAstVersion = 1;;
 let () = Mltop.add_known_plugin (fun () ->
   if Flags.is_verbose () && not !Flags.batch_mode then begin
     Printf.printf "\nSmall Scale Reflection version %s loaded.\n" ssrversion;
-    Printf.printf "Copyright 2005-2014 Microsoft Corporation and INRIA.\n";
+    Printf.printf "Copyright 2005-2016 Microsoft Corporation and INRIA.\n";
     Printf.printf "Distributed under the terms of the CeCILL-B license.\n\n"
   end)
-  "ssreflect"
+  "ssreflect_plugin"
 ;;
 
 (* Defining grammar rules with "xx" in it automatically declares keywords too,
  * we thus save the lexer to restore it at the end of the file *)
-let frozen_lexer = Lexer.freeze () ;;
+let frozen_lexer = CLexer.freeze () ;;
 
 (*i camlp4use: "pa_extend.cmo" i*)
 (*i camlp4deps: "grammar/grammar.cma" i*)
 
 open Names
 open Pp
+open Feedback
 open Pcoq
 open Pcoq.Prim
 open Pcoq.Constr
 open Genarg
 open Stdarg
-open Constrarg
+open Tacarg
 open Term
 open Vars
 open Context
@@ -44,6 +45,7 @@ open Coqlib
 open Glob_term
 open Util
 open Evd
+open Proofview.Notations
 open Sigma.Notations
 open Extend
 open Goptions
@@ -51,7 +53,7 @@ open Tacexpr
 open Tacinterp
 open Pretyping
 open Constr
-open Tactic
+open Pltac
 open Extraargs
 open Ppconstr
 open Printer
@@ -70,8 +72,11 @@ open Locusops
 open Compat
 open Tok
 
+open Ssrmatching_plugin
 open Ssrmatching
 
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
 
 (* Tentative patch from util.ml *)
 
@@ -95,9 +100,13 @@ module Intset = Evar.Set
 
 type loc = Loc.t
 let dummy_loc = Loc.ghost
-let errorstrm = Errors.errorlabstrm "ssreflect"
-let loc_error loc msg = Errors.user_err_loc (loc, msg, str msg)
-let anomaly s = Errors.anomaly (str s)
+let errorstrm msg = CErrors.user_err ~hdr:"ssreflect" msg
+let loc_error loc msg = CErrors.user_err ~loc ~hdr:msg (str msg)
+let anomaly s = CErrors.anomaly (str s)
+
+(* Compatibility with Coq 8.6 *)
+let ppnl  = msg_info
+let msgnl = msg_info
 
 (** look up a name in the ssreflect internals module *)
 let ssrdirpath = make_dirpath [id_of_string "ssreflect"]
@@ -108,7 +117,7 @@ let locate_reference qid =
 let mkSsrRef name =
   try locate_reference (ssrqid name) with Not_found ->
   try locate_reference (ssrtopqid name) with Not_found ->
-  Errors.error "Small scale reflection library not loaded"
+  CErrors.error "Small scale reflection library not loaded"
 let mkSsrRRef name = GRef (dummy_loc, mkSsrRef name,None), None
 let mkSsrConst name env sigma =
   Sigma.fresh_global env sigma (mkSsrRef name)
@@ -136,13 +145,13 @@ let pf_fresh_global name gl =
 let ssr_loaded = Summary.ref ~name:"SSR:loaded" false
 let is_ssr_loaded () =
   !ssr_loaded ||
-  (if Lexer.is_keyword "SsrSyntax_is_Imported" then ssr_loaded:=true;
+  (if CLexer.is_keyword "SsrSyntax_is_Imported" then ssr_loaded:=true;
    !ssr_loaded)
 
 (* 0 cost pp function. Active only if env variable SSRDEBUG is set *)
 (* or if SsrDebug is Set                                                  *)
 let pp_ref = ref (fun _ -> ())
-let ssr_pp s = pperrnl (str"SSR: "++Lazy.force s)
+let ssr_pp s = msg_error (str"SSR: "++Lazy.force s)
 let _ = try ignore(Sys.getenv "SSRDEBUG"); pp_ref := ssr_pp with Not_found -> ()
 let _ =
   Goptions.declare_bool_option
@@ -209,13 +218,15 @@ let prl_term (k, c) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
 (** Adding a new uninterpreted generic argument type *)
 let add_genarg tag pr =
   let wit = Genarg.make0 tag in
+  let tag = Geninterp.Val.create tag in
   let glob ist x = (ist, x) in
   let subst _ x = x in
-  let interp ist x = Ftactic.return x in
+  let interp ist x = Ftactic.return (Geninterp.Val.Dyn (tag, x)) in
   let gen_pr _ _ _ = pr in
   let () = Genintern.register_intern0 wit glob in
   let () = Genintern.register_subst0 wit subst in
   let () = Geninterp.register_interp0 wit interp in
+  let () = Geninterp.register_val0 wit (Some (Geninterp.Val.Base tag)) in
   Pptactic.declare_extra_genarg_pprule wit gen_pr gen_pr gen_pr;
   wit
 
@@ -447,7 +458,7 @@ let mk_profiler s =
 let inVersion = Libobject.declare_object {
   (Libobject.default_object "SSRASTVERSION") with
   Libobject.load_function = (fun _ (_,v) -> 
-    if v <> ssrAstVersion then Errors.error "Please recompile your .vo files");
+    if v <> ssrAstVersion then CErrors.error "Please recompile your .vo files");
   Libobject.classify_function = (fun v -> Libobject.Keep v);
 }
 
@@ -461,7 +472,7 @@ let _ =
       Goptions.optwrite = (fun _ -> 
         Lib.add_anonymous_leaf (inVersion ssrAstVersion)) }
 
-let tactic_expr = Tactic.tactic_expr
+let tactic_expr = Pltac.tactic_expr
 let gallina_ext = Vernac_.gallina_ext 
 let sprintf = Printf.sprintf
 let tactic_mode = G_ltac.tactic_mode
@@ -555,7 +566,7 @@ let is_pf_var c = isVar c && not_section_id (destVar c)
 
 let pf_ids_of_proof_hyps gl =
   let add_hyp decl ids =
-    let id = Named.Declaration.get_id decl in
+    let id = NamedDecl.get_id decl in
     if not_section_id id then id :: ids else ids in
   Context.Named.fold_outside add_hyp (pf_hyps gl) ~init:[]
 
@@ -590,15 +601,15 @@ let apply_type x xs = Proofview.V82.of_tactic (apply_type x xs)
 
 (* we reduce head beta redexes *)
 let betared env = 
-  Closure.create_clos_infos 
-   (Closure.RedFlags.mkflags [Closure.RedFlags.fBETA])
+  CClosure.create_clos_infos 
+   (CClosure.RedFlags.mkflags [CClosure.RedFlags.fBETA])
     env
 ;;
 let introid name = tclTHEN (fun gl ->
    let g, env = pf_concl gl, pf_env gl in
    match kind_of_term g with
    | App (hd, _) when isLambda hd -> 
-     let g = Closure.whd_val (betared env) (Closure.inject g) in
+     let g = CClosure.whd_val (betared env) (CClosure.inject g) in
      Proofview.V82.of_tactic (convert_concl_no_check g) gl
    | _ -> tclIDTAC gl)
   (Proofview.V82.of_tactic (intro_mustbe_force name))
@@ -747,7 +758,7 @@ let mk_anon_id t gl =
 let ssr_anon_hyp = "Hyp"
 
 let anontac decl gl =
-  let id =  match Rel.Declaration.get_name decl with
+  let id =  match RelDecl.get_name decl with
   | Name id ->
     if is_discharged_id id then id else mk_anon_id (string_of_id id) gl
   | _ -> mk_anon_id ssr_anon_hyp gl in
@@ -797,9 +808,9 @@ let pf_abs_evars gl (sigma, c0) =
   let abs_evar n k =
     let evi = Evd.find sigma k in
     let dc = List.firstn n (evar_filtered_context evi) in
-    let abs_dc c decl = match Named.Declaration.to_tuple decl with
-    | x, Some b, t -> mkNamedLetIn x b t (mkArrow t c)
-    | x, None, t -> mkNamedProd x t c in
+    let abs_dc c = function
+    | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
+    | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
     let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
     Evarutil.nf_evar sigma t in
   let rec put evlist c = match kind_of_term c with
@@ -852,9 +863,9 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
   let abs_evar n k =
     let evi = Evd.find sigma k in
     let dc = List.firstn n (evar_filtered_context evi) in
-    let abs_dc c decl = match Named.Declaration.to_tuple decl with
-    | x, Some b, t -> mkNamedLetIn x b t (mkArrow t c)
-    | x, None, t -> mkNamedProd x t c in
+    let abs_dc c = function
+    | NamedDecl.LocalDef (x,b,t) -> mkNamedLetIn x b t (mkArrow t c)
+    | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
     let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
     Evarutil.nf_evar sigma0 (Evarutil.nf_evar sigma t) in
   let rec put evlist c = match kind_of_term c with
@@ -992,10 +1003,10 @@ let pf_unabs_evars gl ise n c0 =
   let push_rel = Environ.push_rel in
   let rec mk_evar j env i c = match kind_of_term c with
   | Prod (x, t, c1) when i < j ->
-    mk_evar j (push_rel (Rel.Declaration.LocalAssum (x, unabs i t)) env) (i + 1) c1
+    mk_evar j (push_rel (RelDecl.LocalAssum (x, unabs i t)) env) (i + 1) c1
   | LetIn (x, b, t, c1) when i < j ->
     let _, _, c2 = destProd c1 in
-    mk_evar j (push_rel (Rel.Declaration.LocalDef (x, unabs i b, unabs i t)) env) (i + 1) c2
+    mk_evar j (push_rel (RelDecl.LocalDef (x, unabs i b, unabs i t)) env) (i + 1) c2
   | _ -> Evarutil.e_new_evar env ise (unabs i c) in
   let rec unabs_evars c =
     if !nev = n then unabs n c else match kind_of_term c with
@@ -1021,7 +1032,7 @@ let pf_unabs_evars gl ise n c0 =
 type ssrargfmt = ArgSsr of string | ArgCoq of argument_type | ArgSep of string
 
 let ssrtac_name name = {
-  mltac_plugin = "ssreflect";
+  mltac_plugin = "ssreflect_plugin";
   mltac_tactic = "ssr" ^ name;
 }
 
@@ -1082,7 +1093,7 @@ let interp_refine ist gl rc =
   let kind = OfType (pf_concl gl) in
   let flags = {
     use_typeclasses = true;
-    use_unif_heuristics = true;
+    solve_unification_constraints = true;
     use_hook = None;
     fail_evar = false;
     expand_evars = true }
@@ -1128,7 +1139,7 @@ let interp_view_nbimps ist gl rc =
     let si = sig_it gl in
     let gl = re_sig si sigma in
     let pl, c = splay_open_constr gl t in
-    if isAppInd gl c then List.length pl else ~-(List.length pl)
+    if isAppInd gl c then List.length pl else (-(List.length pl))
   with _ -> 0
 
 (* }}} *)
@@ -1212,18 +1223,18 @@ let interp_search_notation loc s opt_scope =
         let ambig = "This string refers to a complex or ambiguous notation." in
         str ambig ++ str "\nTry searching with one of\n" ++ ntns
       with _ -> str "This string is not part of an identifier or notation." in
-    Errors.user_err_loc (loc, "interp_search_notation", diagnosis)
+    CErrors.user_err ~loc ~hdr:"interp_search_notation" diagnosis
 
 let pr_ssr_search_item _ _ _ = pr_search_item
 
 (* Workaround the notation API that can only print notations *)
 
-let is_ident s = try Lexer.check_ident s; true with _ -> false
+let is_ident s = try CLexer.check_ident s; true with _ -> false
 
 let is_ident_part s = is_ident ("H" ^ s)
 
 let interp_search_notation loc tag okey =
-  let err msg = Errors.user_err_loc (loc, "interp_search_notation", msg) in
+  let err msg = CErrors.user_err ~loc ~hdr:"interp_search_notation" msg in
   let mk_pntn s for_key =
     let n = String.length s in
     let s' = String.make (n + 2) ' ' in
@@ -1347,7 +1358,7 @@ let rec splay_search_pattern na = function
   | Pattern.PApp (fp, args) -> splay_search_pattern (na + Array.length args) fp
   | Pattern.PLetIn (_, _, bp) -> splay_search_pattern na bp
   | Pattern.PRef hr -> hr, na
-  | _ -> Errors.error "no head constant in head search pattern"
+  | _ -> CErrors.error "no head constant in head search pattern"
 
 let coerce_search_pattern_to_sort hpat =
   let env = Global.env () and sigma = Evd.empty in
@@ -1358,7 +1369,7 @@ let coerce_search_pattern_to_sort hpat =
   let dc, ht =
     Reductionops.splay_prod env sigma (Universes.unsafe_type_of_global hr) in
   let np = List.length dc in
-  if np < na then Errors.error "too many arguments in head search pattern" else
+  if np < na then CErrors.error "too many arguments in head search pattern" else
   let hpat' = if np = na then hpat else mkPApp hpat (np - na) [||] in
   let warn () =
     msg_warning (str "Listing only lemmas with conclusion matching " ++ 
@@ -1409,7 +1420,7 @@ let interp_search_arg arg =
       try
         let intern = Constrintern.intern_constr_pattern in 
         Search.GlobSearchSubPattern (snd (intern (Global.env()) p))
-      with e -> let e = Errors.push e in iraise (Cerrors.process_vernac_interp_error e)) arg in
+      with e -> let e = CErrors.push e in iraise (ExplainErr.process_vernac_interp_error e)) arg in
   let hpat, a1 = match arg with
   | (_, Search.GlobSearchSubPattern (Pattern.PMeta _)) :: a' -> all_true, a'
   | (true, Search.GlobSearchSubPattern p) :: a' ->
@@ -1444,7 +1455,7 @@ let interp_modloc mr =
   let interp_mod (_, mr) =
     let (loc, qid) = qualid_of_reference mr in
     try Nametab.full_name_module qid with Not_found ->
-    Errors.user_err_loc (loc, "interp_modloc", str "No Module " ++ pr_qualid qid) in
+    CErrors.user_err ~loc ~hdr:"interp_modloc" (str "No Module " ++ pr_qualid qid) in
   let mr_out, mr_in = List.partition fst mr in
   let interp_bmod b = function
   | [] -> fun _ _ _ -> true
@@ -1455,7 +1466,7 @@ let interp_modloc mr =
 (* The unified, extended vernacular "Search" command *)
 
 let ssrdisplaysearch gr env t =
-  let pr_res = pr_global gr ++ spc () ++ str " " ++ pr_lconstr_env env Evd.empty t in
+  let pr_res = pr_global gr ++ str ":" ++ spc () ++ pr_lconstr_env env Evd.empty t in
   msg_info (hov 2 pr_res ++ fnl ())
 
 VERNAC COMMAND EXTEND SsrSearchPattern CLASSIFIED AS QUERY
@@ -1576,7 +1587,7 @@ let donetac gl =
   let tacname = 
     try Nametab.locate_tactic (qualid_of_ident (id_of_string "done"))
     with Not_found -> try Nametab.locate_tactic (ssrqid "done")
-    with Not_found -> Errors.error "The ssreflect library was not loaded" in
+    with Not_found -> CErrors.error "The ssreflect library was not loaded" in
   let tacexpr = dummy_loc, Tacexpr.Reference (ArgArg (dummy_loc, tacname)) in
   Proofview.V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl
 
@@ -1750,7 +1761,7 @@ let pr_ssrhyp _ _ _ = pr_hyp
 let wit_ssrhyprep = add_genarg "ssrhyprep" pr_hyp
 
 let hyp_err loc msg id =
-  Errors.user_err_loc (loc, "ssrhyp", str msg ++ pr_id id)
+  CErrors.user_err ~loc ~hdr:"ssrhyp" (str msg ++ pr_id id)
 
 let intern_hyp ist (SsrHyp (loc, id) as hyp) =
   let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_var) (loc, id)) in
@@ -1862,8 +1873,8 @@ ARGUMENT EXTEND ssrterm
      PRINTED BY pr_ssrterm
      INTERPRETED BY interp_ssrterm
      GLOBALIZED BY glob_ssrterm SUBSTITUTED BY subst_ssrterm
-     RAW_TYPED AS cpattern RAW_PRINTED BY pr_ssrterm
-     GLOB_TYPED AS cpattern GLOB_PRINTED BY pr_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
 | [ "YouShouldNotTypeThis" constr(c) ] -> [ mk_lterm c ]
 END
 
@@ -1904,7 +1915,7 @@ ARGUMENT EXTEND ssrclear TYPED AS ssrclear_ne PRINTED BY pr_ssrclear
 | [ ] -> [ [] ]
 END
 
-let cleartac clr = check_hyps_uniq [] clr; clear (hyps_ids clr)
+let cleartac clr = check_hyps_uniq [] clr; Proofview.V82.of_tactic (clear (hyps_ids clr))
 
 (* type ssrwgen = ssrclear * ssrhyp * string *)
 
@@ -1988,10 +1999,10 @@ let rec safe_depth c = match kind_of_term c with
 let red_safe r e s c0 =
   let rec red_to e c n = match kind_of_term c with
   | Prod (x, t, c') when n > 0 ->
-    let t' = r e s t in let e' = Environ.push_rel (Rel.Declaration.LocalAssum (x, t')) e in
+    let t' = r e s t in let e' = Environ.push_rel (RelDecl.LocalAssum (x, t')) e in
     mkProd (x, t', red_to e' c' (n - 1))
   | LetIn (x, b, t, c') when n > 0 ->
-    let t' = r e s t in let e' = Environ.push_rel (Rel.Declaration.LocalAssum (x, t')) e in
+    let t' = r e s t in let e' = Environ.push_rel (RelDecl.LocalAssum (x, t')) e in
     mkLetIn (x, r e s b, t', red_to e' c' (n - 1))
   | _ -> r e s c in
   red_to e c0 (safe_depth c0)
@@ -2012,7 +2023,7 @@ let pf_clauseids gl gens clseq =
   let keep_clears = List.map (fun (x, _) -> x, None) in
   if gens <> [] then (check_wgen_uniq gens; gens) else
   if clseq <> InAll && clseq <> InAllHyps then keep_clears gens else
-  Errors.error "assumptions should be named explicitly"
+  CErrors.error "assumptions should be named explicitly"
 
 let hidden_clseq = function InHyps | InHypsSeq | InAllHyps -> true | _ -> false
 
@@ -2023,10 +2034,10 @@ let hidetacs clseq idhide cl0 =
 
 let discharge_hyp (id', (id, mode)) gl =
   let cl' = subst_var id (pf_concl gl) in
-  match Named.Declaration.to_tuple (pf_get_hyp gl id), mode with
-  | (_, None, t), _ | (_, Some _, t), "(" -> 
+  match pf_get_hyp gl id, mode with
+  | NamedDecl.LocalAssum (_, t), _ | NamedDecl.LocalDef (_, _, t), "(" ->
      apply_type (mkProd (Name id', t, cl')) [mkVar id] gl
-  | (_, Some v, t), _ ->
+  | NamedDecl.LocalDef (_, v, t), _ ->
      Proofview.V82.of_tactic (convert_concl (mkLetIn (Name id', v, t, cl'))) gl
 
 let endclausestac id_map clseq gl_id cl0 gl =
@@ -2036,7 +2047,7 @@ let endclausestac id_map clseq gl_id cl0 gl =
   let hide_goal = hidden_clseq clseq in
   let c_hidden = hide_goal && c = mkVar gl_id in
   let rec fits forced = function
-  | (id, _) :: ids, decl :: dc' when Rel.Declaration.get_name decl = Name id ->
+  | (id, _) :: ids, decl :: dc' when RelDecl.get_name decl = Name id ->
     fits true (ids, dc')
   | ids, dc' ->
     forced && ids = [] && (not hide_goal || dc' = [] && c_hidden) in
@@ -2049,18 +2060,18 @@ let endclausestac id_map clseq gl_id cl0 gl =
   | _ -> map_constr unmark c in
   let utac hyp =
     Proofview.V82.of_tactic 
-     (convert_hyp_no_check (Context.Named.Declaration.map_constr unmark hyp)) in
+     (convert_hyp_no_check (NamedDecl.map_constr unmark hyp)) in
   let utacs = List.map utac (pf_hyps gl) in
   let ugtac gl' =
     Proofview.V82.of_tactic
       (convert_concl_no_check (unmark (pf_concl gl'))) gl' in
-  let ctacs = if hide_goal then [clear [gl_id]] else [] in
+  let ctacs = if hide_goal then [Proofview.V82.of_tactic (clear [gl_id])] else [] in
   let mktac itacs = tclTHENLIST (itacs @ utacs @ ugtac :: ctacs) in
   let itac (_, id) = Proofview.V82.of_tactic (introduction id) in
   if fits false (id_map, List.rev dc) then mktac (List.map itac id_map) gl else
   let all_ids = ids_of_rel_context dc @ pf_ids_of_hyps gl in
   if List.for_all not_hyp' all_ids && not c_hidden then mktac [] gl else
-  Errors.error "tampering with discharged assumptions of \"in\" tactical"
+  CErrors.error "tampering with discharged assumptions of \"in\" tactical"
 
 let is_id_constr c = match kind_of_term c with
   | Lambda(_,_,c) when isRel c -> 1 = destRel c
@@ -2074,19 +2085,20 @@ let abs_wgen keep_let ist f gen (gl,args,c) =
   let sigma, env = project gl, pf_env gl in
   let evar_closed t p =
     if occur_existential t then
-      Errors.user_err_loc (loc_of_cpattern p,"ssreflect",
-        pr_constr_pat t ++
+      CErrors.user_err ~loc:(loc_of_cpattern p) ~hdr:"ssreflect"
+        (pr_constr_pat t ++
         str" contains holes and matches no subterm of the goal") in
   match gen with
   | _, Some ((x, mode), None) when mode = "@" || (mode = " " && keep_let) ->
      let x = hoi_id x in
-     let _, bo, ty = Named.Declaration.to_tuple (pf_get_hyp gl x) in
+     let decl = pf_get_hyp gl x in
      gl,
-     (if bo <> None then args else mkVar x :: args),
-     mkProd_or_LetIn (Rel.Declaration.of_tuple (Name (f x),bo,ty)) (subst_var x c)
+     (if NamedDecl.is_local_def decl then args else mkVar x :: args),
+     mkProd_or_LetIn (decl |> NamedDecl.to_rel_decl |> RelDecl.set_name (Name (f x)))
+                     (subst_var x c)
   | _, Some ((x, _), None) ->
      let x = hoi_id x in
-     gl, mkVar x :: args, mkProd (Name (f x), pf_get_hyp_typ gl x, subst_var x c)
+     gl, mkVar x :: args, mkProd (Name (f x),pf_get_hyp_typ gl x, subst_var x c)
   | _, Some ((x, "@"), Some p) -> 
      let x = hoi_id x in
      let cp = interp_cpattern ist gl p None in
@@ -2381,7 +2393,7 @@ END
 (* Populating the table *)
 
 let cache_viewhint (_, (i, lvh)) =
-  let mem_raw h = List.exists (Notation_ops.eq_glob_constr h) in
+  let mem_raw h = List.exists (Glob_ops.glob_constr_eq h) in
   let add_hint h hdb = if mem_raw h hdb then hdb else h :: hdb in
   viewtab.(i) <- List.fold_right add_hint lvh viewtab.(i)
 
@@ -2513,7 +2525,7 @@ let rec ipat_of_intro_pattern = function
   | IntroNaming IntroAnonymous -> IpatAnon
   | IntroAction (IntroRewrite b) -> IpatRw (allocc, if b then L2R else R2L)
   | IntroNaming (IntroFresh id) -> IpatAnon
-  | IntroAction (IntroApplyOn _) -> (* to do *) Errors.error "TO DO"
+  | IntroAction (IntroApplyOn _) -> (* to do *) CErrors.error "TO DO"
   | IntroAction (IntroInjection ips) ->
       IpatCase [List.map ipat_of_intro_pattern (List.map remove_loc ips)]
   | IntroForthcoming _ -> (* Unable to determine which kind of ipat interp_introid could return [HH] *)
@@ -2678,7 +2690,7 @@ END
 
 (* subsets of patterns *)
 let check_ssrhpats loc w_binders ipats =
-  let err_loc s = Errors.user_err_loc (loc, "ssreflect", s) in
+  let err_loc s = CErrors.user_err ~loc ~hdr:"ssreflect" s in
   let clr, ipats =
     let rec aux clr = function
       | IpatSimpl (cl, Nop) :: tl -> aux (clr @ cl) tl
@@ -2771,8 +2783,8 @@ let equality_inj l b id c gl =
   let msg = ref "" in
   try Proofview.V82.of_tactic (Equality.inj l b None c) gl
   with
-    | Compat.Exc_located(_,Errors.UserError (_,s))
-    | Errors.UserError (_,s)
+    | Compat.Exc_located(_,CErrors.UserError (_,s))
+    | CErrors.UserError (_,s)
   when msg := Pp.string_of_ppcmds s;
        !msg = "Not a projectable equality but a discriminable one." ||
        !msg = "Nothing to inject." ->
@@ -2786,7 +2798,7 @@ let injectl2rtac c = match kind_of_term c with
 | Var id -> injectidl2rtac id (mkVar id, NoBindings)
 | _ ->
   let id = injecteq_id in
-  tclTHENLIST [havetac id c; injectidl2rtac id (mkVar id, NoBindings); clear [id]]
+  tclTHENLIST [havetac id c; injectidl2rtac id (mkVar id, NoBindings); Proofview.V82.of_tactic (clear [id])]
 
 let is_injection_case c gl =
   let gl, cty = pf_type_of gl c in
@@ -2799,7 +2811,7 @@ let perform_injection c gl =
   let dc, eqt = decompose_prod t in
   if dc = [] then injectl2rtac c gl else
   if not (closed0 eqt) then
-    Errors.error "can't decompose a quantified equality" else
+    CErrors.error "can't decompose a quantified equality" else
   let cl = pf_concl gl in let n = List.length dc in
   let c_eq = mkEtaApp c n 2 in
   let cl1 = mkLambda (Anonymous, mkArrow eqt cl, mkApp (mkRel 1, [|c_eq|])) in
@@ -2822,10 +2834,10 @@ let intro_all gl =
 let rec intro_anon gl =
   try anontac (List.hd (fst (Term.decompose_prod_n_assum 1 (pf_concl gl)))) gl
   with err0 -> try tclTHEN (Proofview.V82.of_tactic red_in_concl) intro_anon gl with _ -> raise err0
-  (* with _ -> Errors.error "No product even after reduction" *)
+  (* with _ -> CErrors.error "No product even after reduction" *)
 
 let with_top tac =
-  tclTHENLIST [introid top_id; tac (mkVar top_id); clear [top_id]]
+  tclTHENLIST [introid top_id; tac (mkVar top_id); Proofview.V82.of_tactic (clear [top_id])]
 
 let rec mapLR f = function [] -> [] | x :: s -> let y = f x in y :: mapLR f s
 
@@ -2838,16 +2850,16 @@ let new_wild_id () =
   id
 
 let clear_wilds wilds gl =
-  clear (List.filter (fun id -> List.mem id wilds) (pf_ids_of_hyps gl)) gl
+  Proofview.V82.of_tactic (clear (List.filter (fun id -> List.mem id wilds) (pf_ids_of_hyps gl))) gl
 
 let clear_with_wilds wilds clr0 gl =
   let extend_clr clr nd =
-    let id = Named.Declaration.get_id nd in
+    let id = NamedDecl.get_id nd in
     if List.mem id clr || not (List.mem id wilds) then clr else
     let vars = global_vars_set_of_decl (pf_env gl) nd in
     let occurs id' = Idset.mem id' vars in
     if List.exists occurs clr then id :: clr else clr in
-  clear (Context.Named.fold_inside extend_clr ~init:clr0 (pf_hyps gl)) gl
+  Proofview.V82.of_tactic (clear (Context.Named.fold_inside extend_clr ~init:clr0 (pf_hyps gl))) gl
 
 let tclTHENS_nonstrict tac tacl taclname gl =
   let tacres = tac gl in
@@ -2896,7 +2908,7 @@ let ssrmkabs id gl =
       let Sigma (m, sigma, p5) = Evarutil.new_evar env sigma abstract_ty in
       Sigma ((m, abstract_ty), sigma, p1 +> p2 +> p3 +> p4 +> p5) in
     let sigma, kont =
-      let rd = Rel.Declaration.LocalAssum (Name id, abstract_ty) in
+      let rd = RelDecl.LocalAssum (Name id, abstract_ty) in
       let Sigma (ev, sigma, _) = Evarutil.new_evar (Environ.push_rel rd env) sigma concl in
       let sigma = Sigma.to_evar_map sigma in
       (sigma, ev)
@@ -3072,12 +3084,12 @@ let tclDO n tac =
   let tac_err_at i gl =
     try tac gl
     with 
-    | Errors.UserError (l, s) as e ->
-        let _, info = Errors.push e in
-        let e' = Errors.UserError (l, prefix i ++ s) in
+    | CErrors.UserError (l, s) as e ->
+        let _, info = CErrors.push e in
+        let e' = CErrors.UserError (l, prefix i ++ s) in
         Util.iraise (e', info)
-    | Compat.Exc_located(loc, Errors.UserError (l, s))  -> 
-        raise (Compat.Exc_located(loc, Errors.UserError (l, prefix i ++ s))) in
+    | Compat.Exc_located(loc, CErrors.UserError (l, s))  -> 
+        raise (Compat.Exc_located(loc, CErrors.UserError (l, prefix i ++ s))) in
   let rec loop i gl =
     if i = n then tac_err_at i gl else
     (tclTHEN (tac_err_at i) (loop (i + 1))) gl in
@@ -3244,7 +3256,7 @@ let tclREV tac gl = tclPERM List.rev tac gl
 let rot_hyps dir i hyps =
   let n = List.length hyps in
   if i = 0 then List.rev hyps else
-  if i > n then Errors.error "Not enough subgoals" else
+  if i > n then CErrors.error "Not enough subgoals" else
   let rec rot i l_hyps = function
     | hyp :: hyps' when i > 0 -> rot (i - 1) (hyp :: l_hyps) hyps'
     | hyps' -> hyps' @ (List.rev l_hyps) in
@@ -3397,7 +3409,7 @@ let saturate ?(beta=false) ?(bi_types=false) env sigma c ?(ty=Retyping.get_type_
   | AtomicType _ ->
       let ty = 
         prof_saturate_whd.profile      
-        (Reductionops.whd_betadeltaiota env sigma) ty in
+        (Reductionops.whd_all env sigma) ty in
       match kind_of_type ty with
       | ProdType _ -> loop ty args sigma n
       | _ -> raise NotEnoughProducts
@@ -3447,9 +3459,9 @@ let pf_interp_gen_aux ist gl to_ind ((oclr, occ), t) =
     if tag_of_cpattern t = '@' then 
       if not (isVar c) then
 	errorstrm (str "@ can be used with variables only")
-      else match Named.Declaration.to_tuple (pf_get_hyp gl (destVar c)) with
-      | _, None, _ -> errorstrm (str "@ can be used with let-ins only")
-      | name, Some bo, ty -> true, pat, mkLetIn (Name name,bo,ty,cl),c,clr,ucst,gl
+      else match pf_get_hyp gl (destVar c) with
+      | NamedDecl.LocalAssum _ -> errorstrm (str "@ can be used with let-ins only")
+      | NamedDecl.LocalDef (name, b, ty) -> true, pat, mkLetIn (Name name,b,ty,cl),c,clr,ucst,gl
     else let gl, ccl =  pf_mkprod gl c cl in false, pat, ccl, c, clr,ucst,gl
   else if to_ind && occ = None then
     let nv, p, _, ucst' = pf_abs_evars gl (fst pat, c) in
@@ -3462,7 +3474,7 @@ let pf_interp_gen_aux ist gl to_ind ((oclr, occ), t) =
 let genclrtac cl cs clr =
   let tclmyORELSE tac1 tac2 gl =
     try tac1 gl
-    with e when Errors.noncritical e -> tac2 e gl in
+    with e when CErrors.noncritical e -> tac2 e gl in
   (* apply_type may give a type error, but the useful message is
    * the one of clear.  You type "move: x" and you get
    * "x is used in hyp H" instead of
@@ -3521,7 +3533,7 @@ let cons_gen gen = function
 
 let cons_dep (gensl, clr) =
   if List.length gensl = 1 then ([] :: gensl, clr) else
-  Errors.error "multiple dependents switches '/'"
+  CErrors.error "multiple dependents switches '/'"
 
 ARGUMENT EXTEND ssrdgens_tl TYPED AS ssrgen list list * ssrclear
                             PRINTED BY pr_ssrdgens
@@ -3566,7 +3578,7 @@ let with_dgens (gensl, clr) maintac ist = match gensl with
 
 let first_goal gls =
   let gl = gls.Evd.it and sig_0 = gls.Evd.sigma in
-  if List.is_empty gl then Errors.error "first_goal";
+  if List.is_empty gl then CErrors.error "first_goal";
   { Evd.it = List.hd gl; Evd.sigma = sig_0; }
 
 let with_deps deps0 maintac cl0 cs0 clr0 ist gl0 =
@@ -3706,13 +3718,13 @@ let rec improper_intros = function
 
 let check_movearg = function
   | view, (eqid, _) when view <> [] && eqid <> None ->
-    Errors.error "incompatible view and equation in move tactic"
+    CErrors.error "incompatible view and equation in move tactic"
   | view, (_, (([gen :: _], _), _)) when view <> [] && has_occ gen ->
-    Errors.error "incompatible view and occurrence switch in move tactic"
+    CErrors.error "incompatible view and occurrence switch in move tactic"
   | _, (_, ((dgens, _), _)) when List.length dgens > 1 ->
-    Errors.error "dependents switch `/' in move tactic"
+    CErrors.error "dependents switch `/' in move tactic"
   | _, (eqid, (_, ipats)) when eqid <> None && improper_intros ipats ->
-    Errors.error "no proper intro pattern for equation in move tactic"
+    CErrors.error "no proper intro pattern for equation in move tactic"
   | arg -> arg
 
 ARGUMENT EXTEND ssrmovearg TYPED AS ssrarg PRINTED BY pr_ssrarg
@@ -3771,11 +3783,11 @@ let analyze_eliminator elimty env sigma =
   | AtomicType (hd, args) when isRel hd -> 
     ctx, destRel hd, not (noccurn 1 t), Array.length args
   | CastType (t, _) -> loop ctx t
-  | ProdType (x, ty, t) -> loop (Rel.Declaration.LocalAssum (x, ty) :: ctx) t
-  | LetInType (x,b,ty,t) -> loop (Rel.Declaration.LocalDef (x, b, ty) :: ctx) (subst1 b t)
+  | ProdType (x, ty, t) -> loop (RelDecl.LocalAssum (x, ty) :: ctx) t
+  | LetInType (x,b,ty,t) -> loop (RelDecl.LocalDef (x, b, ty) :: ctx) (subst1 b t)
   | _ ->
     let env' = Environ.push_rel_context ctx env in
-    let t' = Reductionops.whd_betadeltaiota env' sigma t in
+    let t' = Reductionops.whd_all env' sigma t in
     if not (Term.eq_constr t t') then loop ctx t' else
       errorstrm (str"The eliminator has the wrong shape."++spc()++
       str"A (applied) bound variable was expected as the conclusion of "++
@@ -3807,14 +3819,16 @@ let unprotecttac gl =
     let hyploc = Option.map (fun id -> id, InHyp) idopt in
     Proofview.V82.of_tactic (reduct_option 
       (Reductionops.clos_norm_flags 
-        (Closure.RedFlags.mkflags 
-          [Closure.RedFlags.fBETA;
-           Closure.RedFlags.fCONST prot;
-           Closure.RedFlags.fIOTA]), DEFAULTcast) hyploc))
+        (CClosure.RedFlags.mkflags 
+          [CClosure.RedFlags.fBETA;
+           CClosure.RedFlags.fCONST prot;
+           CClosure.RedFlags.fMATCH;
+           CClosure.RedFlags.fFIX;
+           CClosure.RedFlags.fCOFIX]), DEFAULTcast) hyploc))
     allHypsAndConcl gl
 
 let dependent_apply_error =
-  try Errors.error "Could not fill dependent hole in \"apply\"" with err -> err
+  try CErrors.error "Could not fill dependent hole in \"apply\"" with err -> err
 
 (* TASSI: Sometimes Coq's apply fails. According to my experience it may be
  * related to goals that are products and with beta redexes. In that case it
@@ -3868,7 +3882,7 @@ let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc gl =
   in
   pp(lazy(str"after: " ++ pr_constr oc));
   try applyn ~with_evars ~with_shelve:true ?beta n oc gl
-  with e when Errors.noncritical e -> raise dependent_apply_error
+  with e when CErrors.noncritical e -> raise dependent_apply_error
 
 let pf_fresh_inductive_instance ind gl =
   let sigma, env, it = project gl, pf_env gl, sig_it gl in
@@ -3941,7 +3955,7 @@ let ssrelim ?(is_case=false) ?ist deps what ?elim eqid ipats gl =
     | X_In_T (e, p) -> sigma, E_As_X_In_T (t, e, p)
     | _ ->
        try unify_HO env sigma t (fst (redex_of_pattern env p)), r
-       with e when Errors.noncritical e -> p in
+       with e when CErrors.noncritical e -> p in
   (* finds the eliminator applies it to evars and c saturated as needed  *)
   (* obtaining "elim ??? (c ???)". pred is the higher order evar         *)
   (* cty is None when the user writes _ (hence we can't make a pattern *)
@@ -3954,7 +3968,7 @@ let ssrelim ?(is_case=false) ?ist deps what ?elim eqid ipats gl =
       let elim, elimty, elim_args, gl =
         pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in
       let pred = List.assoc pred_id elim_args in
-      let elimty = Reductionops.whd_betadeltaiota env (project gl) elimty in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
       let cty, gl =
         if Option.is_empty oc then None, gl
         else
@@ -3992,7 +4006,7 @@ let ssrelim ?(is_case=false) ?ist deps what ?elim eqid ipats gl =
         | 0, Some p -> interp_cpattern (Option.get ist) orig_gl p None 
         | _ -> mkTpat gl c in
       let cty = Some (c, c_ty, pc) in
-      let elimty = Reductionops.whd_betadeltaiota env (project gl) elimty in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
       cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl
   in
   pp(lazy(str"elim= "++ pr_constr_pat elim));
@@ -4007,7 +4021,7 @@ let ssrelim ?(is_case=false) ?ist deps what ?elim eqid ipats gl =
       Some (c, c_ty, gl, gl')
     with
     | NotEnoughProducts -> None
-    | e when Errors.noncritical e -> loop (n+1) in loop 0 in
+    | e when CErrors.noncritical e -> loop (n+1) in loop 0 in
   (* Here we try to understand if the main pattern/term the user gave is
    * the first pattern to be matched (i.e. if elimty ends in P t1 .. tn,
    * weather tn is the t the user wrote in 'elim: t' *)
@@ -4221,7 +4235,7 @@ let _ = simplest_newcase_ref := simplest_newcase
 
 let check_casearg = function
 | view, (_, (([_; gen :: _], _), _)) when view <> [] && has_occ gen ->
-  Errors.error "incompatible view and occurrence switch in dependent case tactic"
+  CErrors.error "incompatible view and occurrence switch in dependent case tactic"
 | arg -> arg
 
 ARGUMENT EXTEND ssrcasearg TYPED AS ssrarg PRINTED BY pr_ssrarg
@@ -4376,7 +4390,7 @@ let refine_interp_apply_view i ist gl gv =
   loop (pair i viewtab.(i) @ if i = 2 then pair 1 viewtab.(1) else [])
 
 let apply_top_tac gl =
-  tclTHENLIST [introid top_id; apply_rconstr (mkRVar top_id); clear [top_id]] gl
+  tclTHENLIST [introid top_id; apply_rconstr (mkRVar top_id); Proofview.V82.of_tactic (clear [top_id])] gl
     
 let inner_ssrapplytac gviews ggenl gclr ist gl =
  let _, clr = interp_hyps ist gl gclr in
@@ -4420,12 +4434,15 @@ ARGUMENT EXTEND ssrexactarg TYPED AS ssrapplyarg PRINTED BY pr_ssraarg
   [ mk_exactarg [] ([], clr) ]
 END
 
-let vmexacttac pf gl = exact_no_check (mkCast (pf, VMcast, pf_concl gl)) gl
+let vmexacttac pf =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  exact_no_check (mkCast (pf, VMcast, Tacmach.New.pf_concl gl))
+  end }
 
 TACTIC EXTEND ssrexact
 | [ "exact" ssrexactarg(arg) ] -> [ Proofview.V82.tactic (tclBY (ssrapplytac ist arg)) ]
 | [ "exact" ] -> [ Proofview.V82.tactic (tclORELSE donetac (tclBY apply_top_tac)) ]
-| [ "exact" "<:" lconstr(pf) ] -> [ Proofview.V82.tactic (vmexacttac pf) ]
+| [ "exact" "<:" lconstr(pf) ] -> [ vmexacttac pf ]
 END
 
 (** The "congr" tactic *)
@@ -4634,11 +4651,11 @@ let mk_rwarg (d, (n, _ as m)) ((clr, occ as docc), rx) (rt, _ as r) =
                      && (clr = None || clr = Some []) then
      anomaly "Improper rewrite clear switch";
    if d = R2L && rt <> RWdef then
-     Errors.error "Right-to-left switch on simplification";
+     CErrors.error "Right-to-left switch on simplification";
    if n <> 1 && rt = RWred Cut then
-     Errors.error "Bad or useless multiplier";
+     CErrors.error "Bad or useless multiplier";
    if occ <> None && rx = None && rt <> RWdef then
-     Errors.error "Missing redex for simplification occurrence"
+     CErrors.error "Missing redex for simplification occurrence"
  end; (d, m), ((docc, rx), r)
 
 let norwmult = L2R, nomult
@@ -4721,7 +4738,7 @@ let unfoldintac occ rdx t (kt,_) gl =
   let body env t c =
     Tacred.unfoldn [OnlyOccurrences [1], get_evalref t] env sigma0 c in
   let easy = occ = None && rdx = None in
-  let red_flags = if easy then Closure.betaiotazeta else Closure.betaiota in
+  let red_flags = if easy then CClosure.betaiotazeta else CClosure.betaiota in
   let beta env = Reductionops.clos_norm_flags red_flags env sigma0 in
   let unfold, conclude = match rdx with
   | Some (_, (In_T _ | In_X_In_T _)) | None ->
@@ -4812,7 +4829,7 @@ exception PRindetermined_rhs of constr
 let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
 (*   pp(lazy(str"sigma@pirrel_rewrite=" ++ pr_evar_map None sigma)); *)
   let env = pf_env gl in
-  let beta = Reductionops.clos_norm_flags Closure.beta env sigma in
+  let beta = Reductionops.clos_norm_flags CClosure.beta env sigma in
   let sigma, p = 
     let sigma = create_evar_defs sigma in
     let sigma = Sigma.Unsafe.of_evar_map sigma in
@@ -4845,7 +4862,7 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
     | App (hd, args) -> 
         let hd_ty = Retyping.get_type_of env sigma hd in
         let names = let rec aux t = function 0 -> [] | n ->
-          let t = Reductionops.whd_betadeltaiota env sigma t in
+          let t = Reductionops.whd_all env sigma t in
           match kind_of_type t with
           | ProdType (name, _, t) -> name :: aux t (n-1)
           | _ -> assert false in aux hd_ty (Array.length args) in
@@ -4880,7 +4897,7 @@ let rwcltac cl rdx dir sr gl =
       let env, sigma, c, c_eq = pf_env gl, fst sr, snd sr, build_coq_eq () in
       let sigma, c_ty = Typing.type_of env sigma c in
         pp(lazy(str"c_ty@rwcltac=" ++ pr_constr c_ty));
-      match kind_of_type (Reductionops.whd_betadeltaiota env sigma c_ty) with
+      match kind_of_type (Reductionops.whd_all env sigma c_ty) with
       | AtomicType(e, a) when is_ind_ref e c_eq ->
           let new_rdx = if dir = L2R then a.(2) else a.(1) in
           pirrel_rewrite cl rdx rdxt new_rdx dir (sigma,c) c_ty, tclIDTAC, gl
@@ -4898,7 +4915,7 @@ let rwcltac cl rdx dir sr gl =
       let cl' = mkNamedProd rule_id (compose_prod dc r3t) (lift 1 cl) in
       let cl'' = mkNamedProd pattern_id rdxt cl' in
       let itacs = [introid pattern_id; introid rule_id] in
-      let cltac = clear [pattern_id; rule_id] in
+      let cltac = Proofview.V82.of_tactic (clear [pattern_id; rule_id]) in
       let rwtacs = [rewritetac dir (mkVar rule_id); cltac] in
       apply_type cl'' [rdx; compose_lam dc r3], tclTHENLIST (itacs @ rwtacs), gl
   in
@@ -4909,7 +4926,7 @@ let rwcltac cl rdx dir sr gl =
       then errorstrm (str "Rewriting impacts evars")
       else errorstrm (str "Dependent type error in rewrite of "
         ++ pf_pr_constr gl (project gl) (mkNamedLambda pattern_id rdxt cl))
-    | Errors.UserError _ as e -> raise e
+    | CErrors.UserError _ as e -> raise e
     | e -> anomaly ("cvtac's exception: " ^ Printexc.to_string e);
   in
   tclTHEN cvtac' rwtac gl
@@ -5185,7 +5202,7 @@ END
 let unfoldtac occ ko t kt gl =
   let cl, c = pf_fill_occ_term gl occ (fst (strip_unfold_term t kt)) in
   let cl' = subst1 (pf_unfoldn [OnlyOccurrences [1], get_evalref c] gl c) cl in
-  let f = if ko = None then Closure.betaiotazeta else Closure.betaiota in
+  let f = if ko = None then CClosure.betaiotazeta else CClosure.betaiota in
   Proofview.V82.of_tactic
     (convert_concl (pf_reduce (Reductionops.clos_norm_flags f) gl cl')) gl
 
@@ -5533,7 +5550,7 @@ let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd
 
 let bvar_locid = function
   | CRef (Ident (loc, id), _) -> loc, id
-  | _ -> Errors.error "Missing identifier after \"(co)fix\""
+  | _ -> CErrors.error "Missing identifier after \"(co)fix\""
 
 
 ARGUMENT EXTEND ssrfixfwd TYPED AS ident * ssrfwd PRINTED BY pr_ssrfixfwd
@@ -5550,7 +5567,7 @@ ARGUMENT EXTEND ssrfixfwd TYPED AS ident * ssrfwd PRINTED BY pr_ssrfixfwd
           (l', Name id') :: _ when Option.equal Id.equal sid (Some id') -> true, (l', id')
           | [l', Name id'] when sid = None -> false, (l', id')
           | _ :: bn -> loop bn
-          | [] -> Errors.error "Bad structural argument" in
+          | [] -> CErrors.error "Bad structural argument" in
         loop (names_of_local_assums lb) in
       let h' = BFrec (has_struct, has_cast) :: binders_fmts bs in
       let fix = CFix (loc, lid, [lid, (Some i, CStructRec), lb, t', c']) in
@@ -5687,7 +5704,7 @@ ARGUMENT EXTEND ssrhavefwdwbinders
     tr, ((((clr, pats), allbinders), simpl), hint) ]
 END
 
-(* Tactic. *)
+(* Pltac. *)
 
 let is_Evar_or_CastedMeta x =
   isEvar_or_Meta x ||
@@ -5730,9 +5747,10 @@ let pf_find_abstract_proof check_lock gl abstract_n =
            strbrk"Did you tamper with it?")
 
 let unfold cl =
-  let module R = Reductionops in let module F = Closure.RedFlags in
+  let module R = Reductionops in let module F = CClosure.RedFlags in
   reduct_in_concl (R.clos_norm_flags (F.mkflags
-    (List.map (fun c -> F.fCONST (fst (destConst c))) cl @ [F.fBETA; F.fIOTA])))
+    (List.map (fun c -> F.fCONST (fst (destConst c))) cl @
+       [F.fBETA; F.fMATCH; F.fFIX; F.fCOFIX])))
 
 let havegentac ist t gl =
   let sigma, c, ucst, _ = pf_abs_ssrterm ist gl t in
@@ -5810,7 +5828,7 @@ let havetac ist
      let sigma, t, uc, n_evars =
        interp gl false (combineCG ct cty (mkCCast loc) mkRCast) in
      if skols <> [] && n_evars <> 0 then
-       Errors.error ("Automatic generalization of unresolved implicit "^
+       CErrors.error ("Automatic generalization of unresolved implicit "^
                      "arguments together with abstract variables is "^
                      "not supported");
      let gl = re_sig (sig_it gl) (Evd.merge_universe_context sigma uc) in
@@ -5998,8 +6016,8 @@ END
 
 let destProd_or_LetIn c =
   match kind_of_term c with
-  | Prod (n,ty,c) -> Rel.Declaration.LocalAssum (n, ty), c
-  | LetIn (n,bo,ty,c) -> Rel.Declaration.LocalDef (n, bo, ty), c
+  | Prod (n,ty,c) -> RelDecl.LocalAssum (n, ty), c
+  | LetIn (n,bo,ty,c) -> RelDecl.LocalDef (n, bo, ty), c
   | _ -> raise DestKO
         
 let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
@@ -6035,14 +6053,14 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
       | Sort _, [] -> Vars.subst_vars s ct
       | LetIn(Name id as n,b,ty,c), _::g -> mkLetIn (n,b,ty,var2rel c g (id::s))
       | Prod(Name id as n,ty,c), _::g -> mkProd (n,ty,var2rel c g (id::s))
-      | _ -> Errors.anomaly(str"SSR: wlog: var2rel: " ++ pr_constr c) in
+      | _ -> CErrors.anomaly(str"SSR: wlog: var2rel: " ++ pr_constr c) in
     let c = var2rel c gens [] in
     let rec pired c = function
       | [] -> c
       | t::ts as args -> match kind_of_term c with
          | Prod(_,_,c) -> pired (subst1 t c) ts
          | LetIn(id,b,ty,c) -> mkLetIn (id,b,ty,pired c args)
-         | _ -> Errors.anomaly(str"SSR: wlog: pired: " ++ pr_constr c) in
+         | _ -> CErrors.anomaly(str"SSR: wlog: pired: " ++ pr_constr c) in
     c, args, pired c args, pf_merge_uc uc gl in
   let tacipat pats = introstac ~ist pats in
   let tacigens = 
@@ -6064,7 +6082,7 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
       | Some (Some id),_ -> Some id, introid id, clear0, pats
       | Some _,_ ->
           let id = mk_anon_id "tmp" gl in
-          Some id, introid id, tclTHEN clear0 (clear [id]), pats in
+          Some id, introid id, tclTHEN clear0 (Proofview.V82.of_tactic (clear [id])), pats in
       let tac_specialize = match id with
       | None -> tclIDTAC
       | Some id ->
@@ -6188,8 +6206,8 @@ END
 (* longer and thus comment out. Such comments are marked with v8.3     *)
 
 GEXTEND Gram
-  GLOBAL: Tactic.hypident;
-  Tactic.hypident: [
+  GLOBAL: Pltac.hypident;
+  Pltac.hypident: [
   [ "("; IDENT "type"; "of"; id = Prim.identref; ")" -> id, InHypTypeOnly
   | "("; IDENT "value"; "of"; id = Prim.identref; ")" -> id, InHypValueOnly
   ] ];
@@ -6206,8 +6224,8 @@ hloc: [
 END
 
 GEXTEND Gram
-  GLOBAL: Tactic.constr_eval;
-  Tactic.constr_eval: [
+  GLOBAL: Pltac.constr_eval;
+  Pltac.constr_eval: [
     [ IDENT "type"; "of"; c = Constr.constr -> Genredexpr.ConstrTypeOf c ]
   ];
 END
@@ -6216,6 +6234,6 @@ END
 (* The user is supposed to Require Import ssreflect or Require ssreflect   *)
 (* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
 (* consequence the extended ssreflect grammar.                             *)
-let () = Lexer.unfreeze frozen_lexer ;;
+let () = CLexer.unfreeze frozen_lexer ;;
 
 (* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/mathcomp/ssreflect/plugin/trunk/ssreflect.mllib b/mathcomp/ssreflect/plugin/trunk/ssreflect_plugin.mlpack
index 006b70f..006b70f 100644
--- a/mathcomp/ssreflect/plugin/trunk/ssreflect.mllib
+++ b/mathcomp/ssreflect/plugin/trunk/ssreflect_plugin.mlpack
diff --git a/mathcomp/ssreflect/plugin/trunk/ssrmatching.ml4 b/mathcomp/ssreflect/plugin/trunk/ssrmatching.ml4
deleted file mode 100644
index cc2643a..0000000
--- a/mathcomp/ssreflect/plugin/trunk/ssrmatching.ml4
+++ /dev/null
@@ -1,1359 +0,0 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
-(* Distributed under the terms of CeCILL-B.                                  *)
-
-(* Defining grammar rules with "xx" in it automatically declares keywords too,
- * we thus save the lexer to restore it at the end of the file *)
-let frozen_lexer = Lexer.freeze () ;;
-
-(*i camlp4use: "pa_extend.cmo" i*)
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
-open Names
-open Pp
-open Pcoq
-open Genarg
-open Constrarg
-open Term
-open Vars
-open Topconstr
-open Libnames
-open Tactics
-open Tacticals
-open Termops
-open Namegen
-open Recordops
-open Tacmach
-open Coqlib
-open Glob_term
-open Util
-open Evd
-open Extend
-open Goptions
-open Tacexpr
-open Proofview.Notations
-open Tacinterp
-open Pretyping
-open Constr
-open Tactic
-open Extraargs
-open Ppconstr
-open Printer
-
-open Globnames
-open Misctypes
-open Decl_kinds
-open Evar_kinds
-open Constrexpr
-open Constrexpr_ops
-open Notation_term
-open Notation_ops
-open Locus
-open Locusops
-
-DECLARE PLUGIN "ssreflect"
-
-type loc = Loc.t
-let dummy_loc = Loc.ghost
-let errorstrm = Errors.errorlabstrm "ssreflect"
-let loc_error loc msg = Errors.user_err_loc (loc, msg, str msg)
-
-(* 0 cost pp function. Active only if env variable SSRDEBUG is set *)
-(* or if SsrDebug is Set                                                  *)
-let pp_ref = ref (fun _ -> ())
-let ssr_pp s = pperrnl (str"SSR: "++Lazy.force s)
-let _ = try ignore(Sys.getenv "SSRDEBUG"); pp_ref := ssr_pp with Not_found -> ()
-let debug b =
-  if b then pp_ref := ssr_pp else pp_ref := fun _ -> ()
-let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = false;
-      Goptions.optname  = "ssrmatching debugging";
-      Goptions.optkey   = ["SsrMatchingDebug"];
-      Goptions.optdepr  = false;
-      Goptions.optread  = (fun _ -> !pp_ref == ssr_pp);
-      Goptions.optwrite = debug }
-let pp s = !pp_ref s
-
-(** Utils {{{ *****************************************************************)
-let env_size env = List.length (Environ.named_context env)
-let safeDestApp c =
-  match kind_of_term c with App (f, a) -> f, a | _ -> c, [| |]
-let get_index = function ArgArg i -> i | _ ->
-  Errors.anomaly (str"Uninterpreted index")
-(* Toplevel constr must be globalized twice ! *)
-let glob_constr ist genv = function
-  | _, Some ce ->
-    let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.lfun Id.Set.empty in
-    let ltacvars = { Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
-    Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv ce
-  | rc, None -> rc
-
-(* Term printing utilities functions for deciding bracketing.  *)
-let pr_paren prx x = hov 1 (str "(" ++ prx x ++ str ")")
-(* String lexing utilities *)
-let skip_wschars s =
-  let rec loop i = match s.[i] with '\n'..' ' -> loop (i + 1) | _ -> i in loop
-(* We also guard characters that might interfere with the ssreflect   *)
-(* tactic syntax.                                                     *)
-let guard_term ch1 s i = match s.[i] with
-  | '(' -> false
-  | '{' | '/' | '=' -> true
-  | _ -> ch1 = '('
-(* The call 'guard s i' should return true if the contents of s *)
-(* starting at i need bracketing to avoid ambiguities.          *)
-let pr_guarded guard prc c =
-  msg_with Format.str_formatter (prc c);
-  let s = Format.flush_str_formatter () ^ "$" in
-  if guard s (skip_wschars s 0) then pr_paren prc c else prc c
-(* More sensible names for constr printers *)
-let pr_constr = pr_constr
-let prl_glob_constr c = pr_lglob_constr_env (Global.env ()) c
-let pr_glob_constr c = pr_glob_constr_env (Global.env ()) c
-let prl_constr_expr = pr_lconstr_expr
-let pr_constr_expr = pr_constr_expr
-let prl_glob_constr_and_expr = function
-  | _, Some c -> prl_constr_expr c
-  | c, None -> prl_glob_constr c
-let pr_glob_constr_and_expr = function
-  | _, Some c -> pr_constr_expr c
-  | c, None -> pr_glob_constr c
-let pr_term (k, c) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
-let prl_term (k, c) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
-
-(** Adding a new uninterpreted generic argument type *)
-let add_genarg tag pr =
-  let wit = Genarg.make0 tag in
-  let glob ist x = (ist, x) in
-  let subst _ x = x in
-  let interp ist x = Ftactic.return x in
-  let gen_pr _ _ _ = pr in
-  let () = Genintern.register_intern0 wit glob in
-  let () = Genintern.register_subst0 wit subst in
-  let () = Geninterp.register_interp0 wit interp in
-  Pptactic.declare_extra_genarg_pprule wit gen_pr gen_pr gen_pr;
-  wit
-
-(** Constructors for cast type *)
-let dC t = CastConv t
-(** Constructors for constr_expr *)
-let isCVar = function CRef (Ident _, _) -> true | _ -> false
-let destCVar = function CRef (Ident (_, id), _) -> id | _ ->
-  Errors.anomaly (str"not a CRef")
-let mkCHole loc = CHole (loc, None, IntroAnonymous, None)
-let mkCLambda loc name ty t = 
-   CLambdaN (loc, [[loc, name], Default Explicit, ty], t)
-let mkCLetIn loc name bo t = 
-   CLetIn (loc, (loc, name), bo, t)
-let mkCCast loc t ty = CCast (loc,t, dC ty)
-(** Constructors for rawconstr *)
-let mkRHole = GHole (dummy_loc, InternalHole, IntroAnonymous, None)
-let mkRApp f args = if args = [] then f else GApp (dummy_loc, f, args)
-let mkRCast rc rt =  GCast (dummy_loc, rc, dC rt)
-let mkRLambda n s t = GLambda (dummy_loc, n, Explicit, s, t)
-
-(* ssrterm conbinators *)
-let combineCG t1 t2 f g = match t1, t2 with
- | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
- | (x, (_, Some t1)), (_, (_, Some t2)) -> x, (mkRHole, Some (f t1 t2))
- | _, (_, (_, None)) -> Errors.anomaly (str"have: mixed C-G constr")
- | _ -> Errors.anomaly (str"have: mixed G-C constr")
-let loc_ofCG = function
- | (_, (s, None)) -> Glob_ops.loc_of_glob_constr s
- | (_, (_, Some s)) -> Constrexpr_ops.constr_loc s
-
-let mk_term k c = k, (mkRHole, Some c)
-let mk_lterm = mk_term ' '
-
-let pf_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl)  sigma, ty
-
-(* }}} *)
-
-(** Profiling {{{ *************************************************************)
-type profiler = { 
-  profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
-  reset : unit -> unit;
-  print : unit -> unit }
-let profile_now = ref false
-let something_profiled = ref false
-let profilers = ref []
-let add_profiler f = profilers := f :: !profilers;;
-let profile b =
-  profile_now := b;
-  if b then List.iter (fun f -> f.reset ()) !profilers;
-  if not b then List.iter (fun f -> f.print ()) !profilers
-;;
-let _ =
-  Goptions.declare_bool_option
-    { Goptions.optsync  = false;
-      Goptions.optname  = "ssrmatching profiling";
-      Goptions.optkey   = ["SsrMatchingProfiling"];
-      Goptions.optread  = (fun _ -> !profile_now);
-      Goptions.optdepr  = false;
-      Goptions.optwrite = profile }
-let () =
-  let prof_total = 
-    let init = ref 0.0 in { 
-    profile = (fun f x -> assert false);
-    reset = (fun () -> init := Unix.gettimeofday ());
-    print = (fun () -> if !something_profiled then
-        prerr_endline 
-           (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f"
-           "total" 0 (Unix.gettimeofday() -. !init) 0.0 0.0)) } in
-  let prof_legenda = {
-    profile = (fun f x -> assert false);
-    reset = (fun () -> ());
-    print = (fun () -> if !something_profiled then begin
-        prerr_endline 
-           (Printf.sprintf "!! %39s ---------- --------- --------- ---------" 
-           (String.make 39 '-'));
-        prerr_endline 
-           (Printf.sprintf "!! %-39s %10s %9s %9s %9s" 
-           "function" "#calls" "total" "max" "average") end) } in
-  add_profiler prof_legenda;
-  add_profiler prof_total
-;;
-
-let mk_profiler s =
-  let total, calls, max = ref 0.0, ref 0, ref 0.0 in
-  let reset () = total := 0.0; calls := 0; max := 0.0 in
-  let profile f x =
-    if not !profile_now then f x else
-    let before = Unix.gettimeofday () in
-    try
-      incr calls;
-      let res = f x in
-      let after = Unix.gettimeofday () in
-      let delta = after -. before in
-      total := !total +. delta;
-      if delta > !max then max := delta;
-      res
-    with exc ->
-      let after = Unix.gettimeofday () in
-      let delta = after -. before in
-      total := !total +. delta;
-      if delta > !max then max := delta;
-      raise exc in
-  let print () =
-     if !calls <> 0 then begin
-       something_profiled := true;
-       prerr_endline
-         (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" 
-         s !calls !total !max (!total /. (float_of_int !calls))) end in
-  let prof = { profile = profile; reset = reset; print = print } in
-  add_profiler prof;
-  prof
-;;
-(* }}} *)
-
-exception NoProgress
-
-(** Unification procedures.                                *)
-
-(* To enforce the rigidity of the rooted match we always split  *)
-(* top applications, so the unification procedures operate on   *)
-(* arrays of patterns and terms.                                *)
-(* We perform three kinds of unification:                       *)
-(*  EQ: exact conversion check                                  *)
-(*  FO: first-order unification of evars, without conversion    *)
-(*  HO: higher-order unification with conversion                *)
-(* The subterm unification strategy is to find the first FO     *)
-(* match, if possible, and the first HO match otherwise, then   *)
-(* compute all the occurrences that are EQ matches for the      *)
-(* relevant subterm.                                            *)
-(*   Additional twists:                                         *)
-(*    - If FO/HO fails then we attempt to fill evars using      *)
-(*      typeclasses before raising an outright error. We also   *)
-(*      fill typeclasses even after a successful match, since   *)
-(*      beta-reduction and canonical instances may leave        *)
-(*      undefined evars.                                        *)
-(*    - We do postchecks to rule out matches that are not       *)
-(*      closed or that assign to a global evar; these can be    *)
-(*      disabled for rewrite or dependent family matches.       *)
-(*    - We do a full FO scan before turning to HO, as the FO    *)
-(*      comparison can be much faster than the HO one.          *)
-
-let unif_EQ env sigma p c =
-  let evars = existential_opt_value sigma, Evd.universes sigma in 
-  try let _ = Reduction.conv env p ~evars c in true with _ -> false
-
-let unif_EQ_args env sigma pa a =
-  let n = Array.length pa in
-  let rec loop i = (i = n) || unif_EQ env sigma pa.(i) a.(i) && loop (i + 1) in
-  loop 0
-
-let prof_unif_eq_args = mk_profiler "unif_EQ_args";;
-let unif_EQ_args env sigma pa a =
-  prof_unif_eq_args.profile (unif_EQ_args env sigma pa) a 
-;;
-
-let unif_HO env ise p c = Evarconv.the_conv_x env p c ise
-
-let unif_HOtype env ise p c = Evarconv.the_conv_x_leq env p c ise
-
-let unif_HO_args env ise0 pa i ca =
-  let n = Array.length pa in
-  let rec loop ise j =
-    if j = n then ise else loop (unif_HO env ise pa.(j) ca.(i + j)) (j + 1) in
-  loop ise0 0
-
-(* FO unification should boil down to calling w_unify with no_delta, but  *)
-(* alas things are not so simple: w_unify does partial type-checking,     *)
-(* which breaks down when the no-delta flag is on (as the Coq type system *)
-(* requires full convertibility. The workaround here is to convert all    *)
-(* evars into metas, since 8.2 does not TC metas. This means some lossage *)
-(* for HO evars, though hopefully Miller patterns can pick up some of     *)
-(* those cases, and HO matching will mop up the rest.                     *)
-let flags_FO =
-  let flags =
-    { (Unification.default_no_delta_unify_flags ()).Unification.core_unify_flags
-      with
-        Unification.modulo_conv_on_closed_terms = None;
-        Unification.modulo_eta = true;
-        Unification.modulo_betaiota = true;
-        Unification.modulo_delta_types = full_transparent_state}
-  in
-  { Unification.core_unify_flags = flags;
-    Unification.merge_unify_flags = flags;
-    Unification.subterm_unify_flags = flags;
-    Unification.allow_K_in_toplevel_higher_order_unification = false;
-    Unification.resolve_evars =
-      (Unification.default_no_delta_unify_flags ()).Unification.resolve_evars
-  }
-let unif_FO env ise p c =
-  Unification.w_unify env ise Reduction.CONV ~flags:flags_FO p c
-
-(* Perform evar substitution in main term and prune substitution. *)
-let nf_open_term sigma0 ise c =
-  let s = ise and s' = ref sigma0 in
-  let rec nf c' = match kind_of_term c' with
-  | Evar ex ->
-    begin try nf (existential_value s ex) with _ ->
-    let k, a = ex in let a' = Array.map nf a in
-    if not (Evd.mem !s' k) then
-      s' := Evd.add !s' k (Evarutil.nf_evar_info s (Evd.find s k));
-    mkEvar (k, a')
-    end
-  | _ -> map_constr nf c' in
-  let copy_def k evi () =
-    if evar_body evi != Evd.Evar_empty then () else
-    match Evd.evar_body (Evd.find s k) with
-    | Evar_defined c' -> s' := Evd.define k (nf c') !s'
-    | _ -> () in
-  let c' = nf c in let _ = Evd.fold copy_def sigma0 () in
-  !s', Evd.evar_universe_context s, c'
-
-let unif_end env sigma0 ise0 pt ok =
-  let ise = Evarconv.consider_remaining_unif_problems env ise0 in
-  let s, uc, t = nf_open_term sigma0 ise pt in
-  let ise1 = create_evar_defs s in
-  let ise1 = Evd.set_universe_context ise1 uc in
-  let ise2 = Typeclasses.resolve_typeclasses ~fail:true env ise1 in
-  if not (ok ise) then raise NoProgress else
-  if ise2 == ise1 then (s, uc, t)
-  else
-    let s, uc', t = nf_open_term sigma0 ise2 t in
-    s, Evd.union_evar_universe_context uc uc', t
-
-let pf_unif_HO gl sigma pt p c =
-  let env = pf_env gl in
-  let ise = unif_HO env (create_evar_defs sigma) p c in
-  unif_end env (project gl) ise pt (fun _ -> true)
-
-let unify_HO env sigma0 t1 t2 =
-  let sigma = unif_HO env sigma0 t1 t2 in
-  let sigma, uc, _ = unif_end env sigma0 sigma t2 (fun _ -> true) in
-  Evd.set_universe_context sigma uc
-
-let pf_unify_HO gl t1 t2 =
-  let env, sigma0, si = pf_env gl, project gl, sig_it gl in
-  let sigma = unify_HO env sigma0 t1 t2 in
-  re_sig si sigma
-
-(* This is what the definition of iter_constr should be... *)
-let iter_constr_LR f c = match kind_of_term c with
-  | Evar (k, a) -> Array.iter f a
-  | Cast (cc, _, t) -> f cc; f t  
-  | Prod (_, t, b) | Lambda (_, t, b)  -> f t; f b
-  | LetIn (_, v, t, b) -> f v; f t; f b
-  | App (cf, a) -> f cf; Array.iter f a
-  | Case (_, p, v, b) -> f v; f p; Array.iter f b
-  | Fix (_, (_, t, b)) | CoFix (_, (_, t, b)) ->
-    for i = 0 to Array.length t - 1 do f t.(i); f b.(i) done
-  | _ -> ()
-
-(* The comparison used to determine which subterms matches is KEYED        *)
-(* CONVERSION. This looks for convertible terms that either have the same  *)
-(* same head constant as pat if pat is an application (after beta-iota),   *)
-(* or start with the same constr constructor (esp. for LetIn); this is     *)
-(* disregarded if the head term is let x := ... in x, and casts are always *)
-(* ignored and removed).                                                   *)
-(* Record projections get special treatment: in addition to the projection *)
-(* constant itself, ssreflect also recognizes head constants of canonical  *)
-(* projections.                                                            *)
-
-exception NoMatch
-type ssrdir = L2R | R2L
-let pr_dir_side = function L2R -> str "LHS" | R2L -> str "RHS"
-let inv_dir = function L2R -> R2L | R2L -> L2R
-
-
-type pattern_class =
-  | KpatFixed
-  | KpatConst
-  | KpatEvar of existential_key
-  | KpatLet
-  | KpatLam
-  | KpatRigid
-  | KpatFlex
-  | KpatProj of constant
-
-type tpattern = {
-  up_k : pattern_class;
-  up_FO : constr;
-  up_f : constr;
-  up_a : constr array;
-  up_t : constr;                      (* equation proof term or matched term *)
-  up_dir : ssrdir;                    (* direction of the rule *)
-  up_ok : constr -> evar_map -> bool; (* progess test for rewrite *)
-  }
-
-let all_ok _ _ = true
-
-let proj_nparams c =
-  try 1 + Recordops.find_projection_nparams (ConstRef c) with _ -> 0
-
-let isFixed c = match kind_of_term c with
-  | Var _ | Ind _ | Construct _ | Const _ -> true
-  | _ -> false
-
-let isRigid c = match kind_of_term c with
-  | Prod _ | Sort _ | Lambda _ | Case _ | Fix _ | CoFix _ -> true
-  | _ -> false
-
-exception UndefPat
-
-let hole_var = mkVar (id_of_string "_")
-let pr_constr_pat c0 =
-  let rec wipe_evar c =
-    if isEvar c then hole_var else map_constr wipe_evar c in
-  pr_constr (wipe_evar c0)
-
-(* Turn (new) evars into metas *)
-let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
-  let ise = ref ise0 in
-  let sigma = ref ise0 in
-  let nenv = env_size env + if hack then 1 else 0 in
-  let rec put c = match kind_of_term c with
-  | Evar (k, a as ex) ->
-    begin try put (existential_value !sigma ex)
-    with NotInstantiatedEvar ->
-    if Evd.mem sigma0 k then map_constr put c else
-    let evi = Evd.find !sigma k in
-    let dc = List.firstn (max 0 (Array.length a - nenv)) (evar_filtered_context evi) in
-    let abs_dc (d, c) = function
-    | Context.Named.Declaration.LocalDef (x, b, t) ->
-        d, mkNamedLetIn x (put b) (put t) c
-    | Context.Named.Declaration.LocalAssum (x, t) ->
-        mkVar x :: d, mkNamedProd x (put t) c in
-    let a, t =
-      Context.Named.fold_inside abs_dc ~init:([], (put evi.evar_concl)) dc in
-    let m = Evarutil.new_meta () in
-    ise := meta_declare m t !ise;
-    sigma := Evd.define k (applist (mkMeta m, a)) !sigma;
-    put (existential_value !sigma ex)
-    end
-  | _ -> map_constr put c in
-  let c1 = put c0 in !ise, c1
-
-(* Compile a match pattern from a term; t is the term to fill. *)
-(* p_origin can be passed to obtain a better error message     *)
-let mk_tpattern ?p_origin ?(hack=false) env sigma0 (ise, t) ok dir p =
-  let k, f, a =
-    let f, a = Reductionops.whd_betaiota_stack ise p in
-    match kind_of_term f with
-    | Const (p,_) ->
-      let np = proj_nparams p in
-      if np = 0 || np > List.length a then KpatConst, f, a else
-      let a1, a2 = List.chop np a in KpatProj p, applist(f, a1), a2
-    | Var _ | Ind _ | Construct _ -> KpatFixed, f, a
-    | Evar (k, _) ->
-      if Evd.mem sigma0 k then KpatEvar k, f, a else
-      if a <> [] then KpatFlex, f, a else 
-      (match p_origin with None -> Errors.error "indeterminate pattern"
-      | Some (dir, rule) ->
-	errorstrm (str "indeterminate " ++ pr_dir_side dir
-          ++ str " in " ++ pr_constr_pat rule))
-    | LetIn (_, v, _, b) ->
-      if b <> mkRel 1 then KpatLet, f, a else KpatFlex, v, a
-    | Lambda _ -> KpatLam, f, a
-    | _ -> KpatRigid, f, a in
-  let aa = Array.of_list a in
-  let ise', p' = evars_for_FO ~hack env sigma0 ise (mkApp (f, aa)) in
-  ise',
-  { up_k = k; up_FO = p'; up_f = f; 
-    up_a = aa; up_ok = ok; up_dir = dir; up_t = t}
-
-(* Specialize a pattern after a successful match: assign a precise head *)
-(* kind and arity for Proj and Flex patterns.                           *)
-let ungen_upat lhs (sigma, uc, t) u =
-  let f, a = safeDestApp lhs in
-  let k = match kind_of_term f with
-  | Var _ | Ind _ | Construct _ -> KpatFixed
-  | Const _ -> KpatConst
-  | Evar (k, _) -> if is_defined sigma k then raise NoMatch else KpatEvar k
-  | LetIn _ -> KpatLet
-  | Lambda _ -> KpatLam
-  | _ -> KpatRigid in
-  sigma, uc, {u with up_k = k; up_FO = lhs; up_f = f; up_a = a; up_t = t}
-
-let nb_cs_proj_args pc f u =
-  let na k =
-    List.length (snd (lookup_canonical_conversion (ConstRef pc, k))).o_TCOMPS in
-  try match kind_of_term f with
-  | Prod _ -> na Prod_cs
-  | Sort s -> na (Sort_cs (family_of_sort s))
-  | Const (c',_) when Constant.equal c' pc -> Array.length (snd (destApp u.up_f))
-  | Var _ | Ind _ | Construct _ | Const _ -> na (Const_cs (global_of_constr f))
-  | _ -> -1
-  with Not_found -> -1
-
-let isEvar_k k f =
-  match kind_of_term f with Evar (k', _) -> k = k' | _ -> false
-
-let nb_args c =
-  match kind_of_term c with App (_, a) -> Array.length a | _ -> 0
-
-let mkSubArg i a = if i = Array.length a then a else Array.sub a 0 i
-let mkSubApp f i a = if i = 0 then f else mkApp (f, mkSubArg i a)
-
-let splay_app ise =
-  let rec loop c a = match kind_of_term c with
-  | App (f, a') -> loop f (Array.append a' a)
-  | Cast (c', _, _) -> loop c' a
-  | Evar ex ->
-    (try loop (existential_value ise ex) a with _ -> c, a)
-  | _ -> c, a in
-  fun c -> match kind_of_term c with
-  | App (f, a) -> loop f a
-  | Cast _ | Evar _ -> loop c [| |]
-  | _ -> c, [| |]
-
-let filter_upat i0 f n u fpats =
-  let na = Array.length u.up_a in
-  if n < na then fpats else
-  let np = match u.up_k with
-  | KpatConst when Term.eq_constr u.up_f f -> na
-  | KpatFixed when Term.eq_constr u.up_f f -> na 
-  | KpatEvar k when isEvar_k k f -> na
-  | KpatLet when isLetIn f -> na
-  | KpatLam when isLambda f -> na
-  | KpatRigid when isRigid f -> na
-  | KpatFlex -> na
-  | KpatProj pc ->
-    let np = na + nb_cs_proj_args pc f u in if n < np then -1 else np
-  | _ -> -1 in
-  if np < na then fpats else
-  let () = if !i0 < np then i0 := n in (u, np) :: fpats
-
-let filter_upat_FO i0 f n u fpats =
-  let np = nb_args u.up_FO in
-  if n < np then fpats else
-  let ok = match u.up_k with
-  | KpatConst -> Term.eq_constr u.up_f f 
-  | KpatFixed -> Term.eq_constr u.up_f f 
-  | KpatEvar k -> isEvar_k k f
-  | KpatLet -> isLetIn f
-  | KpatLam -> isLambda f
-  | KpatRigid -> isRigid f
-  | KpatProj pc -> Term.eq_constr f (mkConst pc)
-  | KpatFlex -> i0 := n; true in
-  if ok then begin if !i0 < np then i0 := np; (u, np) :: fpats end else fpats
-
-exception FoundUnif of (evar_map * evar_universe_context * tpattern)
-(* Note: we don't update env as we descend into the term, as the primitive *)
-(* unification procedure always rejects subterms with bound variables.     *)
-
-let dont_impact_evars_in cl =
-  let evs_in_cl = Evd.evars_of_term cl in
-  fun sigma -> Evar.Set.for_all (fun k ->
-    try let _ = Evd.find_undefined sigma k in true
-    with Not_found -> false) evs_in_cl
-
-(* We are forced to duplicate code between the FO/HO matching because we    *)
-(* have to work around several kludges in unify.ml:                         *)
-(*  - w_unify drops into second-order unification when the pattern is an    *)
-(*    application whose head is a meta.                                     *)
-(*  - w_unify tries to unify types without subsumption when the pattern     *)
-(*    head is an evar or meta (e.g., it fails on ?1 = nat when ?1 : Type).  *)
-(*  - w_unify expands let-in (zeta conversion) eagerly, whereas we want to  *)
-(*    match a head let rigidly.                                             *)
-let match_upats_FO upats env sigma0 ise orig_c =
-  let dont_impact_evars = dont_impact_evars_in orig_c in
-  let rec loop c =
-    let f, a = splay_app ise c in let i0 = ref (-1) in
-    let fpats =
-      List.fold_right (filter_upat_FO i0 f (Array.length a)) upats [] in
-    while !i0 >= 0 do
-      let i = !i0 in i0 := -1;
-      let c' = mkSubApp f i a in
-      let one_match (u, np) =
-         let skip =
-           if i <= np then i < np else
-           if u.up_k == KpatFlex then begin i0 := i - 1; false end else
-           begin if !i0 < np then i0 := np; true end in
-         if skip || not (closed0 c') then () else try
-           let _ = match u.up_k with
-           | KpatFlex ->
-             let kludge v = mkLambda (Anonymous, mkProp, v) in
-             unif_FO env ise (kludge u.up_FO) (kludge c')
-           | KpatLet ->
-             let kludge vla =
-               let vl, a = safeDestApp vla in
-               let x, v, t, b = destLetIn vl in
-               mkApp (mkLambda (x, t, b), Array.cons v a) in
-             unif_FO env ise (kludge u.up_FO) (kludge c')
-           | _ -> unif_FO env ise u.up_FO c' in
-           let ise' = (* Unify again using HO to assign evars *)
-             let p = mkApp (u.up_f, u.up_a) in
-             try unif_HO env ise p c' with _ -> raise NoMatch in
-           let lhs = mkSubApp f i a in
-           let pt' = unif_end env sigma0 ise' u.up_t (u.up_ok lhs) in
-           raise (FoundUnif (ungen_upat lhs pt' u))
-       with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
-       | Not_found -> Errors.anomaly (str"incomplete ise in match_upats_FO")
-       | _ -> () in
-    List.iter one_match fpats
-  done;
-  iter_constr_LR loop f; Array.iter loop a in
-  try loop orig_c with Invalid_argument _ -> Errors.anomaly (str"IN FO")
-
-let prof_FO = mk_profiler "match_upats_FO";;
-let match_upats_FO upats env sigma0 ise c =
-  prof_FO.profile (match_upats_FO upats env sigma0) ise c
-;;
-
-
-let match_upats_HO ~on_instance upats env sigma0 ise c =
-  let dont_impact_evars = dont_impact_evars_in c in
- let it_did_match = ref false in
- let failed_because_of_TC = ref false in
- let rec aux upats env sigma0 ise c =
-  let f, a = splay_app ise c in let i0 = ref (-1) in
-  let fpats = List.fold_right (filter_upat i0 f (Array.length a)) upats [] in
-  while !i0 >= 0 do
-    let i = !i0 in i0 := -1;
-    let one_match (u, np) =
-      let skip =
-        if i <= np then i < np else
-        if u.up_k == KpatFlex then begin i0 := i - 1; false end else
-        begin if !i0 < np then i0 := np; true end in
-      if skip then () else try
-        let ise' = match u.up_k with
-        | KpatFixed | KpatConst -> ise
-        | KpatEvar _ ->
-          let _, pka = destEvar u.up_f and _, ka = destEvar f in
-          unif_HO_args env ise pka 0 ka
-        | KpatLet ->
-          let x, v, t, b = destLetIn f in
-          let _, pv, _, pb = destLetIn u.up_f in
-          let ise' = unif_HO env ise pv v in
-          unif_HO
-            (Environ.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env)
-            ise' pb b
-        | KpatFlex | KpatProj _ ->
-          unif_HO env ise u.up_f (mkSubApp f (i - Array.length u.up_a) a)
-        | _ -> unif_HO env ise u.up_f f in
-        let ise'' = unif_HO_args env ise' u.up_a (i - Array.length u.up_a) a in
-        let lhs = mkSubApp f i a in
-        let pt' = unif_end env sigma0 ise'' u.up_t (u.up_ok lhs) in
-        on_instance (ungen_upat lhs pt' u)
-      with FoundUnif (s,_,_) as sig_u when dont_impact_evars s -> raise sig_u
-      | NoProgress -> it_did_match := true
-      | Pretype_errors.PretypeError
-         (_,_,Pretype_errors.UnsatisfiableConstraints _) ->
-          failed_because_of_TC:=true
-      | e when Errors.noncritical e -> () in
-    List.iter one_match fpats
-  done;
-  iter_constr_LR (aux upats env sigma0 ise) f;
-  Array.iter (aux upats env sigma0 ise) a
- in
- aux upats env sigma0 ise c;
- if !it_did_match then raise NoProgress;
- !failed_because_of_TC
-
-let prof_HO = mk_profiler "match_upats_HO";;
-let match_upats_HO ~on_instance upats env sigma0 ise c =
-  prof_HO.profile (match_upats_HO ~on_instance upats env sigma0) ise c
-;;
-
-
-let fixed_upat = function
-| {up_k = KpatFlex | KpatEvar _ | KpatProj _} -> false 
-| {up_t = t} -> not (occur_existential t)
-
-let do_once r f = match !r with Some _ -> () | None -> r := Some (f ())
-
-let assert_done r = 
-  match !r with Some x -> x | None -> Errors.anomaly (str"do_once never called")
-
-let assert_done_multires r = 
-  match !r with
-  | None -> Errors.anomaly (str"do_once never called")
-  | Some (n, xs) ->
-      r := Some (n+1,xs);
-      try List.nth xs n with Failure _ -> raise NoMatch
-
-type subst = Environ.env -> Term.constr -> Term.constr -> int -> Term.constr
-type find_P = 
-  Environ.env -> Term.constr -> int ->
-  k:subst ->
-     Term.constr
-type conclude = unit ->
-  Term.constr * ssrdir * (Evd.evar_map * Evd.evar_universe_context * Term.constr)
-
-(* upats_origin makes a better error message only            *)
-let mk_tpattern_matcher ?(all_instances=false)
-  ?(raise_NoMatch=false) ?upats_origin sigma0 occ (ise, upats)
-=
-  let nocc = ref 0 and skip_occ = ref false in
-  let use_occ, occ_list = match occ with
-  | Some (true, ol) -> ol = [], ol
-  | Some (false, ol) -> ol <> [], ol
-  | None -> false, [] in
-  let max_occ = List.fold_right max occ_list 0 in
-  let subst_occ =
-    let occ_set = Array.make max_occ (not use_occ) in
-    let _ = List.iter (fun i -> occ_set.(i - 1) <- use_occ) occ_list in
-    let _ = if max_occ = 0 then skip_occ := use_occ in
-    fun () -> incr nocc;
-    if !nocc = max_occ then skip_occ := use_occ;
-    if !nocc <= max_occ then occ_set.(!nocc - 1) else not use_occ in
-  let upat_that_matched = ref None in
-  let match_EQ env sigma u = 
-    match u.up_k with
-    | KpatLet ->
-      let x, pv, t, pb = destLetIn u.up_f in
-      let env' =
-        Environ.push_rel (Context.Rel.Declaration.LocalAssum(x, t)) env in
-      let match_let f = match kind_of_term f with
-      | LetIn (_, v, _, b) -> unif_EQ env sigma pv v && unif_EQ env' sigma pb b
-      | _ -> false in match_let
-    | KpatFixed -> Term.eq_constr u.up_f
-    | KpatConst -> Term.eq_constr u.up_f
-    | KpatLam -> fun c ->
-       (match kind_of_term c with
-       | Lambda _ -> unif_EQ env sigma u.up_f c
-       | _ -> false)
-    | _ -> unif_EQ env sigma u.up_f in
-let p2t p = mkApp(p.up_f,p.up_a) in 
-let source () = match upats_origin, upats with
-  | None, [p] -> 
-      (if fixed_upat p then str"term " else str"partial term ") ++ 
-      pr_constr_pat (p2t p) ++ spc()
-  | Some (dir,rule), [p] -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
-      pr_constr_pat rule ++ fnl() ++ ws 4 ++ pr_constr_pat (p2t p) ++ fnl()
-  | Some (dir,rule), _ -> str"The " ++ pr_dir_side dir ++ str" of " ++ 
-      pr_constr_pat rule ++ spc()
-  | _, [] | None, _::_::_ ->
-      Errors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
-let on_instance, instances =
-  let instances = ref [] in
-  (fun x ->
-    if all_instances then instances := !instances @ [x]
-    else raise (FoundUnif x)),
-  (fun () -> !instances) in
-let rec uniquize = function
-  | [] -> []
-  | (sigma,_,{ up_f = f; up_a = a; up_t = t } as x) :: xs ->
-    let t = Reductionops.nf_evar sigma t in
-    let f = Reductionops.nf_evar sigma f in
-    let a = Array.map (Reductionops.nf_evar sigma) a in
-    let neq (sigma1,_,{ up_f = f1; up_a = a1; up_t = t1 }) =
-      let t1 = Reductionops.nf_evar sigma1 t1 in
-      let f1 = Reductionops.nf_evar sigma1 f1 in
-      let a1 = Array.map (Reductionops.nf_evar sigma1) a1 in
-      not (Term.eq_constr t t1 &&
-           Term.eq_constr f f1 && CArray.for_all2 Term.eq_constr a a1) in
-    x :: uniquize (List.filter neq xs) in
-
-((fun env c h ~k -> 
-  do_once upat_that_matched (fun () -> 
-    let failed_because_of_TC = ref false in
-    try
-      if not all_instances then match_upats_FO upats env sigma0 ise c;
-      failed_because_of_TC:=match_upats_HO ~on_instance upats env sigma0 ise c;
-      raise NoMatch
-    with FoundUnif sigma_u -> 0,[sigma_u]
-    | (NoMatch|NoProgress) when all_instances && instances () <> [] ->
-      0, uniquize (instances ())
-    | NoMatch when (not raise_NoMatch) ->
-      if !failed_because_of_TC then
-        errorstrm (source ()++strbrk"matches but type classes inference fails")
-      else
-        errorstrm (source () ++ str "does not match any subterm of the goal")
-    | NoProgress when (not raise_NoMatch) ->
-        let dir = match upats_origin with Some (d,_) -> d | _ ->
-          Errors.anomaly (str"mk_tpattern_matcher with no upats_origin") in
-        errorstrm (str"all matches of "++source()++
-          str"are equal to the " ++ pr_dir_side (inv_dir dir))
-    | NoProgress -> raise NoMatch);
-  let sigma, _, ({up_f = pf; up_a = pa} as u) =
-    if all_instances then assert_done_multires upat_that_matched
-    else List.hd (snd(assert_done upat_that_matched)) in
-(*   pp(lazy(str"sigma@tmatch=" ++ pr_evar_map None sigma)); *)
-  if !skip_occ then ((*ignore(k env u.up_t 0);*) c) else
-  let match_EQ = match_EQ env sigma u in
-  let pn = Array.length pa in
-  let rec subst_loop (env,h as acc) c' =
-    if !skip_occ then c' else
-    let f, a = splay_app sigma c' in
-    if Array.length a >= pn && match_EQ f && unif_EQ_args env sigma pa a then
-      let a1, a2 = Array.chop (Array.length pa) a in
-      let fa1 = mkApp (f, a1) in
-      let f' = if subst_occ () then k env u.up_t fa1 h else fa1 in
-      mkApp (f', Array.map_left (subst_loop acc) a2)
-    else
-      (* TASSI: clear letin values to avoid unfolding *)
-      let inc_h rd (env,h') =
-        let ctx_item =
-          match rd with
-          | Context.Rel.Declaration.LocalAssum _ as x -> x
-          | Context.Rel.Declaration.LocalDef (x,_,y) ->
-              Context.Rel.Declaration.LocalAssum(x,y) in
-        Environ.push_rel ctx_item env, h' + 1 in
-      let f' = map_constr_with_binders_left_to_right inc_h subst_loop acc f in
-      mkApp (f', Array.map_left (subst_loop acc) a) in
-  subst_loop (env,h) c) : find_P),
-((fun () ->
-  let sigma, uc, ({up_f = pf; up_a = pa} as u) =
-    match !upat_that_matched with
-    | Some (_,x) -> List.hd x | None when raise_NoMatch -> raise NoMatch
-    | None -> Errors.anomaly (str"companion function never called") in
-  let p' = mkApp (pf, pa) in
-  if max_occ <= !nocc then p', u.up_dir, (sigma, uc, u.up_t)
-  else errorstrm (str"Only " ++ int !nocc ++ str" < " ++ int max_occ ++
-        str(String.plural !nocc " occurence") ++ match upats_origin with
-        | None -> str" of" ++ spc() ++ pr_constr_pat p'
-        | Some (dir,rule) -> str" of the " ++ pr_dir_side dir ++ fnl() ++
-            ws 4 ++ pr_constr_pat p' ++ fnl () ++ 
-            str"of " ++ pr_constr_pat rule)) : conclude)
-
-type ('ident, 'term) ssrpattern = 
-  | T of 'term
-  | In_T of 'term
-  | X_In_T of 'ident * 'term     
-  | In_X_In_T of 'ident * 'term     
-  | E_In_X_In_T of 'term * 'ident * 'term     
-  | E_As_X_In_T of 'term * 'ident * 'term     
-        
-let pr_pattern = function
-  | T t -> prl_term t
-  | In_T t -> str "in " ++ prl_term t
-  | X_In_T (x,t) -> prl_term x ++ str " in " ++ prl_term t
-  | In_X_In_T (x,t) -> str "in " ++ prl_term x ++ str " in " ++ prl_term t
-  | E_In_X_In_T (e,x,t) ->
-      prl_term e ++ str " in " ++ prl_term x ++ str " in " ++ prl_term t
-  | E_As_X_In_T (e,x,t) ->
-      prl_term e ++ str " as " ++ prl_term x ++ str " in " ++ prl_term t
-
-let pr_pattern_w_ids = function
-  | T t -> prl_term t
-  | In_T t -> str "in " ++ prl_term t
-  | X_In_T (x,t) -> pr_id x ++ str " in " ++ prl_term t
-  | In_X_In_T (x,t) -> str "in " ++ pr_id x ++ str " in " ++ prl_term t
-  | E_In_X_In_T (e,x,t) ->
-      prl_term e ++ str " in " ++ pr_id x ++ str " in " ++ prl_term t
-  | E_As_X_In_T (e,x,t) ->
-      prl_term e ++ str " as " ++ pr_id x ++ str " in " ++ prl_term t
-
-let pr_pattern_aux pr_constr = function
-  | T t -> pr_constr t
-  | In_T t -> str "in " ++ pr_constr t
-  | X_In_T (x,t) -> pr_constr x ++ str " in " ++ pr_constr t
-  | In_X_In_T (x,t) -> str "in " ++ pr_constr x ++ str " in " ++ pr_constr t
-  | E_In_X_In_T (e,x,t) ->
-      pr_constr e ++ str " in " ++ pr_constr x ++ str " in " ++ pr_constr t
-  | E_As_X_In_T (e,x,t) ->
-      pr_constr e ++ str " as " ++ pr_constr x ++ str " in " ++ pr_constr t
-let pp_pattern (sigma, p) =
-  pr_pattern_aux (fun t -> pr_constr_pat (pi3 (nf_open_term sigma sigma t))) p
-let pr_cpattern = pr_term
-let pr_rpattern _ _ _ = pr_pattern
-
-let pr_option f = function None -> mt() | Some x -> f x
-let pr_ssrpattern _ _ _ = pr_option pr_pattern
-let pr_pattern_squarep = pr_option (fun r -> str "[" ++ pr_pattern r ++ str "]")
-let pr_ssrpattern_squarep _ _ _ = pr_pattern_squarep
-let pr_pattern_roundp = pr_option (fun r -> str "(" ++ pr_pattern r ++ str ")")
-let pr_ssrpattern_roundp  _ _ _ = pr_pattern_roundp
-
-let wit_rpatternty = add_genarg "rpatternty" pr_pattern
-
-ARGUMENT EXTEND rpattern TYPED AS rpatternty PRINTED BY pr_rpattern
-  | [ lconstr(c) ] -> [ T (mk_lterm c) ]
-  | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c) ]
-  | [ lconstr(x) "in" lconstr(c) ] -> 
-    [ X_In_T (mk_lterm x, mk_lterm c) ]
-  | [ "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ In_X_In_T (mk_lterm x, mk_lterm c) ]
-  | [ lconstr(e) "in" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_In_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
-  | [ lconstr(e) "as" lconstr(x) "in" lconstr(c) ] -> 
-    [ E_As_X_In_T (mk_lterm e, mk_lterm x, mk_lterm c) ]
-END
-
-type cpattern = char * glob_constr_and_expr
-let tag_of_cpattern = fst
-let loc_of_cpattern = loc_ofCG
-let cpattern_of_term t = t
-type occ = (bool * int list) option
-
-type rpattern = (cpattern, cpattern) ssrpattern
-let pr_rpattern = pr_pattern
-
-type pattern = Evd.evar_map * (Term.constr, Term.constr) ssrpattern
-
-
-let id_of_cpattern = function
-  | _,(_,Some (CRef (Ident (_, x), _))) -> Some x
-  | _,(_,Some (CAppExpl (_, (_, Ident (_, x), _), []))) -> Some x
-  | _,(GRef (_, VarRef x, _) ,None) -> Some x
-  | _ -> None
-let id_of_Cterm t = match id_of_cpattern t with
-  | Some x -> x
-  | None -> loc_error (loc_of_cpattern t) "Only identifiers are allowed here"
-
-let of_ftactic ftac gl =
-  let r = ref None in
-  let tac = Ftactic.run ftac (fun ans -> r := Some ans; Proofview.tclUNIT ()) in
-  let tac = Proofview.V82.of_tactic tac in
-  let { sigma = sigma } = tac gl in
-  let ans = match !r with
-  | None -> assert false (** If the tactic failed we should not reach this point *)
-  | Some ans -> ans
-  in
-  (sigma, ans)
-
-let interp_wit wit ist gl x = 
-  let globarg = in_gen (glbwit wit) x in
-  let arg = interp_genarg ist globarg in
-  let (sigma, arg) = of_ftactic arg gl in
-  sigma, Value.cast (topwit wit) arg
-let interp_constr = interp_wit wit_constr
-let interp_open_constr ist gl gc =
-  interp_wit wit_open_constr ist gl gc
-let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c
-let interp_term ist gl (_, c) = (interp_open_constr ist gl c)
-let glob_ssrterm gs = function
-  | k, (_, Some c) -> k, Tacintern.intern_constr gs c
-  | ct -> ct
-let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
-let pr_ssrterm _ _ _ = pr_term
-let input_ssrtermkind strm = match Compat.get_tok (stream_nth 0 strm) with
-  | Tok.KEYWORD "(" -> '('
-  | Tok.KEYWORD "@" -> '@'
-  | _ -> ' '
-let ssrtermkind = Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
-
-(* This piece of code asserts the following notations are reserved *)
-(* Reserved Notation "( a 'in' b )"        (at level 0).           *)
-(* Reserved Notation "( a 'as' b )"        (at level 0).           *)
-(* Reserved Notation "( a 'in' b 'in' c )" (at level 0).           *)
-(* Reserved Notation "( a 'as' b 'in' c )" (at level 0).           *)
-let glob_cpattern gs p =
-  pp(lazy(str"globbing pattern: " ++ pr_term p));
-  let glob x = snd (glob_ssrterm gs (mk_lterm x)) in
-  let encode k s l =
-    let name = Name (id_of_string ("_ssrpat_" ^ s)) in
-    k, (mkRCast mkRHole (mkRLambda name mkRHole (mkRApp mkRHole l)), None) in
-  let bind_in t1 t2 =
-    let d = dummy_loc in let n = Name (destCVar t1) in
-    fst (glob (mkCCast d (mkCHole d) (mkCLambda d n (mkCHole d) t2))) in
-  let check_var t2 = if not (isCVar t2) then
-    loc_error (constr_loc t2) "Only identifiers are allowed here" in
-  match p with
-  | _, (_, None) as x -> x
-  | k, (v, Some t) as orig ->
-     if k = 'x' then glob_ssrterm gs ('(', (v, Some t)) else
-     match t with
-     | CNotation(_, "( _ in _ )", ([t1; t2], [], [])) ->
-         (try match glob t1, glob t2 with
-         | (r1, None), (r2, None) -> encode k "In" [r1;r2]
-         | (r1, Some _), (r2, Some _) when isCVar t1 ->
-             encode k "In" [r1; r2; bind_in t1 t2]
-         | (r1, Some _), (r2, Some _) -> encode k "In" [r1; r2]
-         | _ -> Errors.anomaly (str"where are we?")
-         with _ when isCVar t1 -> encode k "In" [bind_in t1 t2])
-     | CNotation(_, "( _ in _ in _ )", ([t1; t2; t3], [], [])) ->
-         check_var t2; encode k "In" [fst (glob t1); bind_in t2 t3]
-     | CNotation(_, "( _ as _ )", ([t1; t2], [], [])) ->
-         encode k "As" [fst (glob t1); fst (glob t2)]
-     | CNotation(_, "( _ as _ in _ )", ([t1; t2; t3], [], [])) ->
-         check_var t2; encode k "As" [fst (glob t1); bind_in t2 t3]
-     | _ -> glob_ssrterm gs orig
-;;
-
-let interp_ssrterm _ gl t = Tacmach.project gl, t
-
-ARGUMENT EXTEND cpattern
-     PRINTED BY pr_ssrterm
-     INTERPRETED BY interp_ssrterm
-     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
-     RAW_TYPED AS cpattern RAW_PRINTED BY pr_ssrterm
-     GLOB_TYPED AS cpattern GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" constr(c) ] -> [ mk_lterm c ]
-END
-
-let (!@) = Compat.to_coqloc
-
-GEXTEND Gram
-  GLOBAL: cpattern;
-  cpattern: [[ k = ssrtermkind; c = constr ->
-    let pattern = mk_term k c in
-    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
-END
-
-ARGUMENT EXTEND lcpattern
-     PRINTED BY pr_ssrterm
-     INTERPRETED BY interp_ssrterm
-     GLOBALIZED BY glob_cpattern SUBSTITUTED BY subst_ssrterm
-     RAW_TYPED AS cpattern RAW_PRINTED BY pr_ssrterm
-     GLOB_TYPED AS cpattern GLOB_PRINTED BY pr_ssrterm
-| [ "Qed" lconstr(c) ] -> [ mk_lterm c ]
-END
-
-GEXTEND Gram
-  GLOBAL: lcpattern;
-  lcpattern: [[ k = ssrtermkind; c = lconstr ->
-    let pattern = mk_term k c in
-    if loc_ofCG pattern <> !@loc && k = '(' then mk_term 'x' c else pattern ]];
-END
-
-let interp_pattern ist gl red redty =
-  pp(lazy(str"interpreting: " ++ pr_pattern red));
-  let xInT x y = X_In_T(x,y) and inXInT x y = In_X_In_T(x,y) in
-  let inT x = In_T x and eInXInT e x t = E_In_X_In_T(e,x,t) in
-  let eAsXInT e x t = E_As_X_In_T(e,x,t) in
-  let mkG ?(k=' ') x = k,(x,None) in
-  let decode t f g =
-    try match (pf_intern_term ist gl t) with
-    | GCast(_,GHole _,CastConv(GLambda(_,Name x,_,_,c))) -> f x (' ',(c,None))
-    | it -> g t with _ -> g t in
-  let decodeG t f g = decode (mkG t) f g in
-  let bad_enc id _ = Errors.anomaly (str"bad encoding for pattern "++str id) in
-  let cleanup_XinE h x rp sigma =
-    let h_k = match kind_of_term h with Evar (k,_) -> k | _ -> assert false in
-    let to_clean, update = (* handle rename if x is already used *)
-      let ctx = pf_hyps gl in
-      let len = Context.Named.length ctx in
-      let name = ref None in
-      try ignore(Context.Named.lookup x ctx); (name, fun k ->
-        if !name = None then
-        let nctx = Evd.evar_context (Evd.find sigma k) in
-        let nlen = Context.Named.length nctx in
-        if nlen > len then begin
-          name := Some (Context.Named.Declaration.get_id (List.nth nctx (nlen - len - 1)))
-        end)
-      with Not_found -> ref (Some x), fun _ -> () in
-    let sigma0 = project gl in
-    let new_evars =
-      let rec aux acc t = match kind_of_term t with
-      | Evar (k,_) ->
-          if k = h_k || List.mem k acc || Evd.mem sigma0 k then acc else
-          (update k; k::acc)
-      | _ -> fold_constr aux acc t in 
-      aux [] (Evarutil.nf_evar sigma rp) in
-    let sigma = 
-      List.fold_left (fun sigma e ->
-        if Evd.is_defined sigma e then sigma else (* clear may be recursive *)
-        if Option.is_empty !to_clean then sigma else
-        let name = Option.get !to_clean in
-        pp(lazy(pr_id name));
-        try snd(Logic.prim_refiner (Proof_type.Thin [name]) sigma e)
-        with Evarutil.ClearDependencyError _ -> sigma)
-      sigma new_evars in
-    sigma in
-  let red = match red with
-    | T(k,(GCast (_,GHole _,(CastConv(GLambda (_,Name id,_,_,t)))),None))
-        when let id = string_of_id id in let len = String.length id in
-        (len > 8 && String.sub id 0 8 = "_ssrpat_") ->
-        let id = string_of_id id in let len = String.length id in
-        (match String.sub id 8 (len - 8), t with
-        | "In", GApp(_, _, [t]) -> decodeG t xInT (fun x -> T x)
-        | "In", GApp(_, _, [e; t]) -> decodeG t (eInXInT (mkG e)) (bad_enc id)
-        | "In", GApp(_, _, [e; t; e_in_t]) ->
-            decodeG t (eInXInT (mkG e))
-              (fun _ -> decodeG e_in_t xInT (fun _ -> assert false))
-        | "As", GApp(_, _, [e; t]) -> decodeG t (eAsXInT (mkG e)) (bad_enc id)
-        | _ -> bad_enc id ())
-    | T t -> decode t xInT (fun x -> T x)
-    | In_T t -> decode t inXInT inT
-    | X_In_T (e,t) -> decode t (eInXInT e) (fun x -> xInT (id_of_Cterm e) x)
-    | In_X_In_T (e,t) -> inXInT (id_of_Cterm e) t
-    | E_In_X_In_T (e,x,rp) -> eInXInT e (id_of_Cterm x) rp
-    | E_As_X_In_T (e,x,rp) -> eAsXInT e (id_of_Cterm x) rp in
-  pp(lazy(str"decoded as: " ++ pr_pattern_w_ids red));
-  let red = match redty with None -> red | Some ty -> let ty = ' ', ty in
-  match red with
-  | T t -> T (combineCG t ty (mkCCast (loc_ofCG t)) mkRCast)
-  | X_In_T (x,t) ->
-      let ty = pf_intern_term ist gl ty in
-      E_As_X_In_T (mkG (mkRCast mkRHole ty), x, t)
-  | E_In_X_In_T (e,x,t) ->
-      let ty = mkG (pf_intern_term ist gl ty) in
-      E_In_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
-  | E_As_X_In_T (e,x,t) ->
-      let ty = mkG (pf_intern_term ist gl ty) in
-      E_As_X_In_T (combineCG e ty (mkCCast (loc_ofCG t)) mkRCast, x, t)
-  | red -> red in
-  pp(lazy(str"typed as: " ++ pr_pattern_w_ids red));
-  let mkXLetIn loc x (a,(g,c)) = match c with
-  | Some b -> a,(g,Some (mkCLetIn loc x (mkCHole loc) b))
-  | None -> a,(GLetIn (loc,x,(GHole (loc, BinderType x, IntroAnonymous, None)), g), None) in
-  match red with
-  | T t -> let sigma, t = interp_term ist gl t in sigma, T t
-  | In_T t -> let sigma, t = interp_term ist gl t in sigma, In_T t
-  | X_In_T (x, rp) | In_X_In_T (x, rp) ->
-    let mk x p = match red with X_In_T _ -> X_In_T(x,p) | _ -> In_X_In_T(x,p) in
-    let rp = mkXLetIn dummy_loc (Name x) rp in
-    let sigma, rp = interp_term ist gl rp in
-    let _, h, _, rp = destLetIn rp in
-    let sigma = cleanup_XinE h x rp sigma in
-    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
-    sigma, mk h rp
-  | E_In_X_In_T(e, x, rp) | E_As_X_In_T (e, x, rp) ->
-    let mk e x p =
-      match red with E_In_X_In_T _ ->E_In_X_In_T(e,x,p)|_->E_As_X_In_T(e,x,p) in
-    let rp = mkXLetIn dummy_loc (Name x) rp in
-    let sigma, rp = interp_term ist gl rp in
-    let _, h, _, rp = destLetIn rp in
-    let sigma = cleanup_XinE h x rp sigma in
-    let rp = subst1 h (Evarutil.nf_evar sigma rp) in
-    let sigma, e = interp_term ist (re_sig (sig_it gl) sigma) e in
-    sigma, mk e h rp
-;;
-let interp_cpattern ist gl red redty = interp_pattern ist gl (T red) redty;;
-let interp_rpattern ist gl red = interp_pattern ist gl red None;;
-
-let id_of_pattern = function
-  | _, T t -> (match kind_of_term t with Var id -> Some id | _ -> None)
-  | _ -> None
-
-(* The full occurrence set *)
-let noindex = Some(false,[])
-
-(* calls do_subst on every sub-term identified by (pattern,occ) *)
-let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
-  let fs sigma x = Reductionops.nf_evar sigma x in
-  let pop_evar sigma e p =
-    let { Evd.evar_body = e_body } as e_def = Evd.find sigma e in
-    let e_body = match e_body with Evar_defined c -> c
-    | _ -> errorstrm (str "Matching the pattern " ++ pr_constr p ++
-          str " did not instantiate ?" ++ int (Evar.repr e) ++ spc () ++
-          str "Does the variable bound by the \"in\" construct occur "++
-          str "in the pattern?") in
-    let sigma = 
-      Evd.add (Evd.remove sigma e) e {e_def with Evd.evar_body = Evar_empty} in
-    sigma, e_body in
-  let ex_value hole =
-    match kind_of_term hole with Evar (e,_) -> e | _ -> assert false in
-  let mk_upat_for ?hack env sigma0 (sigma, t) ?(p=t) ok =
-    let sigma,pat= mk_tpattern ?hack env sigma0 (sigma,p) ok L2R (fs sigma t) in
-    sigma, [pat] in
-  match pattern with
-  | None -> do_subst env0 concl0 concl0 1
-  | Some (sigma, (T rp | In_T rp)) -> 
-    let rp = fs sigma rp in
-    let ise = create_evar_defs sigma in
-    let occ = match pattern with Some (_, T _) -> occ | _ -> noindex in
-    let rp = mk_upat_for env0 sigma0 (ise, rp) all_ok in
-    let find_T, end_T = mk_tpattern_matcher ?raise_NoMatch sigma0 occ rp in
-    let concl = find_T env0 concl0 1 do_subst in
-    let _ = end_T () in
-    concl
-  | Some (sigma, (X_In_T (hole, p) | In_X_In_T (hole, p))) ->
-    let p = fs sigma p in
-    let occ = match pattern with Some (_, X_In_T _) -> occ | _ -> noindex in
-    let ex = ex_value hole in
-    let rp = mk_upat_for ~hack:true env0 sigma0 (sigma, p) all_ok in
-    let find_T, end_T = mk_tpattern_matcher sigma0 noindex rp in
-    (* we start from sigma, so hole is considered a rigid head *)
-    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
-    let find_X, end_X = mk_tpattern_matcher ?raise_NoMatch sigma occ holep in
-    let concl = find_T env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
-      let sigma, e_body = pop_evar p_sigma ex p in
-      fs p_sigma (find_X env (fs sigma p) h 
-        (fun env _ -> do_subst env e_body))) in
-    let _ = end_X () in let _ = end_T () in 
-    concl
-  | Some (sigma, E_In_X_In_T (e, hole, p)) ->
-    let p, e = fs sigma p, fs sigma e in
-    let ex = ex_value hole in
-    let rp = mk_upat_for ~hack:true env0 sigma0 (sigma, p) all_ok in
-    let find_T, end_T = mk_tpattern_matcher sigma0 noindex rp in
-    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
-    let find_X, end_X = mk_tpattern_matcher sigma noindex holep in
-    let re = mk_upat_for env0 sigma0 (sigma, e) all_ok in
-    let find_E, end_E = mk_tpattern_matcher ?raise_NoMatch sigma0 occ re in
-    let concl = find_T env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
-      let sigma, e_body = pop_evar p_sigma ex p in
-      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
-        find_E env e_body h do_subst))) in
-    let _ = end_E () in let _ = end_X () in let _ = end_T () in
-    concl
-  | Some (sigma, E_As_X_In_T (e, hole, p)) ->
-    let p, e = fs sigma p, fs sigma e in
-    let ex = ex_value hole in
-    let rp = 
-      let e_sigma = unify_HO env0 sigma hole e in
-      e_sigma, fs e_sigma p in
-    let rp = mk_upat_for ~hack:true env0 sigma0 rp all_ok in
-    let find_TE, end_TE = mk_tpattern_matcher sigma0 noindex rp in
-    let holep = mk_upat_for env0 sigma (sigma, hole) all_ok in
-    let find_X, end_X = mk_tpattern_matcher sigma occ holep in
-    let concl = find_TE env0 concl0 1 (fun env c _ h ->
-      let p_sigma = unify_HO env (create_evar_defs sigma) c p in
-      let sigma, e_body = pop_evar p_sigma ex p in
-      fs p_sigma (find_X env (fs sigma p) h (fun env c _ h ->
-        let e_sigma = unify_HO env sigma e_body e in
-        let e_body = fs e_sigma e in
-        do_subst env e_body e_body h))) in
-    let _ = end_X () in let _ = end_TE () in
-    concl
-;;
-
-let redex_of_pattern ?(resolve_typeclasses=false) env (sigma, p) =
-  let e = match p with
-  | In_T _ | In_X_In_T _ -> Errors.anomaly (str"pattern without redex")
-  | T e | X_In_T (e, _) | E_As_X_In_T (e, _, _) | E_In_X_In_T (e, _, _) -> e in
-  let sigma =
-    if not resolve_typeclasses then sigma
-    else Typeclasses.resolve_typeclasses ~fail:false env sigma in
-  Reductionops.nf_evar sigma e, Evd.evar_universe_context sigma
-
-let fill_occ_pattern ?raise_NoMatch env sigma cl pat occ h =
-  let do_make_rel, occ =
-    if occ = Some(true,[]) then false, Some(false,[1]) else true, occ in
-  let find_R, conclude =
-    let r = ref None in
-    (fun env c _ h' ->
-       do_once r (fun () -> c, Evd.empty_evar_universe_context);
-       if do_make_rel then mkRel (h'+h-1) else c),
-    (fun _ -> if !r = None then redex_of_pattern env pat else assert_done r) in
-  let cl = eval_pattern ?raise_NoMatch env sigma cl (Some pat) occ find_R in
-  let e = conclude cl in
-  e, cl
-;;
-
-(* clenup interface for external use *)
-let mk_tpattern ?p_origin env sigma0 sigma_t f dir c = 
-  mk_tpattern ?p_origin env sigma0 sigma_t f dir c
-;;
-
-let pf_fill_occ env concl occ sigma0 p (sigma, t) ok h =
- let ise = create_evar_defs sigma in
- let ise, u = mk_tpattern env sigma0 (ise,t) ok L2R p in
- let find_U, end_U =
-   mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[u]) in
- let concl = find_U env concl h (fun _ _ _ -> mkRel) in
- let rdx, _, (sigma, uc, p) = end_U () in
- sigma, uc, p, concl, rdx
-
-let fill_occ_term env cl occ sigma0 (sigma, t) =
-  try
-    let sigma',uc,t',cl,_= pf_fill_occ env cl occ sigma0 t (sigma, t) all_ok 1 in
-    if sigma' != sigma0 then Errors.error "matching impacts evars"
-    else cl, (Evd.merge_universe_context sigma' uc, t')
-  with NoMatch -> try
-    let sigma', uc, t' =
-      unif_end env sigma0 (create_evar_defs sigma) t (fun _ -> true) in
-    if sigma' != sigma0 then raise NoMatch
-    else cl, (Evd.merge_universe_context sigma' uc, t')
-  with _ ->
-    errorstrm (str "partial term " ++ pr_constr_pat t
-            ++ str " does not match any subterm of the goal")
-
-let pf_fill_occ_term gl occ t =
-  let sigma0 = project gl and env = pf_env gl and concl = pf_concl gl in
-  let cl,(_,t) = fill_occ_term env concl occ sigma0 t in
-  cl, t
-
-let cpattern_of_id id = ' ', (GRef (dummy_loc, VarRef  id, None), None)
-
-let is_wildcard = function
-  | _,(_,Some (CHole _)|GHole _,None) -> true
-  | _ -> false
-
-(* "ssrpattern" *)
-let pr_ssrpatternarg _ _ _ cpat = pr_rpattern cpat
-
-ARGUMENT EXTEND ssrpatternarg
-  TYPED AS rpattern
-  PRINTED BY pr_ssrpatternarg
-| [ "[" rpattern(pat) "]" ] -> [ pat ]
-END
-  
-let pf_merge_uc uc gl =
-  re_sig (sig_it gl) (Evd.merge_universe_context (project gl) uc)
-
-let pf_unsafe_merge_uc uc gl =
-  re_sig (sig_it gl) (Evd.set_universe_context (project gl) uc)
-
-let ssrpatterntac ist arg gl =
-  let pat = interp_rpattern ist gl arg in
-  let sigma0 = project gl in
-  let concl0 = pf_concl gl in
-  let (t, uc), concl_x =
-    fill_occ_pattern (Global.env()) sigma0 concl0 pat noindex 1 in
-  let gl, tty = pf_type_of gl t in
-  let concl = mkLetIn (Name (id_of_string "selected"), t, tty, concl_x) in
-  Proofview.V82.of_tactic (convert_concl concl DEFAULTcast) gl
-
-(* Register "ssrpattern" tactic *)
-let () =
-  let mltac _ ist =
-    let arg =
-      let v = Id.Map.find (Names.Id.of_string "ssrpatternarg") ist.lfun in
-      Value.cast (topwit wit_ssrpatternarg) v in
-    Proofview.V82.tactic (ssrpatterntac ist arg) in
-  let name = { mltac_plugin = "ssrmatching"; mltac_tactic = "ssrpattern"; } in
-  let () = Tacenv.register_ml_tactic name [|mltac|] in
-  let tac =
-    TacFun ([Some (Id.of_string "ssrpatternarg")],
-      TacML (Loc.ghost, { mltac_name = name; mltac_index = 0 }, [])) in
-  let obj () =
-    Tacenv.register_ltac true false (Id.of_string "ssrpattern") tac in
-  Mltop.declare_cache_obj obj "ssreflect"
-
-let ssrinstancesof ist arg gl =
-  let ok rhs lhs ise = true in
-(*   not (Term.eq_constr lhs (Evarutil.nf_evar ise rhs)) in *)
-  let env, sigma, concl = pf_env gl, project gl, pf_concl gl in
-  let sigma0, cpat = interp_cpattern ist gl arg None in
-  let pat = match cpat with T x -> x | _ -> errorstrm (str"Not supported") in
-  let etpat, tpat = mk_tpattern env sigma (sigma0,pat) (ok pat) L2R pat in
-  let find, conclude =
-    mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true
-      sigma None (etpat,[tpat]) in
-  let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr c)); c in
-  ppnl (str"BEGIN INSTANCES");
-  try
-    while true do
-      ignore(find env concl 1 ~k:print)
-    done; raise NoMatch
-  with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl
-
-TACTIC EXTEND ssrinstoftpat
-| [ "ssrinstancesoftpat" cpattern(arg) ] -> [ Proofview.V82.tactic (ssrinstancesof ist arg) ]
-END
-
-(* We wipe out all the keywords generated by the grammar rules we defined. *)
-(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
-(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
-(* consequence the extended ssreflect grammar.                             *)
-let () = Lexer.unfreeze frozen_lexer ;;
-
-(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/mathcomp/ssreflect/plugin/trunk/ssrmatching.mli b/mathcomp/ssreflect/plugin/trunk/ssrmatching.mli
deleted file mode 100644
index 74a603e..0000000
--- a/mathcomp/ssreflect/plugin/trunk/ssrmatching.mli
+++ /dev/null
@@ -1,241 +0,0 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
-(* Distributed under the terms of CeCILL-B.                                  *)
-
-open Genarg
-open Tacexpr
-open Environ
-open Tacmach
-open Evd
-open Proof_type
-open Term
-
-(** ******** Small Scale Reflection pattern matching facilities ************* *)
-
-(** Pattern parsing *)
-
-(** The type of context patterns, the patterns of the [set] tactic and 
-    [:] tactical. These are patterns that identify a precise subterm. *)
-type cpattern
-val pr_cpattern : cpattern -> Pp.std_ppcmds
-
-(** CS cpattern: (f _), (X in t), (t in X in t), (t as X in t) *)
-val cpattern         : cpattern Pcoq.Gram.entry
-val wit_cpattern     : cpattern uniform_genarg_type
-
-(** OS cpattern: f _, (X in t), (t in X in t), (t as X in t) *)
-val lcpattern         : cpattern Pcoq.Gram.entry
-val wit_lcpattern     : cpattern uniform_genarg_type
-
-(** The type of rewrite patterns, the patterns of the [rewrite] tactic.
-    These patterns also include patterns that identify all the subterms
-    of a context (i.e. "in" prefix) *)
-type rpattern
-val pr_rpattern : rpattern -> Pp.std_ppcmds
-
-(** OS rpattern: f _, in t, X in t, in X in t, t in X in t, t as X in t *)
-val rpattern         : rpattern Pcoq.Gram.entry
-val wit_rpattern     : rpattern uniform_genarg_type
-
-(** Pattern interpretation and matching *)
-
-exception NoMatch
-exception NoProgress
-
-(** AST for [rpattern] (and consequently [cpattern]) *)
-type ('ident, 'term) ssrpattern =
-  | T of 'term
-  | In_T of 'term
-  | X_In_T of 'ident * 'term
-  | In_X_In_T of 'ident * 'term
-  | E_In_X_In_T of 'term * 'ident * 'term
-  | E_As_X_In_T of 'term * 'ident * 'term
-
-type pattern = evar_map * (constr, constr) ssrpattern
-val pp_pattern : pattern -> Pp.std_ppcmds
-
-(** Extracts the redex and applies to it the substitution part of the pattern.
-  @raise Anomaly if called on [In_T] or [In_X_In_T] *)
-val redex_of_pattern :
-  ?resolve_typeclasses:bool -> env -> pattern ->
-     constr Evd.in_evar_universe_context
-
-(** [interp_rpattern ise gl rpat] "internalizes" and "interprets" [rpat]
-    in the current [Ltac] interpretation signature [ise] and tactic input [gl]*)
-val interp_rpattern :
-  Tacinterp.interp_sign -> goal sigma ->
-  rpattern ->
-    pattern
-
-(** [interp_cpattern ise gl cpat ty] "internalizes" and "interprets" [cpat]
-    in the current [Ltac] interpretation signature [ise] and tactic input [gl].
-    [ty] is an optional type for the redex of [cpat] *)
-val interp_cpattern :
-  Tacinterp.interp_sign -> goal sigma ->
-  cpattern -> glob_constr_and_expr option ->
-    pattern
-
-(** The set of occurrences to be matched. The boolean is set to true
- *  to signal the complement of this set (i.e. {-1 3}) *)
-type occ = (bool * int list) option
-
-(** [subst e p t i]. [i] is the number of binders
-    traversed so far, [p] the term from the pattern, [t] the matched one *)
-type subst = env -> constr -> constr -> int -> constr
-
-(** [eval_pattern b env sigma t pat occ subst] maps [t] calling [subst] on every
-    [occ] occurrence of [pat]. The [int] argument is the number of 
-    binders traversed. If [pat] is [None] then then subst is called on [t].
-    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
-    (an extension of) [sigma]. 
-  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false])
-  @return [t] where all [occ] occurrences of [pat] have been mapped using
-    [subst] *)
-val eval_pattern :
-  ?raise_NoMatch:bool ->
-  env -> evar_map -> constr ->
-  pattern option -> occ -> subst ->
-    constr
-
-(** [fill_occ_pattern b env sigma t pat occ h] is a simplified version of 
-    [eval_pattern]. 
-    It replaces all [occ] occurrences of [pat] in [t] with Rel [h]. 
-    [t] must live in [env] and [sigma], [pat] must have been interpreted in 
-    (an extension of) [sigma]. 
-  @raise NoMatch if [pat] has no occurrence and [b] is [true] (default [false]) 
-  @return the instance of the redex of [pat] that was matched and [t]
-    transformed as described above. *)
-val fill_occ_pattern :
-  ?raise_NoMatch:bool ->
-  env -> evar_map -> constr ->
-  pattern -> occ -> int ->
-    constr Evd.in_evar_universe_context * constr
-
-(** *************************** Low level APIs ****************************** *)
-
-(* The primitive matching facility. It matches of a term with holes, like 
-   the T pattern above, and calls a continuation on its occurrences. *)
-
-type ssrdir = L2R | R2L
-val pr_dir_side : ssrdir -> Pp.std_ppcmds
-
-(** a pattern for a term with wildcards *)
-type tpattern
-
-(** [mk_tpattern env sigma0 sigma_p ok p_origin dir t] compiles a term [t] 
-    living in [env] [sigma] (an extension of [sigma0]) intro a [tpattern].
-    The [tpattern] can hold a (proof) term [p] and a diction [dir]. The [ok]
-    callback is used to filter occurrences.
-  @return the compiled [tpattern] and its [evar_map]
-  @raise UserEerror is the pattern is a wildcard *)
-val mk_tpattern :
-  ?p_origin:ssrdir * constr ->
-  env -> evar_map ->
-  evar_map * constr ->
-  (constr -> evar_map -> bool) ->
-  ssrdir -> constr ->
-    evar_map * tpattern
-
-(** [findP env t i k] is a stateful function that finds the next occurrence 
-    of a tpattern and calls the callback [k] to map the subterm matched. 
-    The [int] argument passed to [k] is the number of binders traversed so far 
-    plus the initial value [i]. 
-  @return [t] where the subterms identified by the selected occurrences of 
-    the patter have been mapped using [k]
-  @raise NoMatch if the raise_NoMatch flag given to [mk_tpattern_matcher] is
-    [true] and if the pattern did not match 
-  @raise UserEerror if the raise_NoMatch flag given to [mk_tpattern_matcher] is
-    [false] and if the pattern did not match *)
-type find_P =
-  env -> constr -> int -> k:subst -> constr
-
-(** [conclude ()] asserts that all mentioned ocurrences have been visited.
-  @return the instance of the pattern, the evarmap after the pattern
-    instantiation, the proof term and the ssrdit stored in the tpattern
-  @raise UserEerror if too many occurrences were specified *)
-type conclude =
-  unit -> constr * ssrdir * (evar_map * Evd.evar_universe_context * constr)
-
-(** [mk_tpattern_matcher b o sigma0 occ sigma_tplist] creates a pair 
-    a function [find_P] and [conclude] with the behaviour explained above.
-    The flag [b] (default [false]) changes the error reporting behaviour
-    of [find_P] if none of the [tpattern] matches. The argument [o] can
-    be passed to tune the [UserError] eventually raised (useful if the 
-    pattern is coming from the LHS/RHS of an equation) *)
-val mk_tpattern_matcher :
-  ?all_instances:bool ->
-  ?raise_NoMatch:bool ->
-  ?upats_origin:ssrdir * constr ->
-  evar_map -> occ -> evar_map * tpattern list ->
-    find_P * conclude
-
-(** Example of [mk_tpattern_matcher] to implement 
-    [rewrite \{occ\}\[in t\]rules].
-    It first matches "in t" (called [pat]), then in all matched subterms 
-    it matches the LHS of the rules using [find_R].
-    [concl0] is the initial goal, [concl] will be the goal where some terms
-    are replaced by a De Bruijn index. The [rw_progress] extra check
-    selects only occurrences that are not rewritten to themselves (e.g.
-    an occurrence "x + x" rewritten with the commutativity law of addition 
-    is skipped) {[
-  let find_R, conclude = match pat with
-  | Some (_, In_T _) ->
-      let aux (sigma, pats) (d, r, lhs, rhs) =
-        let sigma, pat = 
-          mk_tpattern env0 sigma0 (sigma, r) (rw_progress rhs) d lhs in
-        sigma, pats @ [pat] in
-      let rpats = List.fold_left aux (r_sigma, []) rules in
-      let find_R, end_R = mk_tpattern_matcher sigma0 occ rpats in
-      find_R ~k:(fun _ _ h -> mkRel h), 
-      fun cl -> let rdx, d, r = end_R () in (d,r),rdx
-  | _ -> ... in
-  let concl = eval_pattern env0 sigma0 concl0 pat occ find_R in
-  let (d, r), rdx = conclude concl in ]} *)
-
-(* convenience shortcut: [pf_fill_occ_term gl occ (sigma,t)] returns
- * the conclusion of [gl] where [occ] occurrences of [t] have been replaced
- * by [Rel 1] and the instance of [t] *)
-val pf_fill_occ_term : goal sigma -> occ -> evar_map * constr -> constr * constr
-
-(* It may be handy to inject a simple term into the first form of cpattern *)
-val cpattern_of_term : char * glob_constr_and_expr -> cpattern
-
-(** Helpers to make stateful closures. Example: a [find_P] function may be 
-    called many times, but the pattern instantiation phase is performed only the
-    first time. The corresponding [conclude] has to return the instantiated
-    pattern redex. Since it is up to [find_P] to raise [NoMatch] if the pattern
-    has no instance, [conclude] considers it an anomaly if the pattern did
-    not match *)
-
-(** [do_once r f] calls [f] and updates the ref only once *)
-val do_once : 'a option ref -> (unit -> 'a) -> unit
-(** [assert_done r] return the content of r. @raise Anomaly is r is [None] *)
-val assert_done : 'a option ref -> 'a
-
-(** Very low level APIs.
-    these are calls to evarconv's [the_conv_x] followed by
-    [consider_remaining_unif_problems] and [resolve_typeclasses].
-    In case of failure they raise [NoMatch] *)
-
-val unify_HO : env -> evar_map -> constr -> constr -> evar_map
-val pf_unify_HO : goal sigma -> constr -> constr -> goal sigma
-
-(** Some more low level functions needed to implement the full SSR language
-    on top of the former APIs *)
-val tag_of_cpattern : cpattern -> char
-val loc_of_cpattern : cpattern -> Loc.t
-val id_of_pattern : pattern -> Names.variable option
-val is_wildcard : cpattern -> bool
-val cpattern_of_id : Names.variable -> cpattern
-val cpattern_of_id : Names.variable -> cpattern
-val pr_constr_pat : constr -> Pp.std_ppcmds
-val pf_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
-val pf_unsafe_merge_uc : Evd.evar_universe_context -> goal Evd.sigma -> goal Evd.sigma
-
-(* One can also "Set SsrMatchingDebug" from a .v *)
-val debug : bool -> unit
-
-(* One should delimit a snippet with "Set SsrMatchingProfiling" and
- * "Unset SsrMatchingProfiling" to get timings *)
-val profile : bool -> unit
-
-(* eof *)
diff --git a/mathcomp/ssreflect/plugin/v8.4/ssreflect.ml4 b/mathcomp/ssreflect/plugin/v8.4/ssreflect.ml4
index 23b4ae5..cc4e896 100644
--- a/mathcomp/ssreflect/plugin/v8.4/ssreflect.ml4
+++ b/mathcomp/ssreflect/plugin/v8.4/ssreflect.ml4
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 (* This line is read by the Makefile's dist target: do not remove. *)
@@ -10,7 +10,7 @@ let () = Mltop.add_known_plugin (fun () ->
     Printf.printf "Copyright 2005-2012 Microsoft Corporation and INRIA.\n";
     Printf.printf "Distributed under the terms of the CeCILL-B license.\n\n"
   end)
-  "ssreflect"
+  "ssreflect_plugin"
 ;;
 (* Defining grammar rules with "xx" in it automatically declares keywords too *)
 let frozen_lexer = Lexer.freeze () ;;
@@ -1447,7 +1447,7 @@ let interp_modloc mr =
 (* The unified, extended vernacular "Search" command *)
 
 let ssrdisplaysearch gr env t =
-  let pr_res = pr_global gr ++ spc () ++ str " " ++ pr_lconstr_env env t in
+  let pr_res = pr_global gr ++ str ":" ++ spc () ++ pr_lconstr_env env t in
   msg (hov 2 pr_res ++ fnl ())
 
 VERNAC COMMAND EXTEND SsrSearchPattern
diff --git a/mathcomp/ssreflect/plugin/v8.4/ssreflect.mllib b/mathcomp/ssreflect/plugin/v8.4/ssreflect_plugin.mllib
index 006b70f..006b70f 100644
--- a/mathcomp/ssreflect/plugin/v8.4/ssreflect.mllib
+++ b/mathcomp/ssreflect/plugin/v8.4/ssreflect_plugin.mllib
diff --git a/mathcomp/ssreflect/plugin/v8.4/ssrmatching.ml4 b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.ml4
index 08f1780..ffbfdfd 100644
--- a/mathcomp/ssreflect/plugin/v8.4/ssrmatching.ml4
+++ b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.ml4
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 (* Defining grammar rules with "xx" in it automatically declares keywords too,
diff --git a/mathcomp/ssreflect/plugin/v8.4/ssrmatching.mli b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.mli
index a12f53b..5edc0a6 100644
--- a/mathcomp/ssreflect/plugin/v8.4/ssrmatching.mli
+++ b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.mli
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 open Genarg
diff --git a/mathcomp/ssreflect/ssrmatching.v b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.v
index bf7d21d..369ffaf 100644
--- a/mathcomp/ssreflect/ssrmatching.v
+++ b/mathcomp/ssreflect/plugin/v8.4/ssrmatching.v
@@ -1,6 +1,5 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
-Declare ML Module "ssreflect".
 
 Set Implicit Arguments.
 Unset Strict Implicit.
diff --git a/mathcomp/ssreflect/plugin/v8.5/ssreflect.ml4 b/mathcomp/ssreflect/plugin/v8.5/ssreflect.ml4
index c40d965..1c16fa9 100644
--- a/mathcomp/ssreflect/plugin/v8.5/ssreflect.ml4
+++ b/mathcomp/ssreflect/plugin/v8.5/ssreflect.ml4
@@ -1,17 +1,17 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 (* This line is read by the Makefile's dist target: do not remove. *)
-DECLARE PLUGIN "ssreflect"
+DECLARE PLUGIN "ssreflect_plugin"
 let ssrversion = "1.6";;
 let ssrAstVersion = 1;;
 let () = Mltop.add_known_plugin (fun () ->
   if Flags.is_verbose () && not !Flags.batch_mode then begin
     Printf.printf "\nSmall Scale Reflection version %s loaded.\n" ssrversion;
-    Printf.printf "Copyright 2005-2014 Microsoft Corporation and INRIA.\n";
+    Printf.printf "Copyright 2005-2016 Microsoft Corporation and INRIA.\n";
     Printf.printf "Distributed under the terms of the CeCILL-B license.\n\n"
   end)
-  "ssreflect"
+  "ssreflect_plugin"
 ;;
 
 (* Defining grammar rules with "xx" in it automatically declares keywords too,
@@ -1011,7 +1011,7 @@ let pf_unabs_evars gl ise n c0 =
 type ssrargfmt = ArgSsr of string | ArgCoq of argument_type | ArgSep of string
 
 let ssrtac_name name = {
-  mltac_plugin = "ssreflect";
+  mltac_plugin = "ssreflect_plugin";
   mltac_tactic = "ssr" ^ name;
 }
 
@@ -1436,7 +1436,7 @@ let interp_modloc mr =
 (* The unified, extended vernacular "Search" command *)
 
 let ssrdisplaysearch gr env t =
-  let pr_res = pr_global gr ++ spc () ++ str " " ++ pr_lconstr_env env Evd.empty t in
+  let pr_res = pr_global gr ++ str ":" ++ spc () ++ pr_lconstr_env env Evd.empty t in
   msg_info (hov 2 pr_res ++ fnl ())
 
 VERNAC COMMAND EXTEND SsrSearchPattern CLASSIFIED AS QUERY
diff --git a/mathcomp/ssreflect/plugin/v8.5/ssreflect.mllib b/mathcomp/ssreflect/plugin/v8.5/ssreflect_plugin.mllib
index 006b70f..006b70f 100644
--- a/mathcomp/ssreflect/plugin/v8.5/ssreflect.mllib
+++ b/mathcomp/ssreflect/plugin/v8.5/ssreflect_plugin.mllib
diff --git a/mathcomp/ssreflect/plugin/v8.5/ssrmatching.ml4 b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.ml4
index fc0b573..084aee9 100644
--- a/mathcomp/ssreflect/plugin/v8.5/ssrmatching.ml4
+++ b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.ml4
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 (* Defining grammar rules with "xx" in it automatically declares keywords too,
@@ -878,7 +878,36 @@ let pr_ssrpattern_roundp  _ _ _ = pr_pattern_roundp
 
 let wit_rpatternty = add_genarg "rpatternty" pr_pattern
 
-ARGUMENT EXTEND rpattern TYPED AS rpatternty PRINTED BY pr_rpattern
+let glob_ssrterm gs = function
+  | k, (_, Some c) -> k,
+      let x = Tacintern.intern_constr gs c in
+      fst x, Some c
+  | ct -> ct
+
+let glob_rpattern s p =
+  match p with
+  | T t -> T (glob_ssrterm s t)
+  | In_T t -> In_T (glob_ssrterm s t)
+  | X_In_T(x,t) -> X_In_T (x,glob_ssrterm s t)
+  | In_X_In_T(x,t) -> In_X_In_T (x,glob_ssrterm s t)
+  | E_In_X_In_T(e,x,t) -> E_In_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
+  | E_As_X_In_T(e,x,t) -> E_As_X_In_T (glob_ssrterm s e,x,glob_ssrterm s t)
+
+let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
+
+let subst_rpattern s = function
+  | T t -> T (subst_ssrterm s t)
+  | In_T t -> In_T (subst_ssrterm s t)
+  | X_In_T(x,t) -> X_In_T (x,subst_ssrterm s t)
+  | In_X_In_T(x,t) -> In_X_In_T (x,subst_ssrterm s t)
+  | E_In_X_In_T(e,x,t) -> E_In_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
+  | E_As_X_In_T(e,x,t) -> E_As_X_In_T (subst_ssrterm s e,x,subst_ssrterm s t)
+
+ARGUMENT EXTEND rpattern
+  TYPED AS rpatternty
+  PRINTED BY pr_rpattern
+  GLOBALIZED BY glob_rpattern
+  SUBSTITUTED BY subst_rpattern
   | [ lconstr(c) ] -> [ T (mk_lterm c) ]
   | [ "in" lconstr(c) ] -> [ In_T (mk_lterm c) ]
   | [ lconstr(x) "in" lconstr(c) ] -> 
@@ -1264,12 +1293,17 @@ let is_wildcard = function
   | _ -> false
 
 (* "ssrpattern" *)
-let pr_ssrpatternarg _ _ _ cpat = pr_rpattern cpat
+let pr_ssrpatternarg _ _ _ (_,cpat) = pr_rpattern cpat
+let pr_ssrpatternarg_glob _ _ _ cpat = pr_rpattern cpat
+let interp_ssrpatternarg ist gl p = project gl, (ist, p)
 
 ARGUMENT EXTEND ssrpatternarg
-  TYPED AS rpattern
   PRINTED BY pr_ssrpatternarg
-| [ "[" rpattern(pat) "]" ] -> [ pat ]
+  INTERPRETED BY interp_ssrpatternarg
+  GLOBALIZED BY glob_rpattern
+  RAW_TYPED AS rpattern RAW_PRINTED BY pr_ssrpatternarg_glob
+  GLOB_TYPED AS rpattern GLOB_PRINTED BY pr_ssrpatternarg_glob
+| [ rpattern(pat) ] -> [ pat ]
 END
   
 let pf_merge_uc uc gl =
@@ -1278,8 +1312,8 @@ let pf_merge_uc uc gl =
 let pf_unsafe_merge_uc uc gl =
   re_sig (sig_it gl) (Evd.set_universe_context (project gl) uc)
 
-let ssrpatterntac ist arg gl =
-  let pat = interp_rpattern ist gl arg in
+let ssrpatterntac _ist (arg_ist,arg) gl =
+  let pat = interp_rpattern arg_ist gl arg in
   let sigma0 = project gl in
   let concl0 = pf_concl gl in
   let (t, uc), concl_x =
diff --git a/mathcomp/ssreflect/plugin/v8.5/ssrmatching.mli b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.mli
index 74a603e..84700d6 100644
--- a/mathcomp/ssreflect/plugin/v8.5/ssrmatching.mli
+++ b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.mli
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 open Genarg
diff --git a/mathcomp/ssreflect/plugin/v8.5/ssrmatching.v b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.v
new file mode 100644
index 0000000..369ffaf
--- /dev/null
+++ b/mathcomp/ssreflect/plugin/v8.5/ssrmatching.v
@@ -0,0 +1,27 @@
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
+(* Distributed under the terms of CeCILL-B.                                  *)
+
+Set Implicit Arguments.
+Unset Strict Implicit.
+Unset Printing Implicit Defensive.
+
+Module SsrMatchingSyntax.
+
+(* Reserve the notation for rewrite patterns so that the user is not allowed  *)
+(* to declare it at a different level.                                        *)
+Reserved Notation "( a 'in' b )"        (at level 0).
+Reserved Notation "( a 'as' b )"        (at level 0).
+Reserved Notation "( a 'in' b 'in' c )" (at level 0).
+Reserved Notation "( a 'as' b 'in' c )" (at level 0).
+
+(* Notation to define shortcuts for the "X in t" part of a pattern.           *)
+Notation "( X 'in' t )" := (_ : fun X => t) : ssrpatternscope.
+Delimit Scope ssrpatternscope with pattern.
+
+(* Some shortcuts for recurrent "X in t" parts.                               *)
+Notation RHS := (X in _ = X)%pattern.
+Notation LHS := (X in X = _)%pattern.
+
+End SsrMatchingSyntax.
+
+Export SsrMatchingSyntax.
diff --git a/mathcomp/ssreflect/plugin/v8.6/ssreflect.ml4 b/mathcomp/ssreflect/plugin/v8.6/ssreflect.ml4
new file mode 100644
index 0000000..6aaa79b
--- /dev/null
+++ b/mathcomp/ssreflect/plugin/v8.6/ssreflect.ml4
@@ -0,0 +1,6242 @@
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
+(* Distributed under the terms of CeCILL-B.                                  *)
+
+(* This line is read by the Makefile's dist target: do not remove. *)
+DECLARE PLUGIN "ssreflect_plugin"
+let ssrversion = "1.6";;
+let ssrAstVersion = 1;;
+let () = Mltop.add_known_plugin (fun () ->
+  if Flags.is_verbose () && not !Flags.batch_mode then begin
+    Printf.printf "\nSmall Scale Reflection version %s loaded.\n" ssrversion;
+    Printf.printf "Copyright 2005-2016 Microsoft Corporation and INRIA.\n";
+    Printf.printf "Distributed under the terms of the CeCILL-B license.\n\n"
+  end)
+  "ssreflect_plugin"
+;;
+
+(* Defining grammar rules with "xx" in it automatically declares keywords too,
+ * we thus save the lexer to restore it at the end of the file *)
+let frozen_lexer = CLexer.freeze () ;;
+
+(*i camlp4use: "pa_extend.cmo" i*)
+(*i camlp4deps: "grammar/grammar.cma" i*)
+
+open Names
+open Pp
+open Feedback
+open Pcoq
+open Pcoq.Prim
+open Pcoq.Constr
+open Genarg
+open Stdarg
+open Constrarg
+open Term
+open Vars
+open Context
+open Topconstr
+open Libnames
+open Tactics
+open Tacticals
+open Termops
+open Namegen
+open Recordops
+open Tacmach
+open Coqlib
+open Glob_term
+open Util
+open Evd
+open Sigma.Notations
+open Extend
+open Goptions
+open Tacexpr
+open Tacinterp
+open Pretyping
+open Constr
+open Tactic
+open Extraargs
+open Ppconstr
+open Printer
+
+open Globnames
+open Misctypes
+open Decl_kinds
+open Evar_kinds
+open Constrexpr
+open Constrexpr_ops
+open Notation_term
+open Notation_ops
+open Locus
+open Locusops
+
+open Compat
+open Tok
+
+open Ssrmatching_plugin
+open Ssrmatching
+
+module RelDecl = Context.Rel.Declaration
+module NamedDecl = Context.Named.Declaration
+
+(* Tentative patch from util.ml *)
+
+let array_fold_right_from n f v a =
+  let rec fold n =
+    if n >= Array.length v then a else f v.(n) (fold (succ n))
+  in
+  fold n
+
+let array_app_tl v l =
+  if Array.length v = 0 then invalid_arg "array_app_tl";
+  array_fold_right_from 1 (fun e l -> e::l) v l
+
+let array_list_of_tl v =
+  if Array.length v = 0 then invalid_arg "array_list_of_tl";
+  array_fold_right_from 1 (fun e l -> e::l) v []
+
+(* end patch *)
+
+module Intset = Evar.Set
+
+type loc = Loc.t
+let dummy_loc = Loc.ghost
+let errorstrm = CErrors.errorlabstrm "ssreflect"
+let loc_error loc msg = CErrors.user_err_loc (loc, msg, str msg)
+let anomaly s = CErrors.anomaly (str s)
+
+(* Compatibility with Coq 8.6 *)
+let ppnl  = msg_info
+let msgnl = msg_info
+
+let mk_reldecl name obody ty =
+  match obody with
+  | None -> RelDecl.LocalAssum (name, ty)
+  | Some bo -> RelDecl.LocalDef (name, bo, ty)
+
+(** look up a name in the ssreflect internals module *)
+let ssrdirpath = make_dirpath [id_of_string "ssreflect"]
+let ssrqid name = make_qualid ssrdirpath (id_of_string name) 
+let ssrtopqid name = make_short_qualid (id_of_string name) 
+let locate_reference qid =
+  Smartlocate.global_of_extended_global (Nametab.locate_extended qid)
+let mkSsrRef name =
+  try locate_reference (ssrqid name) with Not_found ->
+  try locate_reference (ssrtopqid name) with Not_found ->
+  CErrors.error "Small scale reflection library not loaded"
+let mkSsrRRef name = GRef (dummy_loc, mkSsrRef name,None), None
+let mkSsrConst name env sigma =
+  Sigma.fresh_global env sigma (mkSsrRef name)
+let pf_mkSsrConst name gl =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma = Sigma.Unsafe.of_evar_map sigma in
+  let Sigma (t, sigma, _) = mkSsrConst name env sigma in
+  let sigma = Sigma.to_evar_map sigma in
+  t, re_sig it sigma
+let pf_fresh_global name gl =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma,t  = Evd.fresh_global env sigma name in
+  t, re_sig it sigma
+
+(** Ssreflect load check. *)
+
+(* To allow ssrcoq to be fully compatible with the "plain" Coq, we only *)
+(* turn on its incompatible features (the new rewrite syntax, and the   *)
+(* reserved identifiers) when the theory library (ssreflect.v) has      *)
+(* has actually been required, or is being defined. Because this check  *)
+(* needs to be done often (for each identifier lookup), we implement    *)
+(* some caching, repeating the test only when the environment changes.  *)
+(*   We check for protect_term because it is the first constant loaded; *)
+(* ssr_have would ultimately be a better choice.                        *)
+let ssr_loaded = Summary.ref ~name:"SSR:loaded" false
+let is_ssr_loaded () =
+  !ssr_loaded ||
+  (if CLexer.is_keyword "SsrSyntax_is_Imported" then ssr_loaded:=true;
+   !ssr_loaded)
+
+(* 0 cost pp function. Active only if env variable SSRDEBUG is set *)
+(* or if SsrDebug is Set                                                  *)
+let pp_ref = ref (fun _ -> ())
+let ssr_pp s = msg_error (str"SSR: "++Lazy.force s)
+let _ = try ignore(Sys.getenv "SSRDEBUG"); pp_ref := ssr_pp with Not_found -> ()
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssreflect debugging";
+      Goptions.optkey   = ["SsrDebug"];
+      Goptions.optdepr  = false;
+      Goptions.optread  = (fun _ -> !pp_ref == ssr_pp);
+      Goptions.optwrite = (fun b -> 
+        Ssrmatching.debug b;
+        if b then pp_ref := ssr_pp else pp_ref := fun _ -> ()) }
+let pp s = !pp_ref s
+
+(** Utils {{{ *****************************************************************)
+let env_size env = List.length (Environ.named_context env)
+let safeDestApp c =
+  match kind_of_term c with App (f, a) -> f, a | _ -> c, [| |]
+let get_index = function ArgArg i -> i | _ ->
+  anomaly "Uninterpreted index"
+(* Toplevel constr must be globalized twice ! *)
+let glob_constr ist genv = function
+  | _, Some ce ->
+    let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.lfun Id.Set.empty in
+    let ltacvars = {
+      Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in
+    Constrintern.intern_gen WithoutTypeConstraint ~ltacvars genv ce
+  | rc, None -> rc
+
+(* Term printing utilities functions for deciding bracketing.  *)
+let pr_paren prx x = hov 1 (str "(" ++ prx x ++ str ")")
+(* String lexing utilities *)
+let skip_wschars s =
+  let rec loop i = match s.[i] with '\n'..' ' -> loop (i + 1) | _ -> i in loop
+let skip_numchars s =
+  let rec loop i = match s.[i] with '0'..'9' -> loop (i + 1) | _ -> i in loop
+(* We also guard characters that might interfere with the ssreflect   *)
+(* tactic syntax.                                                     *)
+let guard_term ch1 s i = match s.[i] with
+  | '(' -> false
+  | '{' | '/' | '=' -> true
+  | _ -> ch1 = '('
+(* The call 'guard s i' should return true if the contents of s *)
+(* starting at i need bracketing to avoid ambiguities.          *)
+let pr_guarded guard prc c =
+  msg_with Format.str_formatter (prc c);
+  let s = Format.flush_str_formatter () ^ "$" in
+  if guard s (skip_wschars s 0) then pr_paren prc c else prc c
+(* More sensible names for constr printers *)
+let prl_constr = pr_lconstr
+let pr_constr = pr_constr
+let prl_glob_constr c = pr_lglob_constr_env (Global.env ()) c
+let pr_glob_constr c = pr_glob_constr_env (Global.env ()) c
+let prl_constr_expr = pr_lconstr_expr
+let pr_constr_expr = pr_constr_expr
+let prl_glob_constr_and_expr = function
+  | _, Some c -> prl_constr_expr c
+  | c, None -> prl_glob_constr c
+let pr_glob_constr_and_expr = function
+  | _, Some c -> pr_constr_expr c
+  | c, None -> pr_glob_constr c
+let pr_term (k, c) = pr_guarded (guard_term k) pr_glob_constr_and_expr c
+let prl_term (k, c) = pr_guarded (guard_term k) prl_glob_constr_and_expr c
+
+(** Adding a new uninterpreted generic argument type *)
+let add_genarg tag pr =
+  let wit = Genarg.make0 tag in
+  let tag = Geninterp.Val.create tag in
+  let glob ist x = (ist, x) in
+  let subst _ x = x in
+  let interp ist x = Ftactic.return (Geninterp.Val.Dyn (tag, x)) in
+  let gen_pr _ _ _ = pr in
+  let () = Genintern.register_intern0 wit glob in
+  let () = Genintern.register_subst0 wit subst in
+  let () = Geninterp.register_interp0 wit interp in
+  let () = Geninterp.register_val0 wit (Some (Geninterp.Val.Base tag)) in
+  Pptactic.declare_extra_genarg_pprule wit gen_pr gen_pr gen_pr;
+  wit
+
+(** Constructors for cast type *)
+let dC t = CastConv t
+
+(** Constructors for constr_expr *)
+let mkCProp loc = CSort (loc, GProp)
+let mkCType loc = CSort (loc, GType [])
+let mkCVar loc id = CRef (Ident (loc, id),None)
+let isCVar = function CRef (Ident _,_) -> true | _ -> false
+let destCVar = function CRef (Ident (_, id),_) -> id | _ ->
+  anomaly "not a CRef"
+let rec mkCHoles loc n =
+  if n <= 0 then [] else CHole (loc, None, IntroAnonymous, None) :: mkCHoles loc (n - 1)
+let mkCHole loc = CHole (loc, None, IntroAnonymous, None)
+let rec isCHoles = function CHole _ :: cl -> isCHoles cl | cl -> cl = []
+let mkCExplVar loc id n =
+   CAppExpl (loc, (None, Ident (loc, id), None), mkCHoles loc n)
+let mkCLambda loc name ty t = 
+   CLambdaN (loc, [[loc, name], Default Explicit, ty], t)
+let mkCLetIn loc name bo t = 
+   CLetIn (loc, (loc, name), bo, t)
+let mkCArrow loc ty t =
+   CProdN (loc, [[dummy_loc,Anonymous], Default Explicit, ty], t)
+let mkCCast loc t ty = CCast (loc,t, dC ty)
+(** Constructors for rawconstr *)
+let mkRHole = GHole (dummy_loc, InternalHole, IntroAnonymous, None)
+let rec mkRHoles n = if n > 0 then mkRHole :: mkRHoles (n - 1) else []
+let rec isRHoles = function GHole _ :: cl -> isRHoles cl | cl -> cl = []
+let mkRApp f args = if args = [] then f else GApp (dummy_loc, f, args)
+let mkRVar id = GRef (dummy_loc, VarRef id,None)
+let mkRltacVar id = GVar (dummy_loc, id)
+let mkRCast rc rt =  GCast (dummy_loc, rc, dC rt)
+let mkRType =  GSort (dummy_loc, GType [])
+let mkRProp =  GSort (dummy_loc, GProp)
+let mkRArrow rt1 rt2 = GProd (dummy_loc, Anonymous, Explicit, rt1, rt2)
+let mkRConstruct c = GRef (dummy_loc, ConstructRef c,None)
+let mkRInd mind = GRef (dummy_loc, IndRef mind,None)
+let mkRLambda n s t = GLambda (dummy_loc, n, Explicit, s, t)
+
+(** Constructors for constr *)
+let pf_e_type_of gl t =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma, ty = Typing.type_of env sigma t in
+  re_sig it sigma, ty
+
+let mkAppRed f c = match kind_of_term f with
+| Lambda (_, _, b) -> subst1 c b
+| _ -> mkApp (f, [|c|])
+
+let mkProt t c gl =
+  let prot, gl = pf_mkSsrConst "protect_term" gl in
+  mkApp (prot, [|t; c|]), gl
+
+let mkRefl t c gl =
+  let refl, gl = pf_fresh_global (build_coq_eq_data()).refl gl in
+  mkApp (refl, [|t; c|]), gl
+
+
+(* Application to a sequence of n rels (for building eta-expansions). *)
+(* The rel indices decrease down to imin (inclusive), unless n < 0,   *)
+(* in which case they're incresing (from imin).                       *)
+let mkEtaApp c n imin =
+  if n = 0 then c else
+  let nargs, mkarg =
+    if n < 0 then -n, (fun i -> mkRel (imin + i)) else
+    let imax = imin + n - 1 in n, (fun i -> mkRel (imax - i)) in
+  mkApp (c, Array.init nargs mkarg)
+(* Same, but optimizing head beta redexes *)
+let rec whdEtaApp c n =
+  if n = 0 then c else match kind_of_term c with
+  | Lambda (_, _, c') -> whdEtaApp c' (n - 1)
+  | _ -> mkEtaApp (lift n c) n 1
+let mkType () = Universes.new_Type (Lib.cwd ())
+
+(* ssrterm conbinators *)
+let combineCG t1 t2 f g = match t1, t2 with
+ | (x, (t1, None)), (_, (t2, None)) -> x, (g t1 t2, None)
+ | (x, (_, Some t1)), (_, (_, Some t2)) -> x, (mkRHole, Some (f t1 t2))
+ | _, (_, (_, None)) -> anomaly "have: mixed C-G constr"
+ | _ -> anomaly "have: mixed G-C constr"
+let loc_ofCG = function
+ | (_, (s, None)) -> Glob_ops.loc_of_glob_constr s
+ | (_, (_, Some s)) -> Constrexpr_ops.constr_loc s
+
+let mk_term k c = k, (mkRHole, Some c)
+let mk_lterm c = mk_term ' ' c
+
+let pf_type_of gl t = let sigma, ty = pf_type_of gl t in re_sig (sig_it gl)  sigma, ty
+
+let map_fold_constr g f ctx acc cstr =
+  let array_f ctx acc x = let x, acc = f ctx acc x in acc, x in
+  match kind_of_term cstr with
+  | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _ | Construct _) ->
+      cstr, acc
+  | Proj (x,c) ->
+      let c', acc = f ctx acc c in
+      (if c == c' then cstr else mkProj (x,c')), acc
+  | Cast (c,k, t) ->
+      let c', acc = f ctx acc c in
+      let t', acc = f ctx acc t in
+      (if c==c' && t==t' then cstr else mkCast (c', k, t')), acc
+  | Prod (na,t,c) ->
+      let t', acc = f ctx acc t in
+      let c', acc = f (g (na,None,t) ctx) acc c in
+      (if t==t' && c==c' then cstr else mkProd (na, t', c')), acc
+  | Lambda (na,t,c) ->
+      let t', acc = f ctx acc t in
+      let c', acc = f (g (na,None,t) ctx) acc c in
+      (if t==t' && c==c' then cstr else  mkLambda (na, t', c')), acc
+  | LetIn (na,b,t,c) ->
+      let b', acc = f ctx acc b in
+      let t', acc = f ctx acc t in
+      let c', acc = f (g (na,Some b,t) ctx) acc c in
+      (if b==b' && t==t' && c==c' then cstr else mkLetIn (na, b', t', c')), acc
+  | App (c,al) ->
+      let c', acc = f ctx acc c in
+      let acc, al' = CArray.smartfoldmap (array_f ctx) acc al in
+      (if c==c' && Array.for_all2 (==) al al' then cstr else mkApp (c', al')),
+      acc
+  | Evar (e,al) ->
+      let acc, al' = CArray.smartfoldmap (array_f ctx) acc al in
+      (if Array.for_all2 (==) al al' then cstr else mkEvar (e, al')), acc
+  | Case (ci,p,c,bl) ->
+      let p', acc = f ctx acc p in
+      let c', acc = f ctx acc c in
+      let acc, bl' = CArray.smartfoldmap (array_f ctx) acc bl in
+      (if p==p' && c==c' && Array.for_all2 (==) bl bl' then cstr else
+        mkCase (ci, p', c', bl')),
+      acc
+  | Fix (ln,(lna,tl,bl)) ->
+      let acc, tl' = CArray.smartfoldmap (array_f ctx) acc tl in
+      let ctx' = Array.fold_left2 (fun l na t -> g (na,None,t) l) ctx lna tl in
+      let acc, bl' = CArray.smartfoldmap (array_f ctx') acc bl in
+      (if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl'
+      then cstr
+      else mkFix (ln,(lna,tl',bl'))), acc
+  | CoFix(ln,(lna,tl,bl)) ->
+      let acc, tl' = CArray.smartfoldmap (array_f ctx) acc tl in
+      let ctx' = Array.fold_left2 (fun l na t -> g (na,None,t) l) ctx lna tl in
+      let acc,bl' = CArray.smartfoldmap (array_f ctx') acc bl in
+      (if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl'
+      then cstr
+      else mkCoFix (ln,(lna,tl',bl'))), acc
+
+let pf_merge_uc_of sigma gl =
+  let ucst = Evd.evar_universe_context sigma in
+  pf_merge_uc ucst gl
+
+(* }}} *)
+
+(** Profiling {{{ *************************************************************)
+type profiler = { 
+  profile : 'a 'b. ('a -> 'b) -> 'a -> 'b;
+  reset : unit -> unit;
+  print : unit -> unit }
+let profile_now = ref false
+let something_profiled = ref false
+let profilers = ref []
+let add_profiler f = profilers := f :: !profilers;;
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssreflect profiling";
+      Goptions.optkey   = ["SsrProfiling"];
+      Goptions.optread  = (fun _ -> !profile_now);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> 
+        Ssrmatching.profile b;
+        profile_now := b;
+        if b then List.iter (fun f -> f.reset ()) !profilers;
+        if not b then List.iter (fun f -> f.print ()) !profilers) }
+let () =
+  let prof_total = 
+    let init = ref 0.0 in { 
+    profile = (fun f x -> assert false);
+    reset = (fun () -> init := Unix.gettimeofday ());
+    print = (fun () -> if !something_profiled then
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f"
+           "total" 0 (Unix.gettimeofday() -. !init) 0.0 0.0)) } in
+  let prof_legenda = {
+    profile = (fun f x -> assert false);
+    reset = (fun () -> ());
+    print = (fun () -> if !something_profiled then begin
+        prerr_endline 
+           (Printf.sprintf "!! %39s ---------- --------- --------- ---------" 
+           (String.make 39 '-'));
+        prerr_endline 
+           (Printf.sprintf "!! %-39s %10s %9s %9s %9s" 
+           "function" "#calls" "total" "max" "average") end) } in
+  add_profiler prof_legenda;
+  add_profiler prof_total
+;;
+
+let mk_profiler s =
+  let total, calls, max = ref 0.0, ref 0, ref 0.0 in
+  let reset () = total := 0.0; calls := 0; max := 0.0 in
+  let profile f x =
+    if not !profile_now then f x else
+    let before = Unix.gettimeofday () in
+    try
+      incr calls;
+      let res = f x in
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      res
+    with exc ->
+      let after = Unix.gettimeofday () in
+      let delta = after -. before in
+      total := !total +. delta;
+      if delta > !max then max := delta;
+      raise exc in
+  let print () =
+     if !calls <> 0 then begin
+       something_profiled := true;
+       prerr_endline
+         (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" 
+         s !calls !total !max (!total /. (float_of_int !calls))) end in
+  let prof = { profile = profile; reset = reset; print = print } in
+  add_profiler prof;
+  prof
+;;
+(* }}} *)
+
+let inVersion = Libobject.declare_object {
+  (Libobject.default_object "SSRASTVERSION") with
+  Libobject.load_function = (fun _ (_,v) -> 
+    if v <> ssrAstVersion then CErrors.error "Please recompile your .vo files");
+  Libobject.classify_function = (fun v -> Libobject.Keep v);
+}
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssreflect version";
+      Goptions.optkey   = ["SsrAstVersion"];
+      Goptions.optread  = (fun _ -> true);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun _ -> 
+        Lib.add_anonymous_leaf (inVersion ssrAstVersion)) }
+
+let tactic_expr = Tactic.tactic_expr
+let gallina_ext = Vernac_.gallina_ext 
+let sprintf = Printf.sprintf
+let tactic_mode = G_ltac.tactic_mode
+
+(** 1. Utilities *)
+
+
+let ssroldreworder = Summary.ref ~name:"SSR:oldreworder" true
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "ssreflect 1.3 compatibility flag";
+      Goptions.optkey   = ["SsrOldRewriteGoalsOrder"];
+      Goptions.optread  = (fun _ -> !ssroldreworder);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> ssroldreworder := b) }
+
+let ssrhaveNOtcresolution = Summary.ref ~name:"SSR:havenotcresolution" false
+
+let inHaveTCResolution = Libobject.declare_object {
+  (Libobject.default_object "SSRHAVETCRESOLUTION") with
+  Libobject.cache_function = (fun (_,v) -> ssrhaveNOtcresolution := v);
+  Libobject.load_function = (fun _ (_,v) -> ssrhaveNOtcresolution := v);
+  Libobject.classify_function = (fun v -> Libobject.Keep v);
+}
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = false;
+      Goptions.optname  = "have type classes";
+      Goptions.optkey   = ["SsrHave";"NoTCResolution"];
+      Goptions.optread  = (fun _ -> !ssrhaveNOtcresolution);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b ->
+        Lib.add_anonymous_leaf (inHaveTCResolution b)) }
+
+
+(** Primitive parsing to avoid syntax conflicts with basic tactics. *)
+
+let accept_before_syms syms strm =
+  match Compat.get_tok (stream_nth 1 strm) with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | _ -> raise Stream.Failure
+
+let accept_before_syms_or_any_id syms strm =
+  match Compat.get_tok (stream_nth 1 strm) with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | Tok.IDENT _ -> ()
+  | _ -> raise Stream.Failure
+
+let accept_before_syms_or_ids syms ids strm =
+  match Compat.get_tok (stream_nth 1 strm) with
+  | Tok.KEYWORD sym when List.mem sym syms -> ()
+  | Tok.IDENT id when List.mem id ids -> ()
+  | _ -> raise Stream.Failure
+
+(** Pretty-printing utilities *)
+
+let pr_id = Ppconstr.pr_id
+let pr_name = function Name id -> pr_id id | Anonymous -> str "_"
+let pr_spc () = str " "
+let pr_bar () = Pp.cut() ++ str "|"
+let pr_list = prlist_with_sep
+
+let tacltop = (5,Ppextend.E)
+
+(** Tactic-level diagnosis *)
+
+let pf_pr_constr gl = pr_constr_env (pf_env gl)
+
+let pf_pr_glob_constr gl = pr_glob_constr_env (pf_env gl)
+
+(* debug *)
+
+let pf_msg gl =
+   let ppgl = pr_lconstr_env (pf_env gl) (project gl) (pf_concl gl) in
+   msgnl (str "goal is " ++ ppgl)
+
+let msgtac gl = pf_msg gl; tclIDTAC gl
+
+(** Tactic utilities *)
+
+let last_goal gls = let sigma, gll = Refiner.unpackage gls in
+   Refiner.repackage sigma (List.nth gll (List.length gll - 1))
+
+let pf_type_id gl t = id_of_string (hdchar (pf_env gl) t)
+
+let not_section_id id = not (is_section_variable id)
+
+let is_pf_var c = isVar c && not_section_id (destVar c)
+
+let pf_ids_of_proof_hyps gl =
+  let add_hyp decl ids =
+    let id = NamedDecl.get_id decl in
+    if not_section_id id then id :: ids else ids in
+  Context.Named.fold_outside add_hyp (pf_hyps gl) ~init:[]
+
+let pf_nf_evar gl e = Reductionops.nf_evar (project gl) e
+
+let pf_partial_solution gl t evl =
+  let sigma, g = project gl, sig_it gl in
+  let sigma = Goal.V82.partial_solution sigma g t in
+  re_sig (List.map (fun x -> (fst (destEvar x))) evl) sigma
+
+let pf_new_evar gl ty =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma = Sigma.Unsafe.of_evar_map sigma in
+  let Sigma (extra, sigma, _) = Evarutil.new_evar env sigma ty in
+  let sigma = Sigma.to_evar_map sigma in
+  re_sig it sigma, extra
+
+(* Basic tactics *)
+
+let convert_concl_no_check t = convert_concl_no_check t DEFAULTcast
+let convert_concl t = convert_concl t DEFAULTcast
+let reduct_in_concl t = reduct_in_concl (t, DEFAULTcast)
+let havetac id c = Proofview.V82.of_tactic (pose_proof (Name id) c)
+let settac id c = letin_tac None (Name id) c None
+let posetac id cl = Proofview.V82.of_tactic (settac id cl nowhere)
+let basecuttac name c gl =
+  let hd, gl = pf_mkSsrConst name gl in
+  let t = mkApp (hd, [|c|]) in
+  let gl, _ = pf_e_type_of gl t in
+  Proofview.V82.of_tactic (apply t) gl
+let apply_type x xs = Proofview.V82.of_tactic (apply_type x xs)
+
+(* we reduce head beta redexes *)
+let betared env = 
+  CClosure.create_clos_infos 
+   (CClosure.RedFlags.mkflags [CClosure.RedFlags.fBETA])
+    env
+;;
+let introid name = tclTHEN (fun gl ->
+   let g, env = pf_concl gl, pf_env gl in
+   match kind_of_term g with
+   | App (hd, _) when isLambda hd -> 
+     let g = CClosure.whd_val (betared env) (CClosure.inject g) in
+     Proofview.V82.of_tactic (convert_concl_no_check g) gl
+   | _ -> tclIDTAC gl)
+  (Proofview.V82.of_tactic (intro_mustbe_force name))
+;;
+
+
+(** Name generation {{{ *******************************************************)
+
+(* Since Coq now does repeated internal checks of its external lexical *)
+(* rules, we now need to carve ssreflect reserved identifiers out of   *)
+(* out of the user namespace. We use identifiers of the form _id_ for  *)
+(* this purpose, e.g., we "anonymize" an identifier id as _id_, adding *)
+(* an extra leading _ if this might clash with an internal identifier. *)
+(*    We check for ssreflect identifiers in the ident grammar rule;    *)
+(* when the ssreflect Module is present this is normally an error,     *)
+(* but we provide a compatibility flag to reduce this to a warning.    *)
+
+let ssr_reserved_ids = Summary.ref ~name:"SSR:idents" true
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = true;
+      Goptions.optname  = "ssreflect identifiers";
+      Goptions.optkey   = ["SsrIdents"];
+      Goptions.optdepr  = false;
+      Goptions.optread  = (fun _ -> !ssr_reserved_ids);
+      Goptions.optwrite = (fun b -> ssr_reserved_ids := b)
+    }
+
+let is_ssr_reserved s =
+  let n = String.length s in n > 2 && s.[0] = '_' && s.[n - 1] = '_'
+
+let internal_names = ref []
+let add_internal_name pt = internal_names := pt :: !internal_names
+let is_internal_name s = List.exists (fun p -> p s) !internal_names
+
+let ssr_id_of_string loc s =
+  if is_ssr_reserved s && is_ssr_loaded () then begin
+    if !ssr_reserved_ids then
+      loc_error loc ("The identifier " ^ s ^ " is reserved.")
+    else if is_internal_name s then
+      msg_warning (str ("Conflict between " ^ s ^ " and ssreflect internal names."))
+    else msg_warning (str (
+     "The name " ^ s ^ " fits the _xxx_ format used for anonymous variables.\n"
+  ^ "Scripts with explicit references to anonymous variables are fragile."))
+    end; id_of_string s
+
+let ssr_null_entry = Gram.Entry.of_parser "ssr_null" (fun _ -> ())
+
+let (!@) = Compat.to_coqloc
+
+GEXTEND Gram 
+  GLOBAL: Prim.ident;
+  Prim.ident: [[ s = IDENT; ssr_null_entry -> ssr_id_of_string !@loc s ]];
+END
+
+let mk_internal_id s =
+  let s' = sprintf "_%s_" s in
+  for i = 1 to String.length s do if s'.[i] = ' ' then s'.[i] <- '_' done;
+  add_internal_name ((=) s'); id_of_string s'
+
+let same_prefix s t n =
+  let rec loop i = i = n || s.[i] = t.[i] && loop (i + 1) in loop 0
+
+let skip_digits s =
+  let n = String.length s in 
+  let rec loop i = if i < n && is_digit s.[i] then loop (i + 1) else i in loop
+
+let mk_tagged_id t i = id_of_string (sprintf "%s%d_" t i)
+let is_tagged t s =
+  let n = String.length s - 1 and m = String.length t in
+  m < n && s.[n] = '_' && same_prefix s t m && skip_digits s m = n
+
+let perm_tag = "_perm_Hyp_"
+let _ = add_internal_name (is_tagged perm_tag)
+let mk_perm_id =
+  let salt = ref 1 in 
+  fun () -> salt := !salt mod 10000 + 1; mk_tagged_id perm_tag !salt
+
+let evar_tag = "_evar_"
+let _ = add_internal_name (is_tagged evar_tag)
+let mk_evar_name n = Name (mk_tagged_id evar_tag n)
+let nb_evar_deps = function
+  | Name id ->
+    let s = string_of_id id in
+    if not (is_tagged evar_tag s) then 0 else
+    let m = String.length evar_tag in
+    (try int_of_string (String.sub s m (String.length s - 1 - m)) with _ -> 0)
+  | _ -> 0
+
+let discharged_tag = "_discharged_"
+let mk_discharged_id id =
+  id_of_string (sprintf "%s%s_" discharged_tag (string_of_id id))
+let has_discharged_tag s =
+  let m = String.length discharged_tag and n = String.length s - 1 in
+  m < n && s.[n] = '_' && same_prefix s discharged_tag m
+let _ = add_internal_name has_discharged_tag
+let is_discharged_id id = has_discharged_tag (string_of_id id)
+
+let wildcard_tag = "_the_"
+let wildcard_post = "_wildcard_"
+let mk_wildcard_id i =
+  id_of_string (sprintf "%s%s%s" wildcard_tag (String.ordinal i) wildcard_post)
+let has_wildcard_tag s = 
+  let n = String.length s in let m = String.length wildcard_tag in
+  let m' = String.length wildcard_post in
+  n < m + m' + 2 && same_prefix s wildcard_tag m &&
+  String.sub s (n - m') m' = wildcard_post &&
+  skip_digits s m = n - m' - 2
+let _ = add_internal_name has_wildcard_tag
+
+let max_suffix m (t, j0 as tj0) id  =
+  let s = string_of_id id in let n = String.length s - 1 in
+  let dn = String.length t - 1 - n in let i0 = j0 - dn in
+  if not (i0 >= m && s.[n] = '_' && same_prefix s t m) then tj0 else
+  let rec loop i =
+    if i < i0 && s.[i] = '0' then loop (i + 1) else
+    if (if i < i0 then skip_digits s i = n else le_s_t i) then s, i else tj0
+  and le_s_t i =
+    let ds = s.[i] and dt = t.[i + dn] in
+    if ds = dt then i = n || le_s_t (i + 1) else
+    dt < ds && skip_digits s i = n in
+  loop m
+
+let mk_anon_id t gl =
+  let m, si0, id0 =
+    let s = ref (sprintf  "_%s_" t) in
+    if is_internal_name !s then s := "_" ^ !s;
+    let n = String.length !s - 1 in
+    let rec loop i j =
+      let d = !s.[i] in if not (is_digit d) then i + 1, j else
+      loop (i - 1) (if d = '0' then j else i) in
+    let m, j = loop (n - 1) n in m, (!s, j), id_of_string !s in
+  let gl_ids = pf_ids_of_hyps gl in
+  if not (List.mem id0 gl_ids) then id0 else
+  let s, i = List.fold_left (max_suffix m) si0 gl_ids in
+  let n = String.length s - 1 in
+  let rec loop i =
+    if s.[i] = '9' then (s.[i] <- '0'; loop (i - 1)) else
+    if i < m then (s.[n] <- '0'; s.[m] <- '1'; s ^ "_") else
+    (s.[i] <- Char.chr (Char.code s.[i] + 1); s) in
+  id_of_string (loop (n - 1))
+  
+(* We must not anonymize context names discharged by the "in" tactical. *)
+
+let ssr_anon_hyp = "Hyp"
+
+let anontac decl gl =
+  let id =  match RelDecl.get_name decl with
+  | Name id ->
+    if is_discharged_id id then id else mk_anon_id (string_of_id id) gl
+  | _ -> mk_anon_id ssr_anon_hyp gl in
+  introid id gl
+
+let rec constr_name c = match kind_of_term c with
+  | Var id -> Name id
+  | Cast (c', _, _) -> constr_name c'
+  | Const (cn,_) -> Name (id_of_label (con_label cn))
+  | App (c', _) -> constr_name c'
+  | _ -> Anonymous
+
+(* }}} *)
+
+(** Open term to lambda-term coercion  {{{ ************************************)
+
+(* This operation takes a goal gl and an open term (sigma, t), and   *)
+(* returns a term t' where all the new evars in sigma are abstracted *)
+(* with the mkAbs argument, i.e., for mkAbs = mkLambda then there is *)
+(* some duplicate-free array args of evars of sigma such that the    *)
+(* term mkApp (t', args) is convertible to t.                        *)
+(* This makes a useful shorthand for local definitions in proofs,    *)
+(* i.e., pose succ := _ + 1 means pose succ := fun n : nat => n + 1, *)
+(* and, in context of the the 4CT library, pose mid := maps id means *)
+(*    pose mid := fun d : detaSet => @maps d d (@id (datum d))       *)
+(* Note that this facility does not extend to set, which tries       *)
+(* instead to fill holes by matching a goal subterm.                 *)
+(* The argument to "have" et al. uses product abstraction, e.g.      *)
+(*    have Hmid: forall s, (maps id s) = s.                          *)
+(* stands for                                                        *)
+(*    have Hmid: forall (d : dataSet) (s : seq d), (maps id s) = s.  *)
+(* We also use this feature for rewrite rules, so that, e.g.,        *)
+(*   rewrite: (plus_assoc _ 3).                                      *)
+(* will execute as                                                   *)
+(*   rewrite (fun n => plus_assoc n 3)                               *)
+(* i.e., it will rewrite some subterm .. + (3 + ..) to .. + 3 + ...  *)
+(* The convention is also used for the argument of the congr tactic, *)
+(* e.g., congr (x + _ * 1).                                          *)
+
+(* Replace new evars with lambda variables, retaining local dependencies *)
+(* but stripping global ones. We use the variable names to encode the    *)
+(* the number of dependencies, so that the transformation is reversible. *)
+
+let pf_abs_evars gl (sigma, c0) =
+  let sigma0, ucst = project gl, Evd.evar_universe_context sigma in
+  let nenv = env_size (pf_env gl) in
+  let abs_evar n k =
+    let evi = Evd.find sigma k in
+    let dc = List.firstn n (evar_filtered_context evi) in
+    let abs_dc c decl = match NamedDecl.to_tuple decl with
+    | x, Some b, t -> mkNamedLetIn x b t (mkArrow t c)
+    | x, None, t -> mkNamedProd x t c in
+    let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
+    Evarutil.nf_evar sigma t in
+  let rec put evlist c = match kind_of_term c with
+  | Evar (k, a) ->  
+    if List.mem_assoc k evlist || Evd.mem sigma0 k then evlist else
+    let n = max 0 (Array.length a - nenv) in
+    let t = abs_evar n k in (k, (n, t)) :: put evlist t
+  | _ -> fold_constr put evlist c in
+  let evlist = put [] c0 in
+  if evlist = [] then 0, c0,[], ucst else
+  let rec lookup k i = function
+    | [] -> 0, 0
+    | (k', (n, _)) :: evl -> if k = k' then i, n else lookup k (i + 1) evl in
+  let rec get i c = match kind_of_term c with
+  | Evar (ev, a) ->
+    let j, n = lookup ev i evlist in
+    if j = 0 then map_constr (get i) c else if n = 0 then mkRel j else
+    mkApp (mkRel j, Array.init n (fun k -> get i a.(n - 1 - k)))
+  | _ -> map_constr_with_binders ((+) 1) get i c in
+  let rec loop c i = function
+  | (_, (n, t)) :: evl ->
+    loop (mkLambda (mk_evar_name n, get (i - 1) t, c)) (i - 1) evl
+  | [] -> c in
+  List.length evlist, loop (get 1 c0) 1 evlist, List.map fst evlist, ucst
+
+
+
+(* As before but if (?i : T(?j)) and (?j : P : Prop), then the lambda for i
+ * looks like (fun evar_i : (forall pi : P. T(pi))) thanks to "loopP" and all 
+ * occurrences of evar_i are replaced by (evar_i evar_j) thanks to "app".
+ *
+ * If P can be solved by ssrautoprop (that defaults to trivial), then
+ * the corresponding lambda looks like (fun evar_i : T(c)) where c is 
+ * the solution found by ssrautoprop.
+ *)
+let ssrautoprop_tac = ref (fun gl -> assert false)
+
+(* Thanks to Arnaud Spiwack for this snippet *)
+let call_on_evar tac e s =
+  let { it = gs ; sigma = s } =
+    tac { it = e ; sigma = s; } in
+  gs, s
+
+let pf_abs_evars_pirrel gl (sigma, c0) =
+  pp(lazy(str"==PF_ABS_EVARS_PIRREL=="));
+  pp(lazy(str"c0= " ++ pr_constr c0));
+  let sigma0 = project gl in
+  let c0 = Evarutil.nf_evar sigma0 (Evarutil.nf_evar sigma c0) in
+  let nenv = env_size (pf_env gl) in
+  let abs_evar n k =
+    let evi = Evd.find sigma k in
+    let dc = List.firstn n (evar_filtered_context evi) in
+    let abs_dc c decl = match NamedDecl.to_tuple decl with
+    | x, Some b, t -> mkNamedLetIn x b t (mkArrow t c)
+    | x, None, t -> mkNamedProd x t c in
+    let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
+    Evarutil.nf_evar sigma0 (Evarutil.nf_evar sigma t) in
+  let rec put evlist c = match kind_of_term c with
+  | Evar (k, a) ->  
+    if List.mem_assoc k evlist || Evd.mem sigma0 k then evlist else
+    let n = max 0 (Array.length a - nenv) in
+    let k_ty = 
+      Retyping.get_sort_family_of 
+        (pf_env gl) sigma (Evd.evar_concl (Evd.find sigma k)) in
+    let is_prop = k_ty = InProp in
+    let t = abs_evar n k in (k, (n, t, is_prop)) :: put evlist t
+  | _ -> fold_constr put evlist c in
+  let evlist = put [] c0 in
+  if evlist = [] then 0, c0 else
+  let pr_constr t = pr_constr (Reductionops.nf_beta (project gl) t) in
+  pp(lazy(str"evlist=" ++ pr_list (fun () -> str";")
+    (fun (k,_) -> str(Evd.string_of_existential k)) evlist));
+  let evplist = 
+    let depev = List.fold_left (fun evs (_,(_,t,_)) -> 
+        Intset.union evs (Evarutil.undefined_evars_of_term sigma t)) Intset.empty evlist in
+    List.filter (fun (i,(_,_,b)) -> b && Intset.mem i depev) evlist in
+  let evlist, evplist, sigma = 
+    if evplist = [] then evlist, [], sigma else
+    List.fold_left (fun (ev, evp, sigma) (i, (_,t,_) as p) ->
+      try 
+        let ng, sigma = call_on_evar !ssrautoprop_tac i sigma in
+        if (ng <> []) then errorstrm (str "Should we tell the user?");
+        List.filter (fun (j,_) -> j <> i) ev, evp, sigma
+      with _ -> ev, p::evp, sigma) (evlist, [], sigma) (List.rev evplist) in
+  let c0 = Evarutil.nf_evar sigma c0 in
+  let evlist = 
+    List.map (fun (x,(y,t,z)) -> x,(y,Evarutil.nf_evar sigma t,z)) evlist in
+  let evplist = 
+    List.map (fun (x,(y,t,z)) -> x,(y,Evarutil.nf_evar sigma t,z)) evplist in
+  pp(lazy(str"c0= " ++ pr_constr c0));
+  let rec lookup k i = function
+    | [] -> 0, 0
+    | (k', (n,_,_)) :: evl -> if k = k' then i,n else lookup k (i + 1) evl in
+  let rec get evlist i c = match kind_of_term c with
+  | Evar (ev, a) ->
+    let j, n = lookup ev i evlist in
+    if j = 0 then map_constr (get evlist i) c else if n = 0 then mkRel j else
+    mkApp (mkRel j, Array.init n (fun k -> get evlist i a.(n - 1 - k)))
+  | _ -> map_constr_with_binders ((+) 1) (get evlist) i c in
+  let rec app extra_args i c = match decompose_app c with
+  | hd, args when isRel hd && destRel hd = i ->
+      let j = destRel hd in
+      mkApp (mkRel j, Array.of_list (List.map (lift (i-1)) extra_args @ args))
+  | _ -> map_constr_with_binders ((+) 1) (app extra_args) i c in
+  let rec loopP evlist c i = function
+  | (_, (n, t, _)) :: evl ->
+    let t = get evlist (i - 1) t in
+    let n = Name (id_of_string (ssr_anon_hyp ^ string_of_int n)) in 
+    loopP evlist (mkProd (n, t, c)) (i - 1) evl
+  | [] -> c in
+  let rec loop c i = function
+  | (_, (n, t, _)) :: evl ->
+    let evs = Evarutil.undefined_evars_of_term sigma t in
+    let t_evplist = List.filter (fun (k,_) -> Intset.mem k evs) evplist in
+    let t = loopP t_evplist (get t_evplist 1 t) 1 t_evplist in
+    let t = get evlist (i - 1) t in
+    let extra_args = 
+      List.map (fun (k,_) -> mkRel (fst (lookup k i evlist))) 
+        (List.rev t_evplist) in
+    let c = if extra_args = [] then c else app extra_args 1 c in
+    loop (mkLambda (mk_evar_name n, t, c)) (i - 1) evl
+  | [] -> c in
+  let res = loop (get evlist 1 c0) 1 evlist in
+  pp(lazy(str"res= " ++ pr_constr res));
+  List.length evlist, res
+
+(* Strip all non-essential dependencies from an abstracted term, generating *)
+(* standard names for the abstracted holes.                                 *)
+
+let pf_abs_cterm gl n c0 =
+  if n <= 0 then c0 else
+  let noargs = [|0|] in
+  let eva = Array.make n noargs in
+  let rec strip i c = match kind_of_term c with
+  | App (f, a) when isRel f ->
+    let j = i - destRel f in
+    if j >= n || eva.(j) = noargs then mkApp (f, Array.map (strip i) a) else
+    let dp = eva.(j) in
+    let nd = Array.length dp - 1 in
+    let mkarg k = strip i a.(if k < nd then dp.(k + 1) - j else k + dp.(0)) in
+    mkApp (f, Array.init (Array.length a - dp.(0)) mkarg)
+  | _ -> map_constr_with_binders ((+) 1) strip i c in
+  let rec strip_ndeps j i c = match kind_of_term c with
+  | Prod (x, t, c1) when i < j ->
+    let dl, c2 = strip_ndeps j (i + 1) c1 in
+    if noccurn 1 c2 then dl, lift (-1) c2 else
+    i :: dl, mkProd (x, strip i t, c2)
+  | LetIn (x, b, t, c1) when i < j ->
+    let _, _, c1' = destProd c1 in
+    let dl, c2 = strip_ndeps j (i + 1) c1' in
+    if noccurn 1 c2 then dl, lift (-1) c2 else
+    i :: dl, mkLetIn (x, strip i b, strip i t, c2)
+  | _ -> [], strip i c in
+  let rec strip_evars i c = match kind_of_term c with
+    | Lambda (x, t1, c1) when i < n ->
+      let na = nb_evar_deps x in
+      let dl, t2 = strip_ndeps (i + na) i t1 in
+      let na' = List.length dl in
+      eva.(i) <- Array.of_list (na - na' :: dl);
+      let x' =
+        if na' = 0 then Name (pf_type_id gl t2) else mk_evar_name na' in
+      mkLambda (x', t2, strip_evars (i + 1) c1)
+(*      if noccurn 1 c2 then lift (-1) c2 else
+      mkLambda (Name (pf_type_id gl t2), t2, c2) *)
+    | _ -> strip i c in
+  strip_evars 0 c0
+
+(* Undo the evar abstractions. Also works for non-evar variables. *)
+
+let pf_unabs_evars gl ise n c0 =
+  if n = 0 then c0 else
+  let evv = Array.make n mkProp in
+  let nev = ref 0 in
+  let env0 = pf_env gl in
+  let nenv0 = env_size env0 in
+  let rec unabs i c = match kind_of_term c with
+  | Rel j when i - j < !nev -> evv.(i - j)
+  | App (f, a0) when isRel f ->
+    let a = Array.map (unabs i) a0 in
+    let j = i - destRel f in
+    if j >= !nev then mkApp (f, a) else
+    let ev, eva = destEvar evv.(j) in
+    let nd = Array.length eva - nenv0 in
+    if nd = 0 then mkApp (evv.(j), a) else
+    let evarg k = if k < nd then a.(nd - 1 - k) else eva.(k) in
+    let c' = mkEvar (ev, Array.init (nd + nenv0) evarg) in
+    let na = Array.length a - nd in
+    if na = 0 then c' else mkApp (c', Array.sub a nd na)
+  | _ -> map_constr_with_binders ((+) 1) unabs i c in
+  let push_rel = Environ.push_rel in
+  let rec mk_evar j env i c = match kind_of_term c with
+  | Prod (x, t, c1) when i < j ->
+    mk_evar j (push_rel (RelDecl.LocalAssum (x, unabs i t)) env) (i + 1) c1
+  | LetIn (x, b, t, c1) when i < j ->
+    let _, _, c2 = destProd c1 in
+    mk_evar j (push_rel (RelDecl.LocalDef (x, unabs i b, unabs i t)) env) (i + 1) c2
+  | _ -> Evarutil.e_new_evar env ise (unabs i c) in
+  let rec unabs_evars c =
+    if !nev = n then unabs n c else match kind_of_term c with
+  | Lambda (x, t, c1) when !nev < n ->
+    let i = !nev in
+    evv.(i) <- mk_evar (i + nb_evar_deps x) env0 i t;
+    incr nev; unabs_evars c1
+  | _ -> unabs !nev c in
+  unabs_evars c0
+
+(* }}} *)
+
+(** Tactical extensions. {{{ **************************************************)
+
+(* The TACTIC EXTEND facility can't be used for defining new user   *)
+(* tacticals, because:                                              *)
+(*  - the concrete syntax must start with a fixed string            *)
+(*   We use the following workaround:                               *)
+(*  - We use the (unparsable) "YouShouldNotTypeThis"  token for tacticals that      *)
+(*    don't start with a token, then redefine the grammar and       *)
+(*    printer using GEXTEND and set_pr_ssrtac, respectively.        *)
+
+type ssrargfmt = ArgSsr of string | ArgCoq of argument_type | ArgSep of string
+
+let ssrtac_name name = {
+  mltac_plugin = "ssreflect_plugin";
+  mltac_tactic = "ssr" ^ name;
+}
+
+let ssrtac_entry name n = {
+  mltac_name = ssrtac_name name; 
+  mltac_index = n;
+}
+
+let set_pr_ssrtac name prec afmt =
+  let fmt = List.map (function
+    | ArgSep s -> Egramml.GramTerminal s
+    | ArgSsr s -> Egramml.GramTerminal s
+    | ArgCoq at -> Egramml.GramTerminal "COQ_ARG") afmt in
+  let tacname = ssrtac_name name in ()
+
+let ssrtac_atom loc name args = TacML (loc, ssrtac_entry name 0, args)
+let ssrtac_expr = ssrtac_atom
+
+
+let ssrevaltac ist gtac =
+  Proofview.V82.of_tactic (tactic_of_value ist gtac)
+
+(* fun gl -> let lfun = [tacarg_id, val_interp ist gl gtac] in
+  interp_tac_gen lfun [] ist.debug tacarg_expr gl *)
+
+(** Generic argument-based globbing/typing utilities *)
+
+let of_ftactic ftac gl =
+  let r = ref None in
+  let tac = Ftactic.run ftac (fun ans -> r := Some ans; Proofview.tclUNIT ()) in
+  let tac = Proofview.V82.of_tactic tac in
+  let { sigma = sigma } = tac gl in
+  let ans = match !r with
+  | None -> assert false (** If the tactic failed we should not reach this point *)
+  | Some ans -> ans
+  in
+  (sigma, ans)
+
+let interp_wit wit ist gl x = 
+  let globarg = in_gen (glbwit wit) x in
+  let arg = interp_genarg ist globarg in
+  let (sigma, arg) = of_ftactic arg gl in
+  sigma, Value.cast (topwit wit) arg
+
+let interp_intro_pattern = interp_wit wit_intro_pattern
+
+let interp_constr = interp_wit wit_constr
+
+let interp_open_constr ist gl gc =
+  let (sigma, (c, _)) = Tacinterp.interp_open_constr_with_bindings ist (pf_env gl) (project gl) (gc, NoBindings) in
+  (project gl, (sigma, c))
+
+let interp_refine ist gl rc =
+  let constrvars = extract_ltac_constr_values ist (pf_env gl) in
+  let vars = { Pretyping.empty_lvar with
+    Pretyping.ltac_constrs = constrvars; ltac_genargs = ist.lfun
+  } in
+  let kind = OfType (pf_concl gl) in
+  let flags = {
+    use_typeclasses = true;
+    solve_unification_constraints = true;
+    use_hook = None;
+    fail_evar = false;
+    expand_evars = true }
+  in
+  let sigma, c = understand_ltac flags (pf_env gl) (project gl) vars kind rc in
+(*   pp(lazy(str"sigma@interp_refine=" ++ pr_evar_map None sigma)); *)
+  pp(lazy(str"c@interp_refine=" ++ pr_constr c));
+  (sigma, (sigma, c))
+
+let pf_match = pf_apply (fun e s c t -> understand_tcc e s ~expected_type:t c)
+
+(* Estimate a bound on the number of arguments of a raw constr. *)
+(* This is not perfect, because the unifier may fail to         *)
+(* typecheck the partial application, so we use a minimum of 5. *)
+(* Also, we don't handle delayed or iterated coercions to       *)
+(* FUNCLASS, which is probably just as well since these can     *)
+(* lead to infinite arities.                                    *)
+
+let splay_open_constr gl (sigma, c) =
+  let env = pf_env gl in let t = Retyping.get_type_of env sigma c in
+  Reductionops.splay_prod env sigma t
+
+let nbargs_open_constr gl oc =
+  let pl, _ = splay_open_constr gl oc in List.length pl
+
+let interp_nbargs ist gl rc =
+  try
+    let rc6 = mkRApp rc (mkRHoles 6) in
+    let sigma, t = interp_open_constr ist gl (rc6, None) in
+    let si = sig_it gl in
+    let gl = re_sig si sigma in
+    6 + nbargs_open_constr gl t
+  with _ -> 5
+
+let pf_nbargs gl c = nbargs_open_constr gl (project gl, c)
+
+let isAppInd gl c =
+  try ignore (pf_reduce_to_atomic_ind gl c); true with _ -> false
+
+let interp_view_nbimps ist gl rc =
+  try
+    let sigma, t = interp_open_constr ist gl (rc, None) in
+    let si = sig_it gl in
+    let gl = re_sig si sigma in
+    let pl, c = splay_open_constr gl t in
+    if isAppInd gl c then List.length pl else ~-(List.length pl)
+  with _ -> 0
+
+(* }}} *)
+
+(** Vernacular commands: Prenex Implicits and Search {{{ **********************)
+
+(* This should really be implemented as an extension to the implicit   *)
+(* arguments feature, but unfortuately that API is sealed. The current *)
+(* workaround uses a combination of notations that works reasonably,   *)
+(* with the following caveats:                                         *)
+(*  - The pretty-printing always elides prenex implicits, even when    *)
+(*    they are obviously needed.                                       *)
+(*  - Prenex Implicits are NEVER exported from a module, because this  *)
+(*    would lead to faulty pretty-printing and scoping errors.         *)
+(*  - The command "Import Prenex Implicits" can be used to reassert    *)
+(*    Prenex Implicits for all the visible constants that had been     *)
+(*    declared as Prenex Implicits.                                    *)
+
+let declare_one_prenex_implicit locality f =
+  let fref =
+    try Smartlocate.global_with_alias f 
+    with _ -> errorstrm (pr_reference f ++ str " is not declared") in
+  let rec loop = function
+  | a :: args' when Impargs.is_status_implicit a ->
+    (ExplByName (Impargs.name_of_implicit a), (true, true, true)) :: loop args'
+  | args' when List.exists Impargs.is_status_implicit args' ->
+      errorstrm (str "Expected prenex implicits for " ++ pr_reference f)
+  | _ -> [] in
+  let impls =
+    match Impargs.implicits_of_global fref  with
+    | [cond,impls] -> impls
+    | [] -> errorstrm (str "Expected some implicits for " ++ pr_reference f)
+    | _ -> errorstrm (str "Multiple implicits not supported") in
+  match loop impls  with
+  | [] ->
+    errorstrm (str "Expected some implicits for " ++ pr_reference f)
+  | impls ->
+    Impargs.declare_manual_implicits locality fref ~enriching:false [impls]
+
+VERNAC COMMAND EXTEND Ssrpreneximplicits CLASSIFIED AS SIDEFF
+  | [ "Prenex" "Implicits" ne_global_list(fl) ]
+  -> [ let locality =
+         Locality.make_section_locality (Locality.LocalityFixme.consume ()) in
+       List.iter (declare_one_prenex_implicit locality) fl ]
+END
+
+(* Vernac grammar visibility patch *)
+
+GEXTEND Gram
+  GLOBAL: gallina_ext;
+  gallina_ext:
+   [ [ IDENT "Import"; IDENT "Prenex"; IDENT "Implicits" ->
+      Vernacexpr.VernacUnsetOption (["Printing"; "Implicit"; "Defensive"])
+   ] ]
+  ;
+END
+
+(** Extend Search to subsume SearchAbout, also adding hidden Type coercions. *)
+
+(* Main prefilter *)
+
+type raw_glob_search_about_item =
+  | RGlobSearchSubPattern of constr_expr
+  | RGlobSearchString of Loc.t * string * string option
+
+let pr_search_item = function
+  | RGlobSearchString (_,s,_) -> str s
+  | RGlobSearchSubPattern p -> pr_constr_expr p
+
+let wit_ssr_searchitem = add_genarg "ssr_searchitem" pr_search_item
+
+let interp_search_notation loc s opt_scope =
+  try
+    let interp = Notation.interp_notation_as_global_reference loc in
+    let ref = interp (fun _ -> true) s opt_scope in
+    Search.GlobSearchSubPattern (Pattern.PRef ref)
+  with _ ->
+    let diagnosis =
+      try
+        let ntns = Notation.locate_notation pr_glob_constr s opt_scope in
+        let ambig = "This string refers to a complex or ambiguous notation." in
+        str ambig ++ str "\nTry searching with one of\n" ++ ntns
+      with _ -> str "This string is not part of an identifier or notation." in
+    CErrors.user_err_loc (loc, "interp_search_notation", diagnosis)
+
+let pr_ssr_search_item _ _ _ = pr_search_item
+
+(* Workaround the notation API that can only print notations *)
+
+let is_ident s = try CLexer.check_ident s; true with _ -> false
+
+let is_ident_part s = is_ident ("H" ^ s)
+
+let interp_search_notation loc tag okey =
+  let err msg = CErrors.user_err_loc (loc, "interp_search_notation", msg) in
+  let mk_pntn s for_key =
+    let n = String.length s in
+    let s' = String.make (n + 2) ' ' in
+    let rec loop i i' =
+      if i >= n then s', i' - 2 else if s.[i] = ' ' then loop (i + 1) i' else
+      let j = try String.index_from s (i + 1) ' ' with _ -> n in
+      let m = j - i in
+      if s.[i] = '\'' && i < j - 2 && s.[j - 1] = '\'' then
+        (String.blit s (i + 1) s' i' (m - 2); loop (j + 1) (i' + m - 1))
+      else if for_key && is_ident (String.sub s i m) then
+         (s'.[i'] <- '_'; loop (j + 1) (i' + 2))
+      else (String.blit s i s' i' m; loop (j + 1) (i' + m + 1)) in
+    loop 0 1 in
+  let trim_ntn (pntn, m) = String.sub pntn 1 (max 0 m) in
+  let pr_ntn ntn = str "(" ++ str ntn ++ str ")" in
+  let pr_and_list pr = function
+    | [x] -> pr x
+    | x :: lx -> pr_list pr_comma pr lx ++ pr_comma () ++ str "and " ++ pr x
+    | [] -> mt () in
+  let pr_sc sc = str (if sc = "" then "independently" else sc) in
+  let pr_scs = function
+    | [""] -> pr_sc ""
+    | scs -> str "in " ++ pr_and_list pr_sc scs in
+  let generator, pr_tag_sc =
+    let ign _ = mt () in match okey with
+  | Some key ->
+    let sc = Notation.find_delimiters_scope loc key in
+    let pr_sc s_in = str s_in ++ spc() ++ str sc ++ pr_comma() in
+    Notation.pr_scope ign sc, pr_sc
+  | None -> Notation.pr_scopes ign, ign in
+  let qtag s_in = pr_tag_sc s_in ++ qstring tag ++ spc()in
+  let ptag, ttag =
+    let ptag, m = mk_pntn tag false in
+    if m <= 0 then err (str "empty notation fragment");
+    ptag, trim_ntn (ptag, m) in
+  let last = ref "" and last_sc = ref "" in
+  let scs = ref [] and ntns = ref [] in
+  let push_sc sc = match !scs with
+  | "" :: scs' ->  scs := "" :: sc :: scs'
+  | scs' -> scs := sc :: scs' in
+  let get s _ _ = match !last with
+  | "Scope " -> last_sc := s; last := ""
+  | "Lonely notation" -> last_sc := ""; last := ""
+  | "\"" ->
+      let pntn, m = mk_pntn s true in
+      if String.string_contains pntn ptag then begin
+        let ntn = trim_ntn (pntn, m) in
+        match !ntns with
+        | [] -> ntns := [ntn]; scs := [!last_sc]
+        | ntn' :: _ when ntn' = ntn -> push_sc !last_sc
+        | _ when ntn = ttag -> ntns := ntn :: !ntns; scs := [!last_sc]
+        | _ :: ntns' when List.mem ntn ntns' -> ()
+        | ntn' :: ntns' -> ntns := ntn' :: ntn :: ntns'
+      end;
+      last := ""
+  | _ -> last := s in
+  pp_with (Format.make_formatter get (fun _ -> ())) generator;
+  let ntn = match !ntns with
+  | [] ->
+    err (hov 0 (qtag "in" ++ str "does not occur in any notation"))
+  | ntn :: ntns' when ntn = ttag ->
+    if ntns' <> [] then begin
+      let pr_ntns' = pr_and_list pr_ntn ntns' in
+      msg_warning (hov 4 (qtag "In" ++ str "also occurs in " ++ pr_ntns'))
+    end; ntn
+  | [ntn] ->
+    msgnl (hov 4 (qtag "In" ++ str "is part of notation " ++ pr_ntn ntn)); ntn
+  | ntns' ->
+    let e = str "occurs in" ++ spc() ++ pr_and_list pr_ntn ntns' in
+    err (hov 4 (str "ambiguous: " ++ qtag "in" ++ e)) in
+  let (nvars, body), ((_, pat), osc) = match !scs with
+  | [sc] -> Notation.interp_notation loc ntn (None, [sc])
+  | scs' ->
+    try Notation.interp_notation loc ntn (None, []) with _ ->
+    let e = pr_ntn ntn ++ spc() ++ str "is defined " ++ pr_scs scs' in
+    err (hov 4 (str "ambiguous: " ++ pr_tag_sc "in" ++ e)) in
+  let sc = Option.default "" osc in
+  let _ =
+    let m_sc =
+      if osc <> None then str "In " ++ str sc ++ pr_comma() else mt() in
+    let ntn_pat = trim_ntn (mk_pntn pat false) in
+    let rbody = glob_constr_of_notation_constr loc body in
+    let m_body = hov 0 (Constrextern.without_symbols prl_glob_constr rbody) in
+    let m = m_sc ++ pr_ntn ntn_pat ++ spc () ++ str "denotes " ++ m_body in
+    msgnl (hov 0 m) in
+  if List.length !scs > 1 then
+    let scs' = List.remove (=) sc !scs in
+    let w = pr_ntn ntn ++ str " is also defined " ++ pr_scs scs' in
+    msg_warning (hov 4 w)
+  else if String.string_contains ntn " .. " then
+    err (pr_ntn ntn ++ str " is an n-ary notation");
+  let nvars = List.filter (fun (_,(_,typ)) -> typ = NtnTypeConstr) nvars in
+  let rec sub () = function
+  | NVar x when List.mem_assoc x nvars -> GPatVar (loc, (false, x))
+  | c ->
+    glob_constr_of_notation_constr_with_binders loc (fun _ x -> (), x) sub () c in
+  let _, npat = Patternops.pattern_of_glob_constr (sub () body) in
+  Search.GlobSearchSubPattern npat
+
+ARGUMENT EXTEND ssr_search_item TYPED AS ssr_searchitem
+  PRINTED BY pr_ssr_search_item
+  | [ string(s) ] -> [ RGlobSearchString (loc,s,None) ]
+  | [ string(s) "%" preident(key) ] -> [ RGlobSearchString (loc,s,Some key) ]
+  | [ constr_pattern(p) ] -> [ RGlobSearchSubPattern p ]
+END
+
+let pr_ssr_search_arg _ _ _ =
+  let pr_item (b, p) = str (if b then "-" else "") ++ pr_search_item p in
+  pr_list spc pr_item
+
+ARGUMENT EXTEND ssr_search_arg TYPED AS (bool * ssr_searchitem) list
+  PRINTED BY pr_ssr_search_arg
+  | [ "-" ssr_search_item(p) ssr_search_arg(a) ] -> [ (false, p) :: a ]
+  | [ ssr_search_item(p) ssr_search_arg(a) ] -> [ (true, p) :: a ]
+  | [ ] -> [ [] ]
+END
+
+(* Main type conclusion pattern filter *)
+
+let rec splay_search_pattern na = function 
+  | Pattern.PApp (fp, args) -> splay_search_pattern (na + Array.length args) fp
+  | Pattern.PLetIn (_, _, bp) -> splay_search_pattern na bp
+  | Pattern.PRef hr -> hr, na
+  | _ -> CErrors.error "no head constant in head search pattern"
+
+let coerce_search_pattern_to_sort hpat =
+  let env = Global.env () and sigma = Evd.empty in
+  let mkPApp fp n_imps args =
+    let args' = Array.append (Array.make n_imps (Pattern.PMeta None)) args in
+    Pattern.PApp (fp, args') in
+  let hr, na = splay_search_pattern 0 hpat in
+  let dc, ht =
+    Reductionops.splay_prod env sigma (Universes.unsafe_type_of_global hr) in
+  let np = List.length dc in
+  if np < na then CErrors.error "too many arguments in head search pattern" else
+  let hpat' = if np = na then hpat else mkPApp hpat (np - na) [||] in
+  let warn () =
+    msg_warning (str "Listing only lemmas with conclusion matching " ++ 
+      pr_constr_pattern hpat') in
+  if isSort ht then begin warn (); true, hpat' end else
+  let filter_head, coe_path =
+    try 
+      let _, cp =
+        Classops.lookup_path_to_sort_from (push_rels_assum dc env) sigma ht in
+      warn ();
+      true, cp
+    with _ -> false, [] in
+  let coerce hp coe_index =
+    let coe = Classops.get_coercion_value coe_index in
+    try
+      let coe_ref = reference_of_constr coe in
+      let n_imps = Option.get (Classops.hide_coercion coe_ref) in
+      mkPApp (Pattern.PRef coe_ref) n_imps [|hp|]
+    with _ ->
+    errorstrm (str "need explicit coercion " ++ pr_constr coe ++ spc ()
+            ++ str "to interpret head search pattern as type") in
+  filter_head, List.fold_left coerce hpat' coe_path
+
+let rec interp_head_pat hpat =
+  let filter_head, p = coerce_search_pattern_to_sort hpat in
+  let rec loop c = match kind_of_term c with
+  | Cast (c', _, _) -> loop c'
+  | Prod (_, _, c') -> loop c'
+  | LetIn (_, _, _, c') -> loop c'
+  | _ -> Constr_matching.is_matching (Global.env()) Evd.empty p c in
+  filter_head, loop
+
+let all_true _ = true
+
+let rec interp_search_about args accu = match args with
+| [] -> accu
+| (flag, arg) :: rem ->
+  fun gr env typ ->
+    let ans = Search.search_about_filter arg gr env typ in
+    (if flag then ans else not ans) && interp_search_about rem accu gr env typ
+
+let interp_search_arg arg =
+  let arg = List.map (fun (x,arg) -> x, match arg with
+  | RGlobSearchString (loc,s,key) ->
+      if is_ident_part s then Search.GlobSearchString s else
+      interp_search_notation loc s key
+  | RGlobSearchSubPattern p ->
+      try
+        let intern = Constrintern.intern_constr_pattern in 
+        Search.GlobSearchSubPattern (snd (intern (Global.env()) p))
+      with e -> let e = CErrors.push e in iraise (ExplainErr.process_vernac_interp_error e)) arg in
+  let hpat, a1 = match arg with
+  | (_, Search.GlobSearchSubPattern (Pattern.PMeta _)) :: a' -> all_true, a'
+  | (true, Search.GlobSearchSubPattern p) :: a' ->
+     let filter_head, p = interp_head_pat p in
+     if filter_head then p, a' else all_true, arg
+  | _ -> all_true, arg in
+  let is_string =
+    function (_, Search.GlobSearchString _) -> true | _ -> false in
+  let a2, a3 = List.partition is_string a1 in
+  interp_search_about (a2 @ a3) (fun gr env typ -> hpat typ)
+
+(* Module path postfilter *)
+
+let pr_modloc (b, m) = if b then str "-" ++ pr_reference m else pr_reference m
+
+let wit_ssrmodloc = add_genarg "ssrmodloc" pr_modloc
+
+let pr_ssr_modlocs _ _ _ ml =
+  if ml = [] then str "" else spc () ++ str "in " ++ pr_list spc pr_modloc ml
+
+ARGUMENT EXTEND ssr_modlocs TYPED AS ssrmodloc list PRINTED BY pr_ssr_modlocs
+  | [ ] -> [ [] ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssr_modlocs;
+  modloc: [[ "-"; m = global -> true, m | m = global -> false, m]];
+  ssr_modlocs: [[ "in"; ml = LIST1 modloc -> ml ]];
+END
+
+let interp_modloc mr =
+  let interp_mod (_, mr) =
+    let (loc, qid) = qualid_of_reference mr in
+    try Nametab.full_name_module qid with Not_found ->
+    CErrors.user_err_loc (loc, "interp_modloc", str "No Module " ++ pr_qualid qid) in
+  let mr_out, mr_in = List.partition fst mr in
+  let interp_bmod b = function
+  | [] -> fun _ _ _ -> true
+  | rmods -> Search.module_filter (List.map interp_mod rmods, b) in
+  let is_in = interp_bmod false mr_in and is_out = interp_bmod true mr_out in
+  fun gr env typ -> is_in gr env typ && is_out gr env typ
+
+(* The unified, extended vernacular "Search" command *)
+
+let ssrdisplaysearch gr env t =
+  let pr_res = pr_global gr ++ str ":" ++ spc () ++ pr_lconstr_env env Evd.empty t in
+  msg_info (hov 2 pr_res ++ fnl ())
+
+VERNAC COMMAND EXTEND SsrSearchPattern CLASSIFIED AS QUERY
+| [ "Search" ssr_search_arg(a) ssr_modlocs(mr) ] ->
+  [ let hpat = interp_search_arg a in
+    let in_mod = interp_modloc mr in
+    let post_filter gr env typ = in_mod gr env typ && hpat gr env typ in
+    let display gr env typ =
+      if post_filter gr env typ then ssrdisplaysearch gr env typ
+    in
+    Search.generic_search None display ]
+END
+
+(* }}} *)
+
+(** Alternative notations for "match" and anonymous arguments. {{{ ************)
+
+(* Syntax:                                                        *)
+(*  if <term> is <pattern> then ... else ...                      *)
+(*  if <term> is <pattern> [in ..] return ... then ... else ...   *)
+(*  let: <pattern> := <term> in ...                               *)
+(*  let: <pattern> [in ...] := <term> return ... in ...           *)
+(* The scope of a top-level 'as' in the pattern extends over the  *)
+(* 'return' type (dependent if/let).                              *)
+(* Note that the optional "in ..." appears next to the <pattern>  *)
+(* rather than the <term> in then "let:" syntax. The alternative  *)
+(* would lead to ambiguities in, e.g.,                            *)
+(* let: p1 := (*v---INNER LET:---v *)                             *)
+(*   let: p2 := let: p3 := e3 in k return t in k2 in k1 return t' *)
+(* in b       (*^--ALTERNATIVE INNER LET--------^ *)              *)
+
+(* Caveat : There is no pretty-printing support, since this would *)
+(* require a modification to the Coq kernel (adding a new match   *)
+(* display style -- why aren't these strings?); also, the v8.1    *)
+(* pretty-printer only allows extension hooks for printing        *)
+(* integer or string literals.                                    *)
+(*   Also note that in the v8 grammar "is" needs to be a keyword; *)
+(* as this can't be done from an ML extension file, the new       *)
+(* syntax will only work when ssreflect.v is imported.            *)
+
+let no_ct = None, None and no_rt = None in 
+let aliasvar = function
+  | [_, [CPatAlias (loc, _, id)]] -> Some (loc,Name id)
+  | _ -> None in
+let mk_cnotype mp = aliasvar mp, None in
+let mk_ctype mp t = aliasvar mp, Some t in
+let mk_rtype t = Some t in
+let mk_dthen loc (mp, ct, rt) c = (loc, mp, c), ct, rt in
+let mk_let loc rt ct mp c1 =
+  CCases (loc, LetPatternStyle, rt, ct, [loc, mp, c1]) in
+let mk_pat c (na, t) = (c, na, t) in
+GEXTEND Gram
+  GLOBAL: binder_constr;
+  ssr_rtype: [[ "return"; t = operconstr LEVEL "100" -> mk_rtype t ]];
+  ssr_mpat: [[ p = pattern -> [!@loc, [p]] ]];
+  ssr_dpat: [
+    [ mp = ssr_mpat; "in"; t = pattern; rt = ssr_rtype -> mp, mk_ctype mp t, rt
+    | mp = ssr_mpat; rt = ssr_rtype -> mp, mk_cnotype mp, rt
+    | mp = ssr_mpat -> mp, no_ct, no_rt
+  ] ];
+  ssr_dthen: [[ dp = ssr_dpat; "then"; c = lconstr -> mk_dthen !@loc dp c ]];
+  ssr_elsepat: [[ "else" -> [!@loc, [CPatAtom (!@loc, None)]] ]];
+  ssr_else: [[ mp = ssr_elsepat; c = lconstr -> !@loc, mp, c ]];
+  binder_constr: [
+    [ "if"; c = operconstr LEVEL "200"; "is"; db1 = ssr_dthen; b2 = ssr_else ->
+      let b1, ct, rt = db1 in CCases (!@loc, MatchStyle, rt, [mk_pat c ct], [b1; b2])
+    | "if"; c = operconstr LEVEL "200";"isn't";db1 = ssr_dthen; b2 = ssr_else ->
+      let b1, ct, rt = db1 in 
+      let b1, b2 = 
+        let (l1, p1, r1), (l2, p2, r2) = b1, b2 in (l1, p1, r2), (l2, p2, r1) in
+      CCases (!@loc, MatchStyle, rt, [mk_pat c ct], [b1; b2])
+    | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr; "in"; c1 = lconstr ->
+      mk_let (!@loc) no_rt [mk_pat c no_ct] mp c1
+    | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr;
+      rt = ssr_rtype; "in"; c1 = lconstr ->
+      mk_let (!@loc) rt [mk_pat c (mk_cnotype mp)] mp c1
+    | "let"; ":"; mp = ssr_mpat; "in"; t = pattern; ":="; c = lconstr;
+      rt = ssr_rtype; "in"; c1 = lconstr ->
+      mk_let (!@loc) rt [mk_pat c (mk_ctype mp t)] mp c1
+  ] ];
+END
+
+GEXTEND Gram
+  GLOBAL: closed_binder;
+  closed_binder: [
+    [ ["of" | "&"]; c = operconstr LEVEL "99" ->
+      [LocalRawAssum ([!@loc, Anonymous], Default Explicit, c)]
+  ] ];
+END
+(* }}} *)
+
+(** Tacticals (+, -, *, done, by, do, =>, first, and last). {{{ ***************)
+
+(** Bracketing tactical *)
+
+(* The tactic pretty-printer doesn't know that some extended tactics *)
+(* are actually tacticals. To prevent it from improperly removing    *)
+(* parentheses we override the parsing rule for bracketed tactic     *)
+(* expressions so that the pretty-print always reflects the input.   *)
+(* (Removing user-specified parentheses is dubious anyway).          *)
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssrparentacarg: [[ "("; tac = tactic_expr; ")" -> !@loc, Tacexp tac ]];
+  tactic_expr: LEVEL "0" [[ arg = ssrparentacarg -> TacArg arg ]];
+END
+
+(** The internal "done" and "ssrautoprop" tactics. *)
+
+(* For additional flexibility, "done" and "ssrautoprop" are  *)
+(* defined in Ltac.                                          *)
+(* Although we provide a default definition in ssreflect,    *)
+(* we look up the definition dynamically at each call point, *)
+(* to allow for user extensions. "ssrautoprop" defaults to   *)
+(* trivial.                                                  *)
+
+let donetac gl =
+  let tacname = 
+    try Nametab.locate_tactic (qualid_of_ident (id_of_string "done"))
+    with Not_found -> try Nametab.locate_tactic (ssrqid "done")
+    with Not_found -> CErrors.error "The ssreflect library was not loaded" in
+  let tacexpr = dummy_loc, Tacexpr.Reference (ArgArg (dummy_loc, tacname)) in
+  Proofview.V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl
+
+let prof_donetac = mk_profiler "donetac";;
+let donetac gl = prof_donetac.profile donetac gl;;
+
+let ssrautoprop gl =
+  try 
+    let tacname = 
+      try Nametab.locate_tactic (qualid_of_ident (id_of_string "ssrautoprop"))
+      with Not_found -> Nametab.locate_tactic (ssrqid "ssrautoprop") in
+    let tacexpr = dummy_loc, Tacexpr.Reference (ArgArg (dummy_loc, tacname)) in
+    Proofview.V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl
+  with Not_found -> Proofview.V82.of_tactic (Auto.full_trivial []) gl
+
+let () = ssrautoprop_tac := ssrautoprop
+
+let tclBY tac = tclTHEN tac donetac
+
+(** Tactical arguments. *)
+
+(* We have four kinds: simple tactics, [|]-bracketed lists, hints, and swaps *)
+(* The latter two are used in forward-chaining tactics (have, suffice, wlog) *)
+(* and subgoal reordering tacticals (; first & ; last), respectively.        *)
+
+(* Force use of the tactic_expr parsing entry, to rule out tick marks. *)
+let pr_ssrtacarg _ _ prt = prt tacltop
+ARGUMENT EXTEND ssrtacarg TYPED AS tactic PRINTED BY pr_ssrtacarg
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+GEXTEND Gram
+  GLOBAL: ssrtacarg;
+  ssrtacarg: [[ tac = tactic_expr LEVEL "5" -> tac ]];
+END
+
+(* Lexically closed tactic for tacticals. *)
+let pr_ssrtclarg _ _ prt tac = prt tacltop tac
+ARGUMENT EXTEND ssrtclarg TYPED AS ssrtacarg
+    PRINTED BY pr_ssrtclarg
+| [ ssrtacarg(tac) ] -> [ tac ]
+END
+let eval_tclarg ist tac = ssrevaltac ist tac
+
+let pr_ortacs prt = 
+  let rec pr_rec = function
+  | [None]           -> spc() ++ str "|" ++ spc()
+  | None :: tacs     -> spc() ++ str "|" ++ pr_rec tacs
+  | Some tac :: tacs -> spc() ++ str "| " ++ prt tacltop tac ++  pr_rec tacs
+  | []                -> mt() in
+  function
+  | [None]           -> spc()
+  | None :: tacs     -> pr_rec tacs
+  | Some tac :: tacs -> prt tacltop tac ++ pr_rec tacs
+  | []                -> mt()
+let pr_ssrortacs _ _ = pr_ortacs
+
+ARGUMENT EXTEND ssrortacs TYPED AS tactic option list PRINTED BY pr_ssrortacs
+| [ ssrtacarg(tac) "|" ssrortacs(tacs) ] -> [ Some tac :: tacs ]
+| [ ssrtacarg(tac) "|" ] -> [ [Some tac; None] ]
+| [ ssrtacarg(tac) ] -> [ [Some tac] ]
+| [ "|" ssrortacs(tacs) ] -> [ None :: tacs ]
+| [ "|" ] -> [ [None; None] ]
+END
+
+let pr_hintarg prt = function
+  | true, tacs -> hv 0 (str "[ " ++ pr_ortacs prt tacs ++ str " ]")
+  | false, [Some tac] -> prt tacltop tac
+  | _, _ -> mt()
+
+let pr_ssrhintarg _ _ = pr_hintarg
+
+let mk_hint tac = false, [Some tac]
+let mk_orhint tacs = true, tacs
+let nullhint = true, []
+let nohint = false, []
+
+ARGUMENT EXTEND ssrhintarg TYPED AS bool * ssrortacs PRINTED BY pr_ssrhintarg
+| [ "[" "]" ] -> [ nullhint ]
+| [ "[" ssrortacs(tacs) "]" ] -> [ mk_orhint tacs ]
+| [ ssrtacarg(arg) ] -> [ mk_hint arg ]
+END
+
+ARGUMENT EXTEND ssrortacarg TYPED AS ssrhintarg PRINTED BY pr_ssrhintarg
+| [ "[" ssrortacs(tacs) "]" ] -> [ mk_orhint tacs ]
+END
+
+let hinttac ist is_by (is_or, atacs) =
+  let dtac = if is_by then donetac else tclIDTAC in
+  let mktac = function
+  | Some atac -> tclTHEN (ssrevaltac ist atac) dtac
+  | _ -> dtac in
+  match List.map mktac atacs with
+  | [] -> if is_or then dtac else tclIDTAC
+  | [tac] -> tac
+  | tacs -> tclFIRST tacs
+
+(** The "-"/"+"/"*" tacticals. *)
+
+(* These are just visual cues to flag the beginning of the script for *)
+(* new subgoals, when indentation is not appropriate (typically after *)
+(* tactics that generate more than two subgoals).                     *)
+
+TACTIC EXTEND ssrtclplus
+| [ "YouShouldNotTypeThis" "+" ssrtclarg(arg) ] -> [ Proofview.V82.tactic (eval_tclarg ist arg) ]
+END
+set_pr_ssrtac "tclplus" 5 [ArgSep "+ "; ArgSsr "tclarg"]
+
+TACTIC EXTEND ssrtclminus
+| [ "YouShouldNotTypeThis" "-" ssrtclarg(arg) ] -> [ Proofview.V82.tactic (eval_tclarg ist arg) ]
+END
+set_pr_ssrtac "tclminus" 5 [ArgSep "- "; ArgSsr "tclarg"]
+
+TACTIC EXTEND ssrtclstar
+| [ "YouShouldNotTypeThis" "*" ssrtclarg(arg) ] -> [ Proofview.V82.tactic (eval_tclarg ist arg) ]
+END
+set_pr_ssrtac "tclstar" 5 [ArgSep "- "; ArgSsr "tclarg"]
+
+let gen_tclarg tac = TacGeneric (in_gen (rawwit wit_ssrtclarg) tac)
+
+GEXTEND Gram
+  GLOBAL: tactic tactic_mode;
+  tactic: [
+    [ "+"; tac = ssrtclarg -> ssrtac_expr !@loc "tclplus" [gen_tclarg tac]
+    | "-"; tac = ssrtclarg -> ssrtac_expr !@loc "tclminus" [gen_tclarg tac]
+    | "*"; tac = ssrtclarg -> ssrtac_expr !@loc "tclstar" [gen_tclarg tac] 
+    ] ];
+  tactic_mode: [
+    [ "+"; tac = G_vernac.subgoal_command -> tac None
+    | "-"; tac = G_vernac.subgoal_command -> tac None
+    | "*"; tac = G_vernac.subgoal_command -> tac None
+    ] ];
+END
+
+(** The "by" tactical. *)
+
+let pr_hint prt arg =
+  if arg = nohint then mt() else str "by " ++ pr_hintarg prt arg
+let pr_ssrhint _ _ = pr_hint
+
+ARGUMENT EXTEND ssrhint TYPED AS ssrhintarg PRINTED BY pr_ssrhint
+| [ ]                       -> [ nohint ]
+END
+
+TACTIC EXTEND ssrtclby
+| [ "by" ssrhintarg(tac) ] -> [ Proofview.V82.tactic (hinttac ist true tac) ]
+END
+
+(* We can't parse "by" in ARGUMENT EXTEND because it will only be made *)
+(* into a keyword in ssreflect.v; so we anticipate this in GEXTEND.    *)
+
+GEXTEND Gram
+  GLOBAL: ssrhint simple_tactic;
+  ssrhint: [[ "by"; arg = ssrhintarg -> arg ]];
+END
+(* }}} *)
+
+(** Bound assumption argument *)
+
+(* The Ltac API does have a type for assumptions but it is level-dependent *)
+(* and therefore impratical to use for complex arguments, so we substitute *)
+(* our own to have a uniform representation. Also, we refuse to intern     *)
+(* idents that match global/section constants, since this would lead to    *)
+(* fragile Ltac scripts.                                                   *)
+
+type ssrhyp = SsrHyp of loc * identifier
+
+let hyp_id (SsrHyp (_, id)) = id
+let pr_hyp (SsrHyp (_, id)) = pr_id id
+let pr_ssrhyp _ _ _ = pr_hyp
+
+let wit_ssrhyprep = add_genarg "ssrhyprep" pr_hyp
+
+let hyp_err loc msg id =
+  CErrors.user_err_loc (loc, "ssrhyp", str msg ++ pr_id id)
+
+let intern_hyp ist (SsrHyp (loc, id) as hyp) =
+  let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_var) (loc, id)) in
+  if not_section_id id then hyp else
+  hyp_err loc "Can't clear section hypothesis " id
+
+let interp_hyp ist gl (SsrHyp (loc, id)) =
+  let s, id' = interp_wit wit_var ist gl (loc, id) in
+  if not_section_id id' then s, SsrHyp (loc, id') else
+  hyp_err loc "Can't clear section hypothesis " id'
+
+ARGUMENT EXTEND ssrhyp TYPED AS ssrhyprep PRINTED BY pr_ssrhyp
+                       INTERPRETED BY interp_hyp
+                       GLOBALIZED BY intern_hyp
+  | [ ident(id) ] -> [ SsrHyp (loc, id) ]
+END
+
+type ssrhyp_or_id = Hyp of ssrhyp | Id of ssrhyp
+
+let hoik f = function Hyp x -> f x | Id x -> f x
+let hoi_id = hoik hyp_id
+let pr_hoi = hoik pr_hyp
+let pr_ssrhoi _ _ _ = pr_hoi
+
+let wit_ssrhoirep = add_genarg "ssrhoirep" pr_hoi
+
+let intern_ssrhoi ist = function
+  | Hyp h -> Hyp (intern_hyp ist h)
+  | Id (SsrHyp (_, id)) as hyp ->
+    let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_ident) id) in
+    hyp
+
+let interp_ssrhoi ist gl = function
+  | Hyp h -> let s, h' = interp_hyp ist gl h in s, Hyp h'
+  | Id (SsrHyp (loc, id)) ->
+    let s, id' = interp_wit wit_ident ist gl id in
+    s, Id (SsrHyp (loc, id'))
+
+ARGUMENT EXTEND ssrhoi_hyp TYPED AS ssrhoirep PRINTED BY pr_ssrhoi
+                       INTERPRETED BY interp_ssrhoi
+                       GLOBALIZED BY intern_ssrhoi
+  | [ ident(id) ] -> [ Hyp (SsrHyp(loc, id)) ]
+END
+ARGUMENT EXTEND ssrhoi_id TYPED AS ssrhoirep PRINTED BY pr_ssrhoi
+                       INTERPRETED BY interp_ssrhoi
+                       GLOBALIZED BY intern_ssrhoi
+  | [ ident(id) ] -> [ Id (SsrHyp(loc, id)) ]
+END
+
+type ssrhyps = ssrhyp list
+
+let pr_hyps = pr_list pr_spc pr_hyp
+let pr_ssrhyps _ _ _ = pr_hyps
+let hyps_ids = List.map hyp_id
+
+let rec check_hyps_uniq ids = function
+  | SsrHyp (loc, id) :: _ when List.mem id ids ->
+    hyp_err loc "Duplicate assumption " id
+  | SsrHyp (_, id) :: hyps -> check_hyps_uniq (id :: ids) hyps
+  | [] -> ()
+
+let check_hyp_exists hyps (SsrHyp(_, id)) =
+  try ignore(Context.Named.lookup id hyps)
+  with Not_found -> errorstrm (str"No assumption is named " ++ pr_id id)
+
+let interp_hyps ist gl ghyps =
+  let hyps = List.map snd (List.map (interp_hyp ist gl) ghyps) in
+  check_hyps_uniq [] hyps; Tacmach.project gl, hyps
+
+ARGUMENT EXTEND ssrhyps TYPED AS ssrhyp list PRINTED BY pr_ssrhyps
+                        INTERPRETED BY interp_hyps
+  | [ ssrhyp_list(hyps) ] -> [ check_hyps_uniq [] hyps; hyps ]
+END
+
+(** Terms parsing. {{{ ********************************************************)
+
+(* Because we allow wildcards in term references, we need to stage the *)
+(* interpretation of terms so that it occurs at the right time during  *)
+(* the execution of the tactic (e.g., so that we don't report an error *)
+(* for a term that isn't actually used in the execution).              *)
+(*   The term representation tracks whether the concrete initial term  *)
+(* started with an opening paren, which might avoid a conflict between *)
+(* the ssrreflect term syntax and Gallina notation.                    *)
+
+(* kinds of terms *)
+
+type ssrtermkind = char (* print flag *)
+
+let input_ssrtermkind strm = match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.KEYWORD "(" -> '('
+  | Tok.KEYWORD "@" -> '@'
+  | _ -> ' '
+
+let ssrtermkind = Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
+
+(* terms *)
+let pr_ssrterm _ _ _ = pr_term
+let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c
+let intern_term ist sigma env (_, c) = glob_constr ist env c
+let interp_term ist gl (_, c) = snd (interp_open_constr ist gl c)
+let force_term ist gl (_, c) = interp_constr ist gl c
+let glob_ssrterm gs = function
+  | k, (_, Some c) -> k, Tacintern.intern_constr gs c
+  | ct -> ct
+let subst_ssrterm s (k, c) = k, Tacsubst.subst_glob_constr_and_expr s c
+let interp_ssrterm _ gl t = Tacmach.project gl, t
+
+ARGUMENT EXTEND ssrterm
+     PRINTED BY pr_ssrterm
+     INTERPRETED BY interp_ssrterm
+     GLOBALIZED BY glob_ssrterm SUBSTITUTED BY subst_ssrterm
+     RAW_PRINTED BY pr_ssrterm
+     GLOB_PRINTED BY pr_ssrterm
+| [ "YouShouldNotTypeThis" constr(c) ] -> [ mk_lterm c ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssrterm;
+  ssrterm: [[ k = ssrtermkind; c = constr -> mk_term k c ]];
+END
+(* }}} *)
+
+(** The "in" pseudo-tactical {{{ **********************************************)
+
+(* We can't make "in" into a general tactical because this would create a  *)
+(* crippling conflict with the ltac let .. in construct. Hence, we add     *)
+(* explicitly an "in" suffix to all the extended tactics for which it is   *)
+(* relevant (including move, case, elim) and to the extended do tactical   *)
+(* below, which yields a general-purpose "in" of the form do [...] in ...  *)
+
+(* This tactical needs to come before the intro tactics because the latter *)
+(* must take precautions in order not to interfere with the discharged     *)
+(* assumptions. This is especially difficult for discharged "let"s, which  *)
+(* the default simpl and unfold tactics would erase blindly.               *)
+
+(** Clear switch *)
+
+type ssrclear = ssrhyps
+
+let pr_clear_ne clr = str "{" ++ pr_hyps clr ++ str "}"
+let pr_clear sep clr = if clr = [] then mt () else sep () ++ pr_clear_ne clr
+
+let pr_ssrclear _ _ _ = pr_clear mt
+
+ARGUMENT EXTEND ssrclear_ne TYPED AS ssrhyps PRINTED BY pr_ssrclear
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ check_hyps_uniq [] clr; clr ]
+END
+
+ARGUMENT EXTEND ssrclear TYPED AS ssrclear_ne PRINTED BY pr_ssrclear
+| [ ssrclear_ne(clr) ] -> [ clr ]
+| [ ] -> [ [] ]
+END
+
+let cleartac clr = check_hyps_uniq [] clr; Proofview.V82.of_tactic (clear (hyps_ids clr))
+
+(* type ssrwgen = ssrclear * ssrhyp * string *)
+
+let pr_wgen = function 
+  | (clr, Some((id,k),None)) -> spc() ++ pr_clear mt clr ++ str k ++ pr_hoi id
+  | (clr, Some((id,k),Some p)) ->
+      spc() ++ pr_clear mt clr ++ str"(" ++ str k ++ pr_hoi id ++ str ":=" ++
+        pr_cpattern p ++ str ")"
+  | (clr, None) -> spc () ++ pr_clear mt clr
+let pr_ssrwgen _ _ _ = pr_wgen
+
+(* no globwith for char *)
+ARGUMENT EXTEND ssrwgen
+  TYPED AS ssrclear * ((ssrhoi_hyp * string) * cpattern option) option
+  PRINTED BY pr_ssrwgen
+| [ ssrclear_ne(clr) ] -> [ clr, None ]
+| [ ssrhoi_hyp(hyp) ] -> [ [], Some((hyp, " "), None) ]
+| [ "@" ssrhoi_hyp(hyp) ] -> [ [], Some((hyp, "@"), None) ]
+| [ "(" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id," "),Some p) ]
+| [ "(" ssrhoi_id(id) ")" ] -> [ [], Some ((id,"("), None) ]
+| [ "(@" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id,"@"),Some p) ]
+| [ "(" "@" ssrhoi_id(id) ":=" lcpattern(p) ")" ] ->
+  [ [], Some ((id,"@"),Some p) ]
+END
+
+type ssrclseq = InGoal | InHyps
+ | InHypsGoal | InHypsSeqGoal | InSeqGoal | InHypsSeq | InAll | InAllHyps
+
+let pr_clseq = function
+  | InGoal | InHyps -> mt ()
+  | InSeqGoal       -> str "|- *"
+  | InHypsSeqGoal   -> str " |- *"
+  | InHypsGoal      -> str " *"
+  | InAll           -> str "*"
+  | InHypsSeq       -> str " |-"
+  | InAllHyps       -> str "* |-"
+
+let wit_ssrclseq = add_genarg "ssrclseq" pr_clseq
+let pr_clausehyps = pr_list pr_spc pr_wgen
+let pr_ssrclausehyps _ _ _ = pr_clausehyps
+
+ARGUMENT EXTEND ssrclausehyps 
+TYPED AS ssrwgen list PRINTED BY pr_ssrclausehyps
+| [ ssrwgen(hyp) "," ssrclausehyps(hyps) ] -> [ hyp :: hyps ]
+| [ ssrwgen(hyp) ssrclausehyps(hyps) ] -> [ hyp :: hyps ]
+| [ ssrwgen(hyp) ] -> [ [hyp] ]
+END
+
+(* type ssrclauses = ssrahyps * ssrclseq *)
+
+let pr_clauses (hyps, clseq) = 
+  if clseq = InGoal then mt ()
+  else str "in " ++ pr_clausehyps hyps ++ pr_clseq clseq
+let pr_ssrclauses _ _ _ = pr_clauses
+
+ARGUMENT EXTEND ssrclauses TYPED AS ssrwgen list * ssrclseq
+    PRINTED BY pr_ssrclauses
+  | [ "in" ssrclausehyps(hyps) "|-" "*" ] -> [ hyps, InHypsSeqGoal ]
+  | [ "in" ssrclausehyps(hyps) "|-" ]     -> [ hyps, InHypsSeq ]
+  | [ "in" ssrclausehyps(hyps) "*" ]      -> [ hyps, InHypsGoal ]
+  | [ "in" ssrclausehyps(hyps) ]          -> [ hyps, InHyps ]
+  | [ "in" "|-" "*" ]                     -> [ [], InSeqGoal ]
+  | [ "in" "*" ]                          -> [ [], InAll ]
+  | [ "in" "*" "|-" ]                     -> [ [], InAllHyps ]
+  | [ ]                                   -> [ [], InGoal ]
+END
+
+let nohide = mkRel 0
+let hidden_goal_tag = "the_hidden_goal"
+
+(* Reduction that preserves the Prod/Let spine of the "in" tactical. *)
+
+let inc_safe n = if n = 0 then n else n + 1
+let rec safe_depth c = match kind_of_term c with
+| LetIn (Name x, _, _, c') when is_discharged_id x -> safe_depth c' + 1
+| LetIn (_, _, _, c') | Prod (_, _, c') -> inc_safe (safe_depth c')
+| _ -> 0 
+
+let red_safe r e s c0 =
+  let rec red_to e c n = match kind_of_term c with
+  | Prod (x, t, c') when n > 0 ->
+    let t' = r e s t in let e' = Environ.push_rel (RelDecl.LocalAssum (x, t')) e in
+    mkProd (x, t', red_to e' c' (n - 1))
+  | LetIn (x, b, t, c') when n > 0 ->
+    let t' = r e s t in let e' = Environ.push_rel (RelDecl.LocalAssum (x, t')) e in
+    mkLetIn (x, r e s b, t', red_to e' c' (n - 1))
+  | _ -> r e s c in
+  red_to e c0 (safe_depth c0)
+
+let check_wgen_uniq gens =
+  let clears = List.flatten (List.map fst gens) in
+  check_hyps_uniq [] clears;
+  let ids = CList.map_filter
+    (function (_,Some ((id,_),_)) -> Some (hoi_id id) | _ -> None) gens in
+  let rec check ids = function
+  | id :: _ when List.mem id ids ->
+    errorstrm (str"Duplicate generalization " ++ pr_id id)
+  | id :: hyps -> check (id :: ids) hyps
+  | [] -> () in
+  check [] ids
+
+let pf_clauseids gl gens clseq =
+  let keep_clears = List.map (fun (x, _) -> x, None) in
+  if gens <> [] then (check_wgen_uniq gens; gens) else
+  if clseq <> InAll && clseq <> InAllHyps then keep_clears gens else
+  CErrors.error "assumptions should be named explicitly"
+
+let hidden_clseq = function InHyps | InHypsSeq | InAllHyps -> true | _ -> false
+
+let hidetacs clseq idhide cl0 =
+  if not (hidden_clseq clseq) then  [] else
+  [posetac idhide cl0;
+   Proofview.V82.of_tactic (convert_concl_no_check (mkVar idhide))]
+
+let discharge_hyp (id', (id, mode)) gl =
+  let cl' = subst_var id (pf_concl gl) in
+  match NamedDecl.to_tuple (pf_get_hyp gl id), mode with
+  | (_, None, t), _ | (_, Some _, t), "(" -> 
+     apply_type (mkProd (Name id', t, cl')) [mkVar id] gl
+  | (_, Some v, t), _ ->
+     Proofview.V82.of_tactic (convert_concl (mkLetIn (Name id', v, t, cl'))) gl
+
+let endclausestac id_map clseq gl_id cl0 gl =
+  let not_hyp' id = not (List.mem_assoc id id_map) in
+  let orig_id id = try List.assoc id id_map with _ -> id in
+  let dc, c = Term.decompose_prod_assum (pf_concl gl) in
+  let hide_goal = hidden_clseq clseq in
+  let c_hidden = hide_goal && c = mkVar gl_id in
+  let rec fits forced = function
+  | (id, _) :: ids, decl :: dc' when RelDecl.get_name decl = Name id ->
+    fits true (ids, dc')
+  | ids, dc' ->
+    forced && ids = [] && (not hide_goal || dc' = [] && c_hidden) in
+  let rec unmark c = match kind_of_term c with
+  | Var id when hidden_clseq clseq && id = gl_id -> cl0
+  | Prod (Name id, t, c') when List.mem_assoc id id_map ->
+    mkProd (Name (orig_id id), unmark t, unmark c')
+  | LetIn (Name id, v, t, c') when List.mem_assoc id id_map ->
+    mkLetIn (Name (orig_id id), unmark v, unmark t, unmark c')
+  | _ -> map_constr unmark c in
+  let utac hyp =
+    Proofview.V82.of_tactic 
+     (convert_hyp_no_check (NamedDecl.map_constr unmark hyp)) in
+  let utacs = List.map utac (pf_hyps gl) in
+  let ugtac gl' =
+    Proofview.V82.of_tactic
+      (convert_concl_no_check (unmark (pf_concl gl'))) gl' in
+  let ctacs = if hide_goal then [Proofview.V82.of_tactic (clear [gl_id])] else [] in
+  let mktac itacs = tclTHENLIST (itacs @ utacs @ ugtac :: ctacs) in
+  let itac (_, id) = Proofview.V82.of_tactic (introduction id) in
+  if fits false (id_map, List.rev dc) then mktac (List.map itac id_map) gl else
+  let all_ids = ids_of_rel_context dc @ pf_ids_of_hyps gl in
+  if List.for_all not_hyp' all_ids && not c_hidden then mktac [] gl else
+  CErrors.error "tampering with discharged assumptions of \"in\" tactical"
+
+let is_id_constr c = match kind_of_term c with
+  | Lambda(_,_,c) when isRel c -> 1 = destRel c
+  | _ -> false
+
+let red_product_skip_id env sigma c = match kind_of_term c with
+  | App(hd,args) when Array.length args = 1 && is_id_constr hd -> args.(0)
+  | _ -> try Tacred.red_product env sigma c with _ -> c
+
+let abs_wgen keep_let ist f gen (gl,args,c) =
+  let sigma, env = project gl, pf_env gl in
+  let evar_closed t p =
+    if occur_existential t then
+      CErrors.user_err_loc (loc_of_cpattern p,"ssreflect",
+        pr_constr_pat t ++
+        str" contains holes and matches no subterm of the goal") in
+  match gen with
+  | _, Some ((x, mode), None) when mode = "@" || (mode = " " && keep_let) ->
+     let x = hoi_id x in
+     let _, bo, ty = NamedDecl.to_tuple (pf_get_hyp gl x) in
+     gl,
+     (if bo <> None then args else mkVar x :: args),
+     mkProd_or_LetIn (mk_reldecl (Name (f x)) bo ty) (subst_var x c)
+  | _, Some ((x, _), None) ->
+     let x = hoi_id x in
+     gl, mkVar x :: args, mkProd (Name (f x),pf_get_hyp_typ gl x, subst_var x c)
+  | _, Some ((x, "@"), Some p) -> 
+     let x = hoi_id x in
+     let cp = interp_cpattern ist gl p None in
+     let (t, ucst), c =
+       try fill_occ_pattern ~raise_NoMatch:true env sigma c cp None 1
+       with NoMatch -> redex_of_pattern env cp, c in
+     evar_closed t p;
+     let ut = red_product_skip_id env sigma t in
+     let gl, ty = pf_type_of gl t in
+     pf_merge_uc ucst gl, args, mkLetIn(Name (f x), ut, ty, c)
+  | _, Some ((x, _), Some p) ->
+     let x = hoi_id x in
+     let cp = interp_cpattern ist gl p None in
+     let (t, ucst), c =
+       try fill_occ_pattern ~raise_NoMatch:true env sigma c cp None 1
+       with NoMatch -> redex_of_pattern env cp, c in
+     evar_closed t p;
+     let gl, ty = pf_type_of gl t in
+     pf_merge_uc ucst gl, t :: args, mkProd(Name (f x), ty, c)
+  | _ -> gl, args, c
+
+let clr_of_wgen gen clrs = match gen with
+  | clr, Some ((x, _), None) ->
+     let x = hoi_id x in
+     cleartac clr :: cleartac [SsrHyp(Loc.ghost,x)] :: clrs
+  | clr, _ -> cleartac clr :: clrs
+    
+let tclCLAUSES ist tac (gens, clseq) gl =
+  if clseq = InGoal || clseq = InSeqGoal then tac gl else
+  let clr_gens = pf_clauseids gl gens clseq in
+  let clear = tclTHENLIST (List.rev(List.fold_right clr_of_wgen clr_gens [])) in
+  let gl_id = mk_anon_id hidden_goal_tag gl in
+  let cl0 = pf_concl gl in
+  let dtac gl =
+    let c = pf_concl gl in
+    let gl, args, c =
+      List.fold_right (abs_wgen true ist mk_discharged_id) gens (gl,[], c) in
+    apply_type c args gl in
+  let endtac =
+    let id_map = CList.map_filter (function
+      | _, Some ((x,_),_) -> let id = hoi_id x in Some (mk_discharged_id id, id)
+      | _, None -> None) gens in
+    endclausestac id_map clseq gl_id cl0 in
+  tclTHENLIST (hidetacs clseq gl_id cl0 @ [dtac; clear; tac; endtac]) gl
+(* }}} *)
+
+(** Simpl switch *)
+
+type ssrsimpl = Simpl | Cut | SimplCut | Nop
+
+let pr_simpl = function
+  | Simpl -> str "/="
+  | Cut -> str "//"
+  | SimplCut -> str "//="
+  | Nop -> mt ()
+
+let pr_ssrsimpl _ _ _ = pr_simpl
+
+let wit_ssrsimplrep = add_genarg "ssrsimplrep" pr_simpl
+
+ARGUMENT EXTEND ssrsimpl_ne TYPED AS ssrsimplrep PRINTED BY pr_ssrsimpl
+| [ "/=" ] -> [ Simpl ]
+| [ "//" ] -> [ Cut ]
+| [ "//=" ] -> [ SimplCut ]
+END
+
+ARGUMENT EXTEND ssrsimpl TYPED AS ssrsimplrep PRINTED BY pr_ssrsimpl
+| [ ssrsimpl_ne(sim) ] -> [ sim ]
+| [ ] -> [ Nop ]
+END
+
+(* We must avoid zeta-converting any "let"s created by the "in" tactical. *)
+
+let safe_simpltac gl =
+  let cl' = red_safe Tacred.simpl (pf_env gl) (project gl) (pf_concl gl) in
+  Proofview.V82.of_tactic (convert_concl_no_check cl') gl
+
+let simpltac = function
+  | Simpl -> safe_simpltac
+  | Cut -> tclTRY donetac
+  | SimplCut -> tclTHEN safe_simpltac (tclTRY donetac)
+  | Nop -> tclIDTAC
+
+(** Rewriting direction *)
+
+let pr_dir = function L2R -> str "->" | R2L -> str "<-"
+let pr_rwdir = function L2R -> mt() | R2L -> str "-"
+
+let rewritetac dir c =
+  (* Due to the new optional arg ?tac, application shouldn't be too partial *)
+  Proofview.V82.of_tactic begin
+    Equality.general_rewrite (dir = L2R) AllOccurrences true false c
+  end
+
+let wit_ssrdir = add_genarg "ssrdir" pr_dir
+
+let dir_org = function L2R -> 1 | R2L -> 2
+
+(** Indexes *)
+
+(* Since SSR indexes are always positive numbers, we use the 0 value *)
+(* to encode an omitted index. We reuse the in or_var type, but we   *)
+(* supply our own interpretation function, which checks for non      *)
+(* positive values, and allows the use of constr numerals, so that   *)
+(* e.g., "let n := eval compute in (1 + 3) in (do n!clear)" works.   *)
+
+type ssrindex = int or_var
+
+let pr_index = function
+  | ArgVar (_, id) -> pr_id id
+  | ArgArg n when n > 0 -> int n
+  | _ -> mt ()
+let pr_ssrindex _ _ _ = pr_index
+
+let noindex = ArgArg 0
+let allocc = Some(false,[])
+
+let check_index loc i =
+  if i > 0 then i else loc_error loc "Index not positive"
+let mk_index loc = function ArgArg i -> ArgArg (check_index loc i) | iv -> iv
+
+let interp_index ist gl idx =
+  Tacmach.project gl, 
+  match idx with
+  | ArgArg _ -> idx
+  | ArgVar (loc, id) ->
+    let i =
+      try
+        let v = Id.Map.find id ist.lfun in
+        begin match Value.to_int v with
+        | Some i -> i
+        | None ->
+        begin match Value.to_constr v with
+        | Some c ->
+          let rc = Detyping.detype false [] (pf_env gl) (project gl) c in
+          begin match Notation.uninterp_prim_token rc with
+          | _, Numeral bigi -> int_of_string (Bigint.to_string bigi)
+          | _ -> raise Not_found
+          end
+        | None -> raise Not_found
+        end end
+    with _ -> loc_error loc "Index not a number" in
+    ArgArg (check_index loc i)
+
+ARGUMENT EXTEND ssrindex TYPED AS ssrindex PRINTED BY pr_ssrindex
+  INTERPRETED BY interp_index
+| [ int_or_var(i) ] -> [ mk_index loc i ]
+END
+
+(** Occurrence switch *)
+
+(* The standard syntax of complemented occurrence lists involves a single *)
+(* initial "-", e.g., {-1 3 5}. An initial                                *)
+(* "+" may be used to indicate positive occurrences (the default). The    *)
+(* "+" is optional, except if the list of occurrences starts with a       *)
+(* variable or is empty (to avoid confusion with a clear switch). The     *)
+(* empty positive switch "{+}" selects no occurrences, while the empty    *)
+(* negative switch "{-}" selects all occurrences explicitly; this is the  *)
+(* default, but "{-}" prevents the implicit clear, and can be used to     *)
+(* force dependent elimination -- see ndefectelimtac below.               *)
+
+type ssrocc = occ
+
+let pr_occ = function
+  | Some (true, occ) -> str "{-" ++ pr_list pr_spc int occ ++ str "}"
+  | Some (false, occ) -> str "{+" ++ pr_list pr_spc int occ ++ str "}"
+  | None -> str "{}"
+
+let pr_ssrocc _ _ _ = pr_occ
+
+ARGUMENT EXTEND ssrocc TYPED AS (bool * int list) option PRINTED BY pr_ssrocc
+| [ natural(n) natural_list(occ) ] -> [
+     Some (false, List.map (check_index loc) (n::occ)) ]
+| [ "-" natural_list(occ) ]     -> [ Some (true, occ) ]
+| [ "+" natural_list(occ) ]     -> [ Some (false, occ) ]
+END
+
+let pf_mkprod gl c ?(name=constr_name c) cl =
+  let gl, t = pf_type_of gl c in
+  if name <> Anonymous || noccurn 1 cl then gl, mkProd (name, t, cl) else
+  gl, mkProd (Name (pf_type_id gl t), t, cl)
+
+let pf_abs_prod name gl c cl = pf_mkprod gl c ~name (subst_term c cl)
+
+(** Discharge occ switch (combined occurrence / clear switch *)
+
+type ssrdocc = ssrclear option * ssrocc option
+
+let mkocc occ = None, occ
+let noclr = mkocc None
+let mkclr clr  = Some clr, None
+let nodocc = mkclr []
+
+let pr_docc = function
+  | None, occ -> pr_occ occ
+  | Some clr, _ -> pr_clear mt clr
+
+let pr_ssrdocc _ _ _ = pr_docc
+
+ARGUMENT EXTEND ssrdocc TYPED AS ssrclear option * ssrocc PRINTED BY pr_ssrdocc
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
+| [ "{" ssrocc(occ) "}" ] -> [ mkocc occ ]
+END
+
+(** View hint database and View application. {{{ ******************************)
+
+(* There are three databases of lemmas used to mediate the application  *)
+(* of reflection lemmas: one for forward chaining, one for backward     *)
+(* chaining, and one for secondary backward chaining.                   *)
+
+(* View hints *)
+
+let rec isCxHoles = function (CHole _, None) :: ch -> isCxHoles ch | _ -> false
+
+let pr_raw_ssrhintref prc _ _ = function
+  | CAppExpl (_, (None, r,x), args) when isCHoles args ->
+    prc (CRef (r,x)) ++ str "|" ++ int (List.length args)
+  | CApp (_, (_, CRef _), _) as c -> prc c
+  | CApp (_, (_, c), args) when isCxHoles args ->
+    prc c ++ str "|" ++ int (List.length args)
+  | c -> prc c
+
+let pr_rawhintref = function
+  | GApp (_, f, args) when isRHoles args ->
+    pr_glob_constr f ++ str "|" ++ int (List.length args)
+  | c -> pr_glob_constr c
+
+let pr_glob_ssrhintref _ _ _ (c, _) = pr_rawhintref c
+
+let pr_ssrhintref prc _ _ = prc
+
+let mkhintref loc c n = match c with
+  | CRef (r,x) -> CAppExpl (loc, (None, r, x), mkCHoles loc n)
+  | _ -> mkAppC (c, mkCHoles loc n)
+
+ARGUMENT EXTEND ssrhintref
+                             PRINTED BY pr_ssrhintref
+    RAW_TYPED AS constr  RAW_PRINTED BY pr_raw_ssrhintref
+   GLOB_TYPED AS constr GLOB_PRINTED BY pr_glob_ssrhintref
+  | [ constr(c) ] -> [ c ]
+  | [ constr(c) "|" natural(n) ] -> [ mkhintref loc c n ]
+END
+
+(* View purpose *)
+
+let pr_viewpos = function
+  | 0 -> str " for move/"
+  | 1 -> str " for apply/"
+  | 2 -> str " for apply//"
+  | _ -> mt ()
+
+let pr_ssrviewpos _ _ _ = pr_viewpos
+
+ARGUMENT EXTEND ssrviewpos TYPED AS int PRINTED BY pr_ssrviewpos
+  | [ "for" "move" "/" ] -> [ 0 ]
+  | [ "for" "apply" "/" ] -> [ 1 ]
+  | [ "for" "apply" "/" "/" ] -> [ 2 ]
+  | [ "for" "apply" "//" ] -> [ 2 ]
+  | [ ] -> [ 3 ]
+END
+
+let pr_ssrviewposspc _ _ _ i = pr_viewpos i ++ spc ()
+
+ARGUMENT EXTEND ssrviewposspc TYPED AS ssrviewpos PRINTED BY pr_ssrviewposspc
+  | [ ssrviewpos(i) ] -> [ i ]
+END
+
+(* The table and its display command *)
+
+let viewtab : glob_constr list array = Array.make 3 []
+
+let _ =
+  let init () = Array.fill viewtab 0 3 [] in
+  let freeze _ = Array.copy viewtab in
+  let unfreeze vt = Array.blit vt 0 viewtab 0 3 in
+  Summary.declare_summary "ssrview"
+    { Summary.freeze_function   = freeze;
+      Summary.unfreeze_function = unfreeze;
+      Summary.init_function     = init }
+
+let mapviewpos f n k = if n < 3 then f n else for i = 0 to k - 1 do f i done
+
+let print_view_hints i =
+  let pp_viewname = str "Hint View" ++ pr_viewpos i ++ str " " in
+  let pp_hints = pr_list spc pr_rawhintref viewtab.(i) in
+  ppnl (pp_viewname ++ hov 0 pp_hints ++ Pp.cut ())
+
+VERNAC COMMAND EXTEND PrintView CLASSIFIED AS QUERY
+| [ "Print" "Hint" "View" ssrviewpos(i) ] -> [ mapviewpos print_view_hints i 3 ]
+END
+
+(* Populating the table *)
+
+let cache_viewhint (_, (i, lvh)) =
+  let mem_raw h = List.exists (Glob_ops.glob_constr_eq h) in
+  let add_hint h hdb = if mem_raw h hdb then hdb else h :: hdb in
+  viewtab.(i) <- List.fold_right add_hint lvh viewtab.(i)
+
+let subst_viewhint ( subst, (i, lvh as ilvh)) =
+  let lvh' = List.smartmap (Detyping.subst_glob_constr subst) lvh in
+  if lvh' == lvh then ilvh else i, lvh'
+      
+let classify_viewhint x = Libobject.Substitute x
+
+let in_viewhint =
+  Libobject.declare_object {(Libobject.default_object "VIEW_HINTS") with
+       Libobject.open_function = (fun i o -> if i = 1 then cache_viewhint o);
+       Libobject.cache_function = cache_viewhint;
+       Libobject.subst_function = subst_viewhint;
+       Libobject.classify_function = classify_viewhint }
+
+let glob_view_hints lvh =
+  List.map (Constrintern.intern_constr (Global.env ())) lvh
+
+let add_view_hints lvh i = Lib.add_anonymous_leaf (in_viewhint (i, lvh))
+
+VERNAC COMMAND EXTEND HintView CLASSIFIED AS SIDEFF
+  |  [ "Hint" "View" ssrviewposspc(n) ne_ssrhintref_list(lvh) ] ->
+     [ mapviewpos (add_view_hints (glob_view_hints lvh)) n 2 ]
+END
+
+(** Views *)
+
+(* Views for the "move" and "case" commands are actually open *)
+(* terms, but this is handled by interp_view, which is called *)
+(* by interp_casearg. We use lists, to support the            *)
+(* "double-view" feature of the apply command.                *)
+
+(* type ssrview = ssrterm list *)
+
+let pr_view = pr_list mt (fun c -> str "/" ++ pr_term c)
+
+let pr_ssrview _ _ _ = pr_view
+
+ARGUMENT EXTEND ssrview TYPED AS ssrterm list
+   PRINTED BY pr_ssrview
+| [ "/" constr(c) ] -> [ [mk_term ' ' c] ]
+| [ "/" constr(c) ssrview(w) ] -> [ (mk_term ' ' c) :: w ]
+END
+
+(* There are two ways of "applying" a view to term:            *)
+(*  1- using a view hint if the view is an instance of some    *)
+(*     (reflection) inductive predicate.                       *)
+(*  2- applying the view if it coerces to a function, adding   *)
+(*     implicit arguments.                                     *)
+(* They require guessing the view hints and the number of      *)
+(* implicits, respectively, which we do by brute force.        *)
+
+let view_error s gv =
+  errorstrm (str ("Cannot " ^ s ^ " view ") ++ pr_term gv)
+
+let interp_view ist si env sigma gv rid =
+  match intern_term ist sigma env gv with
+  | GApp (loc, GHole _, rargs) ->
+    let rv = GApp (loc, rid, rargs) in
+    snd (interp_open_constr ist (re_sig si sigma) (rv, None))
+  | rv ->
+  let interp rc rargs =
+    interp_open_constr ist (re_sig si sigma) (mkRApp rc rargs, None) in
+  let rec simple_view rargs n =
+    if n < 0 then view_error "use" gv else
+    try interp rv rargs with _ -> simple_view (mkRHole :: rargs) (n - 1) in
+  let view_nbimps = interp_view_nbimps ist (re_sig si sigma) rv in
+  let view_args = [mkRApp rv (mkRHoles view_nbimps); rid] in
+  let rec view_with = function
+  | [] -> simple_view [rid] (interp_nbargs ist (re_sig si sigma) rv)
+  | hint :: hints -> try interp hint view_args with _ -> view_with hints in
+  snd (view_with (if view_nbimps < 0 then [] else viewtab.(0)))
+
+let top_id = mk_internal_id "top assumption"
+
+let with_view ist si env gl0 c name cl prune =
+  let c2r ist x = { ist with lfun =
+    Id.Map.add top_id (Value.of_constr x) ist.lfun } in
+  let rec loop (sigma, c') = function
+  | f :: view ->
+      let rid, ist = match kind_of_term c' with
+        | Var id -> mkRVar id, ist
+        | _ -> mkRltacVar top_id, c2r ist c' in
+      loop (interp_view ist si env sigma f rid) view
+  | [] ->
+      let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
+      let c' = Reductionops.nf_evar sigma c' in
+      let n, c', _, ucst = pf_abs_evars gl0 (sigma, c') in
+      let c' = if not prune then c' else pf_abs_cterm gl0 n c' in
+      let gl0 = pf_merge_uc ucst gl0 in
+      let gl0, ap = pf_abs_prod name gl0 c' (prod_applist cl [c]) in
+      ap, c', pf_merge_uc_of sigma gl0
+  in loop
+
+let pf_with_view ist gl (prune, view) cl c =
+  let env, sigma, si = pf_env gl, project gl, sig_it gl in
+  with_view ist si env gl c (constr_name c) cl prune (sigma, c) view
+(* }}} *)
+ 
+(** Extended intro patterns {{{ ***********************************************)
+
+type ssrtermrep = char * glob_constr_and_expr
+type ssripat =
+  | IpatSimpl of ssrclear * ssrsimpl
+  | IpatId of identifier
+  | IpatWild
+  | IpatCase of ssripats list
+  | IpatRw of ssrocc * ssrdir
+  | IpatAll
+  | IpatAnon
+  | IpatView of ssrtermrep list
+  | IpatNoop
+  | IpatNewHidden of identifier list
+and ssripats = ssripat list
+
+let remove_loc = snd
+
+let rec ipat_of_intro_pattern = function
+  | IntroNaming (IntroIdentifier id) -> IpatId id
+  | IntroAction IntroWildcard -> IpatWild
+  | IntroAction (IntroOrAndPattern (IntroOrPattern iorpat)) ->
+    IpatCase 
+      (List.map (List.map ipat_of_intro_pattern) 
+	 (List.map (List.map remove_loc) iorpat))
+  | IntroAction (IntroOrAndPattern (IntroAndPattern iandpat)) ->
+    IpatCase 
+      [List.map ipat_of_intro_pattern (List.map remove_loc iandpat)]
+  | IntroNaming IntroAnonymous -> IpatAnon
+  | IntroAction (IntroRewrite b) -> IpatRw (allocc, if b then L2R else R2L)
+  | IntroNaming (IntroFresh id) -> IpatAnon
+  | IntroAction (IntroApplyOn _) -> (* to do *) CErrors.error "TO DO"
+  | IntroAction (IntroInjection ips) ->
+      IpatCase [List.map ipat_of_intro_pattern (List.map remove_loc ips)]
+  | IntroForthcoming _ -> (* Unable to determine which kind of ipat interp_introid could return [HH] *)
+      assert false
+
+let rec pr_ipat = function
+  | IpatId id -> pr_id id
+  | IpatSimpl (clr, sim) -> pr_clear mt clr ++ pr_simpl sim
+  | IpatCase iorpat -> hov 1 (str "[" ++ pr_iorpat iorpat ++ str "]")
+  | IpatRw (occ, dir) -> pr_occ occ ++ pr_dir dir
+  | IpatAll -> str "*"
+  | IpatWild -> str "_"
+  | IpatAnon -> str "?"
+  | IpatView v -> pr_view v
+  | IpatNoop -> str "-"
+  | IpatNewHidden l -> str "[:" ++ pr_list spc pr_id l ++ str "]"
+and pr_iorpat iorpat = pr_list pr_bar pr_ipats iorpat
+and pr_ipats ipats = pr_list spc pr_ipat ipats
+
+let wit_ssripatrep = add_genarg "ssripatrep" pr_ipat
+
+let pr_ssripat _ _ _ = pr_ipat
+let pr_ssripats _ _ _ = pr_ipats
+let pr_ssriorpat _ _ _ = pr_iorpat
+
+let intern_ipat ist ipat =
+  let rec check_pat = function
+  | IpatSimpl (clr, _) -> ignore (List.map (intern_hyp ist) clr)
+  | IpatCase iorpat -> List.iter (List.iter check_pat) iorpat
+  | _ -> () in
+  check_pat ipat; ipat
+
+let intern_ipats ist = List.map (intern_ipat ist)
+
+let interp_introid ist gl id =
+ try IntroNaming (IntroIdentifier (hyp_id (snd (interp_hyp ist gl (SsrHyp (dummy_loc, id))))))
+ with _ -> snd(snd (interp_intro_pattern ist gl (dummy_loc,IntroNaming (IntroIdentifier id))))
+
+let rec add_intro_pattern_hyps (loc, ipat) hyps = match ipat with
+  | IntroNaming (IntroIdentifier id) ->
+    if not_section_id id then SsrHyp (loc, id) :: hyps else
+    hyp_err loc "Can't delete section hypothesis " id
+  | IntroAction IntroWildcard -> hyps
+  | IntroAction (IntroOrAndPattern (IntroOrPattern iorpat)) ->
+    List.fold_right (List.fold_right add_intro_pattern_hyps) iorpat hyps
+  | IntroAction (IntroOrAndPattern (IntroAndPattern iandpat)) ->
+    List.fold_right add_intro_pattern_hyps iandpat hyps
+  | IntroNaming IntroAnonymous -> []
+  | IntroNaming (IntroFresh _) -> []
+  | IntroAction (IntroRewrite _) -> hyps
+  | IntroAction (IntroInjection ips) -> List.fold_right add_intro_pattern_hyps ips hyps
+  | IntroAction (IntroApplyOn (c,pat)) -> add_intro_pattern_hyps pat hyps
+  | IntroForthcoming _ -> 
+    (* As in ipat_of_intro_pattern, was unable to determine which kind
+      of ipat interp_introid could return [HH] *) assert false
+
+let rec interp_ipat ist gl =
+  let ltacvar id = Id.Map.mem id ist.lfun in
+  let rec interp = function
+  | IpatId id when ltacvar id ->
+    ipat_of_intro_pattern (interp_introid ist gl id)
+  | IpatSimpl (clr, sim) ->
+    let add_hyps (SsrHyp (loc, id) as hyp) hyps =
+      if not (ltacvar id) then hyp :: hyps else
+      add_intro_pattern_hyps (loc, (interp_introid ist gl id)) hyps in
+    let clr' = List.fold_right add_hyps clr [] in
+    check_hyps_uniq [] clr'; IpatSimpl (clr', sim)
+  | IpatCase iorpat -> IpatCase (List.map (List.map interp) iorpat)
+  | IpatNewHidden l ->
+      IpatNewHidden
+        (List.map (function
+           | IntroNaming (IntroIdentifier id) -> id
+           | _ -> assert false)
+        (List.map (interp_introid ist gl) l))
+  | ipat -> ipat in
+  interp
+
+let interp_ipats ist gl l = project gl, List.map (interp_ipat ist gl) l
+
+let pushIpatRw = function
+  | pats :: orpat -> (IpatRw (allocc, L2R) :: pats) :: orpat
+  | [] -> []
+
+let pushIpatNoop = function
+  | pats :: orpat -> (IpatNoop :: pats) :: orpat
+  | [] -> []
+
+ARGUMENT EXTEND ssripat TYPED AS ssripatrep list PRINTED BY pr_ssripats
+  INTERPRETED BY interp_ipats
+  GLOBALIZED BY intern_ipats
+  | [ "_" ] -> [ [IpatWild] ]
+  | [ "*" ] -> [ [IpatAll] ]
+  | [ ident(id) ] -> [ [IpatId id] ]
+  | [ "?" ] -> [ [IpatAnon] ]
+  | [ ssrsimpl_ne(sim) ] -> [ [IpatSimpl ([], sim)] ]
+  | [ ssrdocc(occ) "->" ] -> [ match occ with
+      | None, occ -> [IpatRw (occ, L2R)]
+      | Some clr, _ -> [IpatSimpl (clr, Nop); IpatRw (allocc, L2R)]]
+  | [ ssrdocc(occ) "<-" ] -> [ match occ with
+      | None, occ ->  [IpatRw (occ, R2L)]
+      | Some clr, _ -> [IpatSimpl (clr, Nop); IpatRw (allocc, R2L)]]
+  | [ ssrdocc(occ) ] -> [ match occ with
+      | Some cl, _ -> check_hyps_uniq [] cl; [IpatSimpl (cl, Nop)]
+      | _ -> loc_error loc "Only identifiers are allowed here"]
+  | [ "->" ] -> [ [IpatRw (allocc, L2R)] ]
+  | [ "<-" ] -> [ [IpatRw (allocc, R2L)] ]
+  | [ "-" ] -> [ [IpatNoop] ]
+  | [ "-/" "=" ] -> [ [IpatNoop;IpatSimpl([],Simpl)] ]
+  | [ "-/=" ] -> [ [IpatNoop;IpatSimpl([],Simpl)] ]
+  | [ "-/" "/" ] -> [ [IpatNoop;IpatSimpl([],Cut)] ]
+  | [ "-//" ] -> [ [IpatNoop;IpatSimpl([],Cut)] ]
+  | [ "-/" "/=" ] -> [ [IpatNoop;IpatSimpl([],SimplCut)] ]
+  | [ "-//" "=" ] -> [ [IpatNoop;IpatSimpl([],SimplCut)] ]
+  | [ "-//=" ] -> [ [IpatNoop;IpatSimpl([],SimplCut)] ]
+  | [ ssrview(v) ] -> [ [IpatView v] ]
+  | [ "[" ":" ident_list(idl) "]" ] -> [ [IpatNewHidden idl] ]
+END
+
+ARGUMENT EXTEND ssripats TYPED AS ssripat PRINTED BY pr_ssripats
+  | [ ssripat(i) ssripats(tl) ] -> [ i @ tl ]
+  | [ ] -> [ [] ]
+END
+
+ARGUMENT EXTEND ssriorpat TYPED AS ssripat list PRINTED BY pr_ssriorpat
+| [ ssripats(pats) "|" ssriorpat(orpat) ] -> [ pats :: orpat ]
+| [ ssripats(pats) "|-" ">" ssriorpat(orpat) ] -> [ pats :: pushIpatRw orpat ]
+| [ ssripats(pats) "|-" ssriorpat(orpat) ] -> [ pats :: pushIpatNoop orpat ]
+| [ ssripats(pats) "|->" ssriorpat(orpat) ] -> [ pats :: pushIpatRw orpat ]
+| [ ssripats(pats) "||" ssriorpat(orpat) ] -> [ pats :: [] :: orpat ]
+| [ ssripats(pats) "|||" ssriorpat(orpat) ] -> [ pats :: [] :: [] :: orpat ]
+| [ ssripats(pats) "||||" ssriorpat(orpat) ] -> [ [pats; []; []; []] @ orpat ]
+| [ ssripats(pats) ] -> [ [pats] ]
+END
+
+let reject_ssrhid strm =
+  match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.KEYWORD "[" ->
+      (match Compat.get_tok (stream_nth 1 strm) with
+      | Tok.KEYWORD ":" -> raise Stream.Failure
+      | _ -> ())
+  | _ -> ()
+
+let test_nohidden = Gram.Entry.of_parser "test_ssrhid" reject_ssrhid
+
+ARGUMENT EXTEND ssrcpat TYPED AS ssripatrep PRINTED BY pr_ssripat
+  | [ "YouShouldNotTypeThis" ssriorpat(x) ] -> [ IpatCase x ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssrcpat;
+  ssrcpat: [[ test_nohidden; "["; iorpat = ssriorpat; "]" -> IpatCase iorpat ]];
+END
+
+GEXTEND Gram
+  GLOBAL: ssripat;
+  ssripat: [[ pat = ssrcpat -> [pat] ]];
+END
+
+ARGUMENT EXTEND ssripats_ne TYPED AS ssripat PRINTED BY pr_ssripats
+  | [ ssripat(i) ssripats(tl) ] -> [ i @ tl ]
+END
+
+(* subsets of patterns *)
+let check_ssrhpats loc w_binders ipats =
+  let err_loc s = CErrors.user_err_loc (loc, "ssreflect", s) in
+  let clr, ipats =
+    let rec aux clr = function
+      | IpatSimpl (cl, Nop) :: tl -> aux (clr @ cl) tl
+      | IpatSimpl (cl, sim) :: tl -> clr @ cl, IpatSimpl ([], sim) :: tl
+      | tl -> clr, tl
+    in aux [] ipats in
+  let simpl, ipats = 
+    match List.rev ipats with
+    | IpatSimpl ([],_) as s :: tl -> [s], List.rev tl
+    | _ -> [],  ipats in
+  if simpl <> [] && not w_binders then
+    err_loc (str "No s-item allowed here: " ++ pr_ipats simpl);
+  let ipat, binders =
+    let rec loop ipat = function
+      | [] -> ipat, []
+      | ( IpatId _| IpatAnon| IpatCase _| IpatRw _ as i) :: tl -> 
+        if w_binders then
+          if simpl <> [] && tl <> [] then 
+            err_loc(str"binders XOR s-item allowed here: "++pr_ipats(tl@simpl))
+          else if not (List.for_all (function IpatId _ -> true | _ -> false) tl)
+          then err_loc (str "Only binders allowed here: " ++ pr_ipats tl)
+          else ipat @ [i], tl
+        else
+          if tl = [] then  ipat @ [i], []
+          else err_loc (str "No binder or s-item allowed here: " ++ pr_ipats tl)
+      | hd :: tl -> loop (ipat @ [hd]) tl
+    in loop [] ipats in
+  ((clr, ipat), binders), simpl
+
+let single loc =
+  function [x] -> x | _ -> loc_error loc "Only one intro pattern is allowed"
+
+let pr_hpats (((clr, ipat), binders), simpl) =
+   pr_clear mt clr ++ pr_ipats ipat ++ pr_ipats binders ++ pr_ipats simpl
+let pr_ssrhpats _ _ _ = pr_hpats
+let pr_ssrhpats_wtransp _ _ _ (_, x) = pr_hpats x
+
+ARGUMENT EXTEND ssrhpats TYPED AS ((ssrclear * ssripat) * ssripat) * ssripat
+PRINTED BY pr_ssrhpats
+  | [ ssripats(i) ] -> [ check_ssrhpats loc true i ]
+END
+
+ARGUMENT EXTEND ssrhpats_wtransp
+  TYPED AS bool * (((ssrclear * ssripat) * ssripat) * ssripat)
+  PRINTED BY pr_ssrhpats_wtransp
+  | [ ssripats(i) ] -> [ false,check_ssrhpats loc true i ]
+  | [ ssripats(i) "@" ssripats(j) ] -> [ true,check_ssrhpats loc true (i @ j) ]
+END
+
+ARGUMENT EXTEND ssrhpats_nobs 
+TYPED AS ((ssrclear * ssripat) * ssripat) * ssripat PRINTED BY pr_ssrhpats
+  | [ ssripats(i) ] -> [ check_ssrhpats loc false i ]
+END
+
+ARGUMENT EXTEND ssrrpat TYPED AS ssripatrep PRINTED BY pr_ssripat
+  | [ "->" ] -> [ IpatRw (allocc, L2R) ]
+  | [ "<-" ] -> [ IpatRw (allocc, R2L) ]
+END
+
+type ssrintros = ssripats
+
+let pr_intros sep intrs =
+  if intrs = [] then mt() else sep () ++ str "=> " ++ pr_ipats intrs
+let pr_ssrintros _ _ _ = pr_intros mt
+
+ARGUMENT EXTEND ssrintros_ne TYPED AS ssripat
+ PRINTED BY pr_ssrintros
+  | [ "=>" ssripats_ne(pats) ] -> [ pats ]
+END
+
+ARGUMENT EXTEND ssrintros TYPED AS ssrintros_ne PRINTED BY pr_ssrintros
+  | [ ssrintros_ne(intrs) ] -> [ intrs ]
+  | [ ] -> [ [] ]
+END
+
+let injecteq_id = mk_internal_id "injection equation"
+
+let pf_nb_prod gl = nb_prod (pf_concl gl)
+
+let rev_id = mk_internal_id "rev concl"
+
+let revtoptac n0 gl =
+  let n = pf_nb_prod gl - n0 in
+  let dc, cl = decompose_prod_n n (pf_concl gl) in
+  let dc' = dc @ [Name rev_id, compose_prod (List.rev dc) cl] in
+  let f = compose_lam dc' (mkEtaApp (mkRel (n + 1)) (-n) 1) in
+  refine (mkApp (f, [|Evarutil.mk_new_meta ()|])) gl
+
+let equality_inj l b id c gl =
+  let msg = ref "" in
+  try Proofview.V82.of_tactic (Equality.inj l b None c) gl
+  with
+    | Compat.Exc_located(_,CErrors.UserError (_,s))
+    | CErrors.UserError (_,s)
+  when msg := Pp.string_of_ppcmds s;
+       !msg = "Not a projectable equality but a discriminable one." ||
+       !msg = "Nothing to inject." ->
+    msg_warning (str !msg);
+    discharge_hyp (id, (id, "")) gl
+
+let injectidl2rtac id c gl =
+  tclTHEN (equality_inj None true id c) (revtoptac (pf_nb_prod gl)) gl
+
+let injectl2rtac c = match kind_of_term c with
+| Var id -> injectidl2rtac id (mkVar id, NoBindings)
+| _ ->
+  let id = injecteq_id in
+  tclTHENLIST [havetac id c; injectidl2rtac id (mkVar id, NoBindings); Proofview.V82.of_tactic (clear [id])]
+
+let is_injection_case c gl =
+  let gl, cty = pf_type_of gl c in
+  let (mind,_), _ = pf_reduce_to_quantified_ind gl cty in
+  eq_gr (IndRef mind) (build_coq_eq ())
+
+let perform_injection c gl =
+  let gl, cty = pf_type_of gl c in
+  let mind, t = pf_reduce_to_quantified_ind gl cty in
+  let dc, eqt = decompose_prod t in
+  if dc = [] then injectl2rtac c gl else
+  if not (closed0 eqt) then
+    CErrors.error "can't decompose a quantified equality" else
+  let cl = pf_concl gl in let n = List.length dc in
+  let c_eq = mkEtaApp c n 2 in
+  let cl1 = mkLambda (Anonymous, mkArrow eqt cl, mkApp (mkRel 1, [|c_eq|])) in
+  let id = injecteq_id in
+  let id_with_ebind = (mkVar id, NoBindings) in
+  let injtac = tclTHEN (introid id) (injectidl2rtac id id_with_ebind) in 
+  tclTHENLAST (Proofview.V82.of_tactic (apply (compose_lam dc cl1))) injtac gl  
+
+let simplest_newcase_ref = ref (fun t gl -> assert false)
+let simplest_newcase x gl = !simplest_newcase_ref x gl
+
+let ssrscasetac c gl = 
+  if is_injection_case c gl then perform_injection c gl
+  else simplest_newcase c gl 
+
+let intro_all gl =
+  let dc, _ = Term.decompose_prod_assum (pf_concl gl) in
+  tclTHENLIST (List.map anontac (List.rev dc)) gl
+
+let rec intro_anon gl =
+  try anontac (List.hd (fst (Term.decompose_prod_n_assum 1 (pf_concl gl)))) gl
+  with err0 -> try tclTHEN (Proofview.V82.of_tactic red_in_concl) intro_anon gl with _ -> raise err0
+  (* with _ -> CErrors.error "No product even after reduction" *)
+
+let with_top tac =
+  tclTHENLIST [introid top_id; tac (mkVar top_id); Proofview.V82.of_tactic (clear [top_id])]
+
+let rec mapLR f = function [] -> [] | x :: s -> let y = f x in y :: mapLR f s
+
+let wild_ids = ref []
+
+let new_wild_id () =
+  let i = 1 + List.length !wild_ids in
+  let id = mk_wildcard_id i in
+  wild_ids := id :: !wild_ids;
+  id
+
+let clear_wilds wilds gl =
+  Proofview.V82.of_tactic (clear (List.filter (fun id -> List.mem id wilds) (pf_ids_of_hyps gl))) gl
+
+let clear_with_wilds wilds clr0 gl =
+  let extend_clr clr nd =
+    let id = NamedDecl.get_id nd in
+    if List.mem id clr || not (List.mem id wilds) then clr else
+    let vars = global_vars_set_of_decl (pf_env gl) nd in
+    let occurs id' = Idset.mem id' vars in
+    if List.exists occurs clr then id :: clr else clr in
+  Proofview.V82.of_tactic (clear (Context.Named.fold_inside extend_clr ~init:clr0 (pf_hyps gl))) gl
+
+let tclTHENS_nonstrict tac tacl taclname gl =
+  let tacres = tac gl in
+  let n_gls = List.length (sig_it tacres) in
+  let n_tac = List.length tacl in
+  if n_gls = n_tac then tclTHENS (fun _ -> tacres) tacl gl else
+  if n_gls = 0 then tacres else
+  let pr_only n1 n2 = if n1 < n2 then str "only " else mt () in
+  let pr_nb n1 n2 name =
+    pr_only n1 n2 ++ int n1 ++ str (" " ^ String.plural n1 name) in
+  errorstrm (pr_nb n_tac n_gls taclname ++ spc ()
+             ++ str "for " ++ pr_nb n_gls n_tac "subgoal")
+
+(* Forward reference to extended rewrite *)
+let ipat_rewritetac = ref (fun _ -> rewritetac)
+
+let rec is_name_in_ipats name = function
+  | IpatSimpl(clr,_) :: tl -> 
+      List.exists (function SsrHyp(_,id) -> id = name) clr 
+      || is_name_in_ipats name tl
+  | IpatId id :: tl -> id = name || is_name_in_ipats name tl
+  | IpatCase l :: tl -> is_name_in_ipats name (List.flatten l @ tl)
+  | _ :: tl -> is_name_in_ipats name tl
+  | [] -> false
+
+let move_top_with_view = ref (fun _ -> assert false)
+
+let rec nat_of_n n =
+  if n = 0 then mkConstruct path_of_O
+  else mkApp (mkConstruct path_of_S, [|nat_of_n (n-1)|])
+
+let ssr_abstract_id = Summary.ref "~name:SSR:abstractid" 0
+
+let mk_abstract_id () = incr ssr_abstract_id; nat_of_n !ssr_abstract_id
+
+let ssrmkabs id gl =
+  let env, concl = pf_env gl, pf_concl gl in
+  let step = { run = begin fun sigma ->
+    let Sigma ((abstract_proof, abstract_ty), sigma, p) =
+      let Sigma ((ty, _), sigma, p1) =
+        Evarutil.new_type_evar env sigma Evd.univ_flexible_alg in
+      let Sigma (ablock, sigma, p2) = mkSsrConst "abstract_lock" env sigma in
+      let Sigma (lock, sigma, p3) = Evarutil.new_evar env sigma ablock in
+      let Sigma (abstract, sigma, p4) = mkSsrConst "abstract" env sigma in
+      let abstract_ty = mkApp(abstract, [|ty;mk_abstract_id ();lock|]) in
+      let Sigma (m, sigma, p5) = Evarutil.new_evar env sigma abstract_ty in
+      Sigma ((m, abstract_ty), sigma, p1 +> p2 +> p3 +> p4 +> p5) in
+    let sigma, kont =
+      let rd = RelDecl.LocalAssum (Name id, abstract_ty) in
+      let Sigma (ev, sigma, _) = Evarutil.new_evar (Environ.push_rel rd env) sigma concl in
+      let sigma = Sigma.to_evar_map sigma in
+      (sigma, ev)
+    in
+    pp(lazy(pr_constr concl));
+    let term = mkApp (mkLambda(Name id,abstract_ty,kont) ,[|abstract_proof|]) in
+    let sigma, _ = Typing.type_of env sigma term in
+    Sigma.Unsafe.of_pair (term, sigma)
+  end } in
+  Proofview.V82.of_tactic
+    (Proofview.tclTHEN
+      (Tactics.New.refine step)
+      (Proofview.tclFOCUS 1 3 Proofview.shelve)) gl
+
+let ssrmkabstac ids =
+  List.fold_right (fun id tac -> tclTHENFIRST (ssrmkabs id) tac) ids tclIDTAC
+
+(* introstac: for "move" and "clear", tclEQINTROS: for "case" and "elim" *)
+(* This block hides the spaghetti-code needed to implement the only two  *)
+(* tactics that should be used to process intro patters.                 *)
+(* The difficulty is that we don't want to always rename, but we can     *)
+(* compute needeed renamings only at runtime, so we theread a tree like  *)
+(* imperativestructure so that outer renamigs are inherited by inner     *)
+(* ipts and that the cler performed at the end of ipatstac clears hyps   *)
+(* eventually renamed at runtime.                                        *)
+(* TODO: hide wild_ids in this block too *)
+let introstac, tclEQINTROS =
+  let rec map_acc_k f k = function
+    | [] -> (* tricky: we save wilds now, we get to_cler (aka k) later *)
+      let clear_ww = clear_with_wilds !wild_ids in           
+      [fun gl -> clear_ww (hyps_ids (List.flatten (List.map (!) k))) gl]
+    | x :: xs -> let k, x = f k xs x in x :: map_acc_k f k xs in
+  let rename force to_clr rest clr gl = 
+    let hyps = pf_hyps gl in
+    pp(lazy(str"rename " ++ pr_clear spc clr));
+    let () = if not force then List.iter (check_hyp_exists hyps) clr in
+    if List.exists (fun x -> force || is_name_in_ipats (hyp_id x) rest) clr then
+      let ren_clr, ren = 
+        List.split (List.map (fun x -> let x = hyp_id x in
+          let x' = mk_anon_id (string_of_id x) gl in
+          SsrHyp (dummy_loc, x'), (x, x')) clr) in
+      let () = to_clr := ren_clr in
+      Proofview.V82.of_tactic (rename_hyp ren) gl 
+    else
+      let () = to_clr := clr in
+      tclIDTAC gl in
+  let rec ipattac ?ist k rest = function
+    | IpatWild -> k, introid (new_wild_id ())
+    | IpatCase iorpat -> k, tclIORPAT ?ist k (with_top ssrscasetac) iorpat
+    | IpatRw (occ, dir) -> k, with_top (!ipat_rewritetac occ dir)
+    | IpatId id -> k, introid id
+    | IpatNewHidden idl -> k, ssrmkabstac idl
+    | IpatSimpl (clr, sim) ->
+      let to_clr = ref [] in
+      to_clr :: k, tclTHEN (rename false to_clr rest clr) (simpltac sim)
+    | IpatAll -> k, intro_all
+    | IpatAnon -> k, intro_anon
+    | IpatNoop -> k, tclIDTAC
+    | IpatView v -> match ist with
+        | None -> anomaly "ipattac with no ist but view"
+        | Some ist -> match rest with
+            | (IpatCase _ | IpatRw _)::_ -> 
+              let to_clr = ref [] in let top_id = ref top_id in
+              to_clr :: k, 
+              tclTHEN
+                (!move_top_with_view false top_id (false,v) ist)
+                (fun gl -> 
+                  rename true to_clr rest [SsrHyp (dummy_loc, !top_id)]gl)
+            | _ -> k, !move_top_with_view true (ref top_id) (true,v) ist
+  and tclIORPAT ?ist k tac = function
+    | [[]] -> tac
+    | orp -> 
+       tclTHENS_nonstrict tac (mapLR (ipatstac ?ist k) orp) "intro pattern"
+  and ipatstac ?ist k ipats = 
+    tclTHENLIST (map_acc_k (ipattac ?ist) k ipats) in
+  let introstac ?ist ipats =
+    wild_ids := [];
+    let tac = ipatstac ?ist [] ipats in
+    tclTHENLIST [tac; clear_wilds !wild_ids] in
+  let tclEQINTROS ?ist tac eqtac ipats =
+    wild_ids := [];
+    let rec split_itacs to_clr tac' = function
+    | (IpatSimpl _ as spat) :: ipats' -> 
+      let to_clr, tac = ipattac ?ist to_clr ipats' spat in
+      split_itacs to_clr (tclTHEN tac' tac) ipats'
+    | IpatCase iorpat :: ipats' -> 
+        to_clr, tclIORPAT ?ist to_clr tac' iorpat, ipats'
+    | ipats' -> to_clr, tac', ipats' in
+    let to_clr, tac1, ipats' = split_itacs [] tac ipats in
+    let tac2 = ipatstac ?ist to_clr ipats' in
+    tclTHENLIST [tac1; eqtac; tac2; clear_wilds !wild_ids] in
+  introstac, tclEQINTROS
+;;
+
+let rec eqmoveipats eqpat = function
+  | (IpatSimpl _ as ipat) :: ipats -> ipat :: eqmoveipats eqpat ipats
+  | (IpatAll :: _ | []) as ipats -> IpatAnon :: eqpat :: ipats
+   | ipat :: ipats -> ipat :: eqpat :: ipats
+
+(* General case *)
+let tclINTROS ist tac ipats = 
+  tclEQINTROS ~ist (tac ist) tclIDTAC ipats
+
+(** The "=>" tactical *)
+
+let ssrintros_sep =
+  let atom_sep = function
+    (* | TacSplit (_, [NoBindings]) -> mt *)
+    (* | TacExtend (_, "ssrapply", []) -> mt *)
+    | _ -> spc in
+  function
+    | TacId [] -> mt
+    | TacArg (_, Tacexp _) -> mt
+    | TacArg (_, Reference _) -> mt
+    | TacAtom (_, atom) -> atom_sep atom
+    | _ -> spc
+
+let pr_ssrintrosarg _ _ prt (tac, ipats) =
+  prt tacltop tac ++ pr_intros spc ipats
+
+ARGUMENT EXTEND ssrintrosarg TYPED AS tactic * ssrintros
+   PRINTED BY pr_ssrintrosarg
+| [ "YouShouldNotTypeThis" ssrtacarg(arg) ssrintros_ne(ipats) ] -> [ arg, ipats ]
+END
+
+TACTIC EXTEND ssrtclintros
+| [ "YouShouldNotTypeThis" ssrintrosarg(arg) ] ->
+  [ let tac, intros = arg in
+    Proofview.V82.tactic (tclINTROS ist (fun ist -> ssrevaltac ist tac) intros) ]
+END
+set_pr_ssrtac "tclintros" 0 [ArgSsr "introsarg"]
+
+let tclintros_expr loc tac ipats =
+  let args = [Tacexpr.TacGeneric (in_gen (rawwit wit_ssrintrosarg) (tac, ipats))] in
+  ssrtac_expr loc "tclintros" args
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  tactic_expr: LEVEL "1" [ RIGHTA
+    [ tac = tactic_expr; intros = ssrintros_ne -> tclintros_expr !@loc tac intros
+    ] ];
+END
+(* }}} *)
+
+(** Multipliers {{{ ***********************************************************)
+
+(* modality *)
+
+type ssrmmod = May | Must | Once
+
+let pr_mmod = function May -> str "?" | Must -> str "!" | Once -> mt ()
+
+let wit_ssrmmod = add_genarg "ssrmmod" pr_mmod
+let ssrmmod = Pcoq.create_generic_entry Pcoq.utactic "ssrmmod" (Genarg.rawwit wit_ssrmmod)
+GEXTEND Gram
+  GLOBAL: ssrmmod;
+  ssrmmod: [[ "!" -> Must | LEFTQMARK -> May | "?" -> May]];
+END
+
+(* tactical *)
+
+let tclID tac = tac
+
+let tclDOTRY n tac =
+  if n <= 0 then tclIDTAC else
+  let rec loop i gl =
+    if i = n then tclTRY tac gl else
+    tclTRY (tclTHEN tac (loop (i + 1))) gl in
+  loop 1
+
+let tclDO n tac =
+  let prefix i = str"At iteration " ++ int i ++ str": " in
+  let tac_err_at i gl =
+    try tac gl
+    with 
+    | CErrors.UserError (l, s) as e ->
+        let _, info = CErrors.push e in
+        let e' = CErrors.UserError (l, prefix i ++ s) in
+        Util.iraise (e', info)
+    | Compat.Exc_located(loc, CErrors.UserError (l, s))  -> 
+        raise (Compat.Exc_located(loc, CErrors.UserError (l, prefix i ++ s))) in
+  let rec loop i gl =
+    if i = n then tac_err_at i gl else
+    (tclTHEN (tac_err_at i) (loop (i + 1))) gl in
+  loop 1
+
+let tclMULT = function
+  | 0, May  -> tclREPEAT
+  | 1, May  -> tclTRY
+  | n, May  -> tclDOTRY n
+  | 0, Must -> tclAT_LEAST_ONCE
+  | n, Must when n > 1 -> tclDO n
+  | _       -> tclID
+
+(** The "do" tactical. ********************************************************)
+
+(*
+type ssrdoarg = ((ssrindex * ssrmmod) * ssrhint) * ssrclauses
+*)
+
+let pr_ssrdoarg prc _ prt (((n, m), tac), clauses) =
+  pr_index n ++ pr_mmod m ++ pr_hintarg prt tac ++ pr_clauses clauses
+
+ARGUMENT EXTEND ssrdoarg
+  TYPED AS ((ssrindex * ssrmmod) * ssrhintarg) * ssrclauses
+  PRINTED BY pr_ssrdoarg
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let ssrdotac ist (((n, m), tac), clauses) =
+  let mul = get_index n, m in
+  tclCLAUSES ist (tclMULT mul (hinttac ist false tac)) clauses
+
+TACTIC EXTEND ssrtcldo
+| [ "YouShouldNotTypeThis" "do" ssrdoarg(arg) ] -> [ Proofview.V82.tactic (ssrdotac ist arg) ]
+END
+set_pr_ssrtac "tcldo" 3 [ArgSep "do "; ArgSsr "doarg"]
+
+let ssrdotac_expr loc n m tac clauses =
+  let arg = ((n, m), tac), clauses in
+  ssrtac_expr loc "tcldo" [Tacexpr.TacGeneric (in_gen (rawwit wit_ssrdoarg) arg)]
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssrdotac: [
+    [ tac = tactic_expr LEVEL "3" -> mk_hint tac
+    | tacs = ssrortacarg -> tacs
+  ] ];
+  tactic_expr: LEVEL "3" [ RIGHTA
+    [ IDENT "do"; m = ssrmmod; tac = ssrdotac; clauses = ssrclauses ->
+      ssrdotac_expr !@loc noindex m tac clauses
+    | IDENT "do"; tac = ssrortacarg; clauses = ssrclauses ->
+      ssrdotac_expr !@loc noindex Once tac clauses
+    | IDENT "do"; n = int_or_var; m = ssrmmod;
+                  tac = ssrdotac; clauses = ssrclauses ->
+      ssrdotac_expr !@loc (mk_index !@loc n) m tac clauses
+    ] ];
+END
+(* }}} *)
+
+(** The "first" and "last" tacticals. {{{ *************************************)
+
+(* type ssrseqarg = ssrindex * (ssrtacarg * ssrtac option) *)
+
+let pr_seqtacarg prt = function
+  | (is_first, []), _ -> str (if is_first then "first" else "last")
+  | tac, Some dtac ->
+    hv 0 (pr_hintarg prt tac ++ spc() ++ str "|| " ++ prt tacltop dtac)
+  | tac, _ -> pr_hintarg prt tac
+
+let pr_ssrseqarg _ _ prt = function
+  | ArgArg 0, tac -> pr_seqtacarg prt tac
+  | i, tac -> pr_index i ++ str " " ++ pr_seqtacarg prt tac
+
+(* We must parse the index separately to resolve the conflict with *)
+(* an unindexed tactic.                                            *)
+ARGUMENT EXTEND ssrseqarg TYPED AS ssrindex * (ssrhintarg * tactic option)
+                          PRINTED BY pr_ssrseqarg
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let sq_brace_tacnames =
+   ["first"; "solve"; "do"; "rewrite"; "have"; "suffices"; "wlog"]
+   (* "by" is a keyword *)
+let accept_ssrseqvar strm =
+  match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.IDENT id when not (List.mem id sq_brace_tacnames) ->
+     accept_before_syms_or_ids ["["] ["first";"last"] strm
+  | _ -> raise Stream.Failure
+
+let test_ssrseqvar = Gram.Entry.of_parser "test_ssrseqvar" accept_ssrseqvar
+
+let swaptacarg (loc, b) = (b, []), Some (TacId [])
+
+let check_seqtacarg dir arg = match snd arg, dir with
+  | ((true, []), Some (TacAtom (loc, _))), L2R ->
+    loc_error loc "expected \"last\""
+  | ((false, []), Some (TacAtom (loc, _))), R2L ->
+    loc_error loc "expected \"first\""
+  | _, _ -> arg
+
+let ssrorelse = Gram.entry_create "ssrorelse"
+GEXTEND Gram
+  GLOBAL: ssrorelse ssrseqarg;
+  ssrseqidx: [
+    [ test_ssrseqvar; id = Prim.ident -> ArgVar (!@loc, id)
+    | n = Prim.natural -> ArgArg (check_index !@loc n)
+    ] ];
+  ssrswap: [[ IDENT "first" -> !@loc, true | IDENT "last" -> !@loc, false ]];
+  ssrorelse: [[ "||"; tac = tactic_expr LEVEL "2" -> tac ]];
+  ssrseqarg: [
+    [ arg = ssrswap -> noindex, swaptacarg arg
+    | i = ssrseqidx; tac = ssrortacarg; def = OPT ssrorelse -> i, (tac, def)
+    | i = ssrseqidx; arg = ssrswap -> i, swaptacarg arg
+    | tac = tactic_expr LEVEL "3" -> noindex, (mk_hint tac, None)
+    ] ];
+END
+
+let tclPERM perm tac gls =
+  let subgls = tac gls in
+  let sigma, subgll = Refiner.unpackage subgls in
+  let subgll' = perm subgll in
+  Refiner.repackage sigma subgll'
+(*
+let tclPERM perm tac gls =
+  let mkpft n g r =
+    {Proof_type.open_subgoals = n; Proof_type.goal = g; Proof_type.ref = r} in
+  let mkleaf g = mkpft 0 g None in
+  let mkprpft n g pr a = mkpft n g (Some (Proof_type.Prim pr, a)) in
+  let mkrpft n g c = mkprpft n g (Proof_type.Refine c) in
+  let mkipft n g =
+    let mki pft (id, _, _ as d) =
+      let g' = {g with evar_concl = mkNamedProd_or_LetIn d g.evar_concl} in
+      mkprpft n g' (Proof_type.Intro id) [pft] in
+    List.fold_left mki in
+  let gl = Refiner.sig_it gls in
+  let mkhyp subgl =
+    let rec chop_section = function
+    | (x, _, _ as d) :: e when not_section_id x -> d :: chop_section e
+    | _ -> [] in
+    let lhyps = Environ.named_context_of_val subgl.evar_hyps in
+    mk_perm_id (), subgl, chop_section lhyps in
+  let mkpfvar (hyp, subgl, lhyps) =
+    let mkarg args (lhyp, body, _) =
+      if body = None then mkVar lhyp :: args else args in
+    mkrpft 0 subgl (applist (mkVar hyp, List.fold_left mkarg [] lhyps)) [] in
+  let mkpfleaf (_, subgl, lhyps) = mkipft 1 gl (mkleaf subgl) lhyps in
+  let mkmeta _ = Evarutil.mk_new_meta () in
+  let mkhypdecl (hyp, subgl, lhyps) =
+    hyp, None, it_mkNamedProd_or_LetIn subgl.evar_concl lhyps in
+  let subgls, v as res0 = tac gls in
+  let sigma, subgll = Refiner.unpackage subgls in
+  let n = List.length subgll in if n = 0 then res0 else
+  let hyps = List.map mkhyp subgll in
+  let hyp_decls = List.map mkhypdecl (List.rev (perm hyps)) in
+  let c = applist (mkmeta (), List.map mkmeta subgll) in
+  let pft0 = mkipft 0 gl (v (List.map mkpfvar hyps)) hyp_decls in
+  let pft1 = mkrpft n gl c (pft0 :: List.map mkpfleaf (perm hyps)) in
+  let subgll', v' = Refiner.frontier pft1 in
+  Refiner.repackage sigma subgll', v'
+*)
+
+let tclREV tac gl = tclPERM List.rev tac gl
+
+let rot_hyps dir i hyps =
+  let n = List.length hyps in
+  if i = 0 then List.rev hyps else
+  if i > n then CErrors.error "Not enough subgoals" else
+  let rec rot i l_hyps = function
+    | hyp :: hyps' when i > 0 -> rot (i - 1) (hyp :: l_hyps) hyps'
+    | hyps' -> hyps' @ (List.rev l_hyps) in
+  rot (match dir with L2R -> i | R2L -> n - i) [] hyps
+
+let tclSEQAT ist atac1 dir (ivar, ((_, atacs2), atac3)) =
+  let i = get_index ivar in
+  let evtac = ssrevaltac ist in
+  let tac1 = evtac atac1 in
+  if atacs2 = [] && atac3 <> None then tclPERM (rot_hyps dir i) tac1  else
+  let evotac = function Some atac -> evtac atac | _ -> tclIDTAC in
+  let tac3 = evotac atac3 in
+  let rec mk_pad n = if n > 0 then tac3 :: mk_pad (n - 1) else [] in
+  match dir, mk_pad (i - 1), List.map evotac atacs2 with
+  | L2R, [], [tac2] when atac3 = None -> tclTHENFIRST tac1 tac2
+  | L2R, [], [tac2] when atac3 = None -> tclTHENLAST tac1 tac2
+  | L2R, pad, tacs2 -> tclTHENSFIRSTn tac1 (Array.of_list (pad @ tacs2)) tac3
+  | R2L, pad, tacs2 -> tclTHENSLASTn tac1 tac3 (Array.of_list (tacs2 @ pad))
+
+(* We can't actually parse the direction separately because this   *)
+(* would introduce conflicts with the basic ltac syntax.           *)
+let pr_ssrseqdir _ _ _ = function
+  | L2R -> str ";" ++ spc () ++ str "first "
+  | R2L -> str ";" ++ spc () ++ str "last "
+
+ARGUMENT EXTEND ssrseqdir TYPED AS ssrdir PRINTED BY pr_ssrseqdir
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+TACTIC EXTEND ssrtclseq
+| [ "YouShouldNotTypeThis" ssrtclarg(tac) ssrseqdir(dir) ssrseqarg(arg) ] ->
+  [ Proofview.V82.tactic (tclSEQAT ist tac dir arg) ]
+END
+set_pr_ssrtac "tclseq" 5 [ArgSsr "tclarg"; ArgSsr "seqdir"; ArgSsr "seqarg"]
+
+let tclseq_expr loc tac dir arg =
+  let arg1 = in_gen (rawwit wit_ssrtclarg) tac in
+  let arg2 = in_gen (rawwit wit_ssrseqdir) dir in
+  let arg3 = in_gen (rawwit wit_ssrseqarg) (check_seqtacarg dir arg) in
+  ssrtac_expr loc "tclseq" (List.map (fun x -> Tacexpr.TacGeneric x) [arg1; arg2; arg3])
+
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  ssr_first: [
+    [ tac = ssr_first; ipats = ssrintros_ne -> tclintros_expr !@loc tac ipats
+    | "["; tacl = LIST0 tactic_expr SEP "|"; "]" -> TacFirst tacl
+    ] ];
+  ssr_first_else: [
+    [ tac1 = ssr_first; tac2 = ssrorelse -> TacOrelse (tac1, tac2)
+    | tac = ssr_first -> tac ]];
+  tactic_expr: LEVEL "4" [ LEFTA
+    [ tac1 = tactic_expr; ";"; IDENT "first"; tac2 = ssr_first_else ->
+      TacThen (tac1, tac2)
+    | tac = tactic_expr; ";"; IDENT "first"; arg = ssrseqarg ->
+      tclseq_expr !@loc tac L2R arg
+    | tac = tactic_expr; ";"; IDENT "last"; arg = ssrseqarg ->
+      tclseq_expr !@loc tac R2L arg
+    ] ];
+END
+(* }}} *)
+
+(** 5. Bookkeeping tactics (clear, move, case, elim) *)
+
+(* post-interpretation of terms *)
+let all_ok _ _ = true
+
+let pf_abs_ssrterm ?(resolve_typeclasses=false) ist gl t =
+  let sigma, ct as t = interp_term ist gl t in
+  let sigma, _ as t =
+    let env = pf_env gl in
+    if not resolve_typeclasses then t
+    else
+       let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
+       sigma, Evarutil.nf_evar sigma ct in
+  let n, c, abstracted_away, ucst = pf_abs_evars gl t in
+  List.fold_left Evd.remove sigma abstracted_away, pf_abs_cterm gl n c, ucst, n
+
+let pf_interp_ty ?(resolve_typeclasses=false) ist gl ty =
+   let n_binders = ref 0 in
+   let ty = match ty with
+   | a, (t, None) ->
+     let rec force_type = function
+     | GProd (l, x, k, s, t) -> incr n_binders; GProd (l, x, k, s, force_type t)
+     | GLetIn (l, x, v, t) -> incr n_binders; GLetIn (l, x, v, force_type t)
+     | ty -> mkRCast ty mkRType in
+     a, (force_type t, None)
+   | _, (_, Some ty) ->
+     let rec force_type = function
+     | CProdN (l, abs, t) ->
+       n_binders := !n_binders +  List.length (List.flatten (List.map pi1 abs));
+       CProdN (l, abs, force_type t)
+     | CLetIn (l, n, v, t) -> incr n_binders; CLetIn (l, n, v, force_type t)
+     | ty -> mkCCast dummy_loc ty (mkCType dummy_loc) in
+     mk_term ' ' (force_type ty) in
+   let strip_cast (sigma, t) =
+     let rec aux t = match kind_of_type t with
+     | CastType (t, ty) when !n_binders = 0 && isSort ty -> t
+     | ProdType(n,s,t) -> decr n_binders; mkProd (n, s, aux t)
+     | LetInType(n,v,ty,t) -> decr n_binders; mkLetIn (n, v, ty, aux t)
+     | _ -> anomaly "pf_interp_ty: ssr Type cast deleted by typecheck" in
+     sigma, aux t in
+   let sigma, cty as ty = strip_cast (interp_term ist gl ty) in
+   let ty =
+     let env = pf_env gl in
+     if not resolve_typeclasses then ty
+     else
+       let sigma = Typeclasses.resolve_typeclasses ~fail:false env sigma in
+       sigma, Evarutil.nf_evar sigma cty in
+   let n, c, _, ucst = pf_abs_evars gl ty in
+   let lam_c = pf_abs_cterm gl n c in
+   let ctx, c = decompose_lam_n n lam_c in
+   n, compose_prod ctx c, lam_c, ucst
+;;
+
+let whd_app f args = Reductionops.whd_betaiota Evd.empty (mkApp (f, args))
+
+let pr_cargs a =
+  str "[" ++ pr_list pr_spc pr_constr (Array.to_list a) ++ str "]"
+
+let pp_term gl t =
+  let t = Reductionops.nf_evar (project gl) t in pr_constr t
+let pp_concat hd ?(sep=str", ") = function [] -> hd | x :: xs ->
+  hd ++ List.fold_left (fun acc x -> acc ++ sep ++ x) x xs
+
+let fake_pmatcher_end () =
+  mkProp, L2R, (Evd.empty, Evd.empty_evar_universe_context, mkProp)
+
+(* TASSI: given (c : ty), generates (c ??? : ty[???/...]) with m evars *)
+exception NotEnoughProducts
+let prof_saturate_whd = mk_profiler "saturate.whd";;
+let saturate ?(beta=false) ?(bi_types=false) env sigma c ?(ty=Retyping.get_type_of env sigma c) m 
+=
+  let rec loop ty args sigma n = 
+  if n = 0 then 
+    let args = List.rev args in
+     (if beta then Reductionops.whd_beta sigma else fun x -> x)
+      (mkApp (c, Array.of_list (List.map snd args))), ty, args, sigma 
+  else match kind_of_type ty with
+  | ProdType (_, src, tgt) ->
+      let sigma = create_evar_defs sigma in
+      let sigma = Sigma.Unsafe.of_evar_map sigma in
+      let Sigma (x, sigma, _) =
+        Evarutil.new_evar env sigma
+          (if bi_types then Reductionops.nf_betaiota (Sigma.to_evar_map sigma) src else src) in
+      let sigma = Sigma.to_evar_map sigma in
+      loop (subst1 x tgt) ((m - n,x) :: args) sigma (n-1)
+  | CastType (t, _) -> loop t args sigma n 
+  | LetInType (_, v, _, t) -> loop (subst1 v t) args sigma n
+  | SortType _ -> assert false
+  | AtomicType _ ->
+      let ty = 
+        prof_saturate_whd.profile      
+        (Reductionops.whd_all env sigma) ty in
+      match kind_of_type ty with
+      | ProdType _ -> loop ty args sigma n
+      | _ -> raise NotEnoughProducts
+  in
+   loop ty [] sigma m
+
+let pf_saturate ?beta ?bi_types gl c ?ty m = 
+  let env, sigma, si = pf_env gl, project gl, sig_it gl in
+  let t, ty, args, sigma = saturate ?beta ?bi_types env sigma c ?ty m in
+  t, ty, args, re_sig si sigma 
+
+(** Rewrite redex switch *)
+
+(** Generalization (discharge) item *)
+
+(* An item is a switch + term pair.                                     *)
+
+(* type ssrgen = ssrdocc * ssrterm *)
+
+let pr_gen (docc, dt) = pr_docc docc ++ pr_cpattern dt
+
+let pr_ssrgen _ _ _ = pr_gen
+
+ARGUMENT EXTEND ssrgen TYPED AS ssrdocc * cpattern PRINTED BY pr_ssrgen
+| [ ssrdocc(docc) cpattern(dt) ] -> [ docc, dt ]
+| [ cpattern(dt) ] -> [ nodocc, dt ]
+END
+
+let has_occ ((_, occ), _) = occ <> None
+let hyp_of_var v =  SsrHyp (dummy_loc, destVar v)
+
+let interp_clr = function
+| Some clr, (k, c) 
+  when (k = ' '  || k = '@') && is_pf_var c -> hyp_of_var c :: clr 
+| Some clr, _ -> clr
+| None, _ -> []
+
+(* XXX the k of the redex should percolate out *)
+let pf_interp_gen_aux ist gl to_ind ((oclr, occ), t) =
+  let pat = interp_cpattern ist gl t None in (* UGLY API *)
+  let cl, env, sigma = pf_concl gl, pf_env gl, project gl in
+  let (c, ucst), cl = 
+    try fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
+    with NoMatch -> redex_of_pattern env pat, cl in
+  let clr = interp_clr (oclr, (tag_of_cpattern t, c)) in
+  if not(occur_existential c) then
+    if tag_of_cpattern t = '@' then 
+      if not (isVar c) then
+	errorstrm (str "@ can be used with variables only")
+      else match NamedDecl.to_tuple (pf_get_hyp gl (destVar c)) with
+      | _, None, _ -> errorstrm (str "@ can be used with let-ins only")
+      | name, Some bo, ty -> true, pat, mkLetIn (Name name,bo,ty,cl),c,clr,ucst,gl
+    else let gl, ccl =  pf_mkprod gl c cl in false, pat, ccl, c, clr,ucst,gl
+  else if to_ind && occ = None then
+    let nv, p, _, ucst' = pf_abs_evars gl (fst pat, c) in
+    let ucst = Evd.union_evar_universe_context ucst ucst' in
+    if nv = 0 then anomaly "occur_existential but no evars" else
+    let gl, pty = pf_type_of gl p in
+    false, pat, mkProd (constr_name c, pty, pf_concl gl), p, clr,ucst,gl
+  else loc_error (loc_of_cpattern t) "generalized term didn't match"
+
+let genclrtac cl cs clr =
+  let tclmyORELSE tac1 tac2 gl =
+    try tac1 gl
+    with e when CErrors.noncritical e -> tac2 e gl in
+  (* apply_type may give a type error, but the useful message is
+   * the one of clear.  You type "move: x" and you get
+   * "x is used in hyp H" instead of
+   * "The term H has type T x but is expected to have type T x0". *)
+  tclTHEN
+    (tclmyORELSE
+      (apply_type cl cs)
+      (fun type_err gl ->
+         tclTHEN
+           (tclTHEN (Proofview.V82.of_tactic (elim_type (build_coq_False ()))) (cleartac clr))
+           (fun gl -> raise type_err)
+           gl))
+    (cleartac clr)
+
+let gentac ist gen gl =
+(*   pp(lazy(str"sigma@gentac=" ++ pr_evar_map None (project gl))); *)
+  let conv, _, cl, c, clr, ucst,gl = pf_interp_gen_aux ist gl false gen in
+  pp(lazy(str"c@gentac=" ++ pr_constr c));
+  let gl = pf_merge_uc ucst gl in
+  if conv
+  then tclTHEN (Proofview.V82.of_tactic (convert_concl cl)) (cleartac clr) gl
+  else genclrtac cl [c] clr gl
+
+let pf_interp_gen ist gl to_ind gen =
+  let _, _, a, b, c, ucst,gl = pf_interp_gen_aux ist gl to_ind gen in
+  a, b ,c, pf_merge_uc ucst gl
+
+(** Generalization (discharge) sequence *)
+
+(* A discharge sequence is represented as a list of up to two   *)
+(* lists of d-items, plus an ident list set (the possibly empty *)
+(* final clear switch). The main list is empty iff the command  *)
+(* is defective, and has length two if there is a sequence of   *)
+(* dependent terms (and in that case it is the first of the two *)
+(* lists). Thus, the first of the two lists is never empty.     *)
+
+(* type ssrgens = ssrgen list *)
+(* type ssrdgens = ssrgens list * ssrclear *)
+
+let gens_sep = function [], [] -> mt | _ -> spc
+
+let pr_dgens pr_gen (gensl, clr) =
+  let prgens s gens = str s ++ pr_list spc pr_gen gens in
+  let prdeps deps = prgens ": " deps ++ spc () ++ str "/" in
+  match gensl with
+  | [deps; []] -> prdeps deps ++ pr_clear pr_spc clr
+  | [deps; gens] -> prdeps deps ++ prgens " " gens ++ pr_clear spc clr
+  | [gens] -> prgens ": " gens ++ pr_clear spc clr
+  | _ -> pr_clear pr_spc clr
+
+let pr_ssrdgens _ _ _ = pr_dgens pr_gen
+
+let cons_gen gen = function
+  | gens :: gensl, clr -> (gen :: gens) :: gensl, clr
+  | _ -> anomaly "missing gen list"
+
+let cons_dep (gensl, clr) =
+  if List.length gensl = 1 then ([] :: gensl, clr) else
+  CErrors.error "multiple dependents switches '/'"
+
+ARGUMENT EXTEND ssrdgens_tl TYPED AS ssrgen list list * ssrclear
+                            PRINTED BY pr_ssrdgens
+| [ "{" ne_ssrhyp_list(clr) "}" cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (mkclr clr, dt) dgens ]
+| [ "{" ne_ssrhyp_list(clr) "}" ] ->
+  [ [[]], clr ]
+| [ "{" ssrocc(occ) "}" cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (mkocc occ, dt) dgens ]
+| [ "/" ssrdgens_tl(dgens) ] ->
+  [ cons_dep dgens ]
+| [ cpattern(dt) ssrdgens_tl(dgens) ] ->
+  [ cons_gen (nodocc, dt) dgens ]
+| [ ] ->
+  [ [[]], [] ]
+END
+
+ARGUMENT EXTEND ssrdgens TYPED AS ssrdgens_tl PRINTED BY pr_ssrdgens
+| [ ":" ssrgen(gen) ssrdgens_tl(dgens) ] -> [ cons_gen gen dgens ]
+END
+
+let genstac (gens, clr) ist =
+  tclTHENLIST (cleartac clr :: List.rev_map (gentac ist) gens)
+
+(* Common code to handle generalization lists along with the defective case *)
+
+let with_defective maintac deps clr ist gl =
+  let top_id =
+    match kind_of_type (pf_concl gl) with
+    | ProdType (Name id, _, _)
+      when has_discharged_tag (string_of_id id) -> id
+    | _ -> top_id in
+  let top_gen = mkclr clr, cpattern_of_id top_id in
+  tclTHEN (introid top_id) (maintac deps top_gen ist) gl
+
+let with_dgens (gensl, clr) maintac ist = match gensl with
+  | [deps; []] -> with_defective maintac deps clr ist
+  | [deps; gen :: gens] ->
+    tclTHEN (genstac (gens, clr) ist) (maintac deps gen ist)
+  | [gen :: gens] -> tclTHEN (genstac (gens, clr) ist) (maintac [] gen ist)
+  | _ -> with_defective maintac [] clr ist
+
+let first_goal gls =
+  let gl = gls.Evd.it and sig_0 = gls.Evd.sigma in
+  if List.is_empty gl then CErrors.error "first_goal";
+  { Evd.it = List.hd gl; Evd.sigma = sig_0; }
+
+let with_deps deps0 maintac cl0 cs0 clr0 ist gl0 =
+  let rec loop gl cl cs clr args clrs = function
+  | [] ->
+    let n = List.length args in
+    maintac (if n > 0 then applist (to_lambda n cl, args) else cl) clrs ist gl0
+  | dep :: deps ->
+    let gl' = first_goal (genclrtac cl cs clr gl) in
+    let cl', c', clr',gl' = pf_interp_gen ist gl' false dep in
+    loop gl' cl' [c'] clr' (c' :: args) (clr' :: clrs) deps in
+  loop gl0 cl0 cs0 clr0 cs0 [clr0] (List.rev deps0)
+
+(** Equations *)
+
+(* argument *)
+
+type ssreqid = ssripat option
+
+let pr_eqid = function Some pat -> str " " ++ pr_ipat pat | None -> mt ()
+let pr_ssreqid _ _ _ = pr_eqid
+
+(* We must use primitive parsing here to avoid conflicts with the  *)
+(* basic move, case, and elim tactics.                             *)
+ARGUMENT EXTEND ssreqid TYPED AS ssripatrep option PRINTED BY pr_ssreqid
+| [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let accept_ssreqid strm =
+  match Compat.get_tok (Util.stream_nth 0 strm) with
+  | Tok.IDENT _ -> accept_before_syms [":"] strm
+  | Tok.KEYWORD ":" -> ()
+  | Tok.KEYWORD pat when List.mem pat ["_"; "?"; "->"; "<-"] ->
+                      accept_before_syms [":"] strm
+  | _ -> raise Stream.Failure
+
+let test_ssreqid = Gram.Entry.of_parser "test_ssreqid" accept_ssreqid
+
+GEXTEND Gram
+  GLOBAL: ssreqid;
+  ssreqpat: [
+    [ id = Prim.ident -> IpatId id
+    | "_" -> IpatWild
+    | "?" -> IpatAnon
+    | occ = ssrdocc; "->" -> (match occ with
+      | None, occ -> IpatRw (occ, L2R)
+      | _ -> loc_error !@loc "Only occurrences are allowed here")
+    | occ = ssrdocc; "<-" -> (match occ with
+      | None, occ ->  IpatRw (occ, R2L)
+      | _ -> loc_error !@loc "Only occurrences are allowed here")
+    | "->" -> IpatRw (allocc, L2R)
+    | "<-" -> IpatRw (allocc, R2L)
+    ]];
+  ssreqid: [
+    [ test_ssreqid; pat = ssreqpat -> Some pat
+    | test_ssreqid -> None
+    ]];
+END
+
+(* creation *)
+
+let mkEq dir cl c t n gl =
+  let eqargs = [|t; c; c|] in eqargs.(dir_org dir) <- mkRel n;
+  let eq, gl = pf_fresh_global (build_coq_eq()) gl in 
+  let refl, gl = mkRefl t c gl in
+  mkArrow (mkApp (eq, eqargs)) (lift 1 cl), refl, gl
+
+let pushmoveeqtac cl c gl =
+  let x, t, cl1 = destProd cl in
+  let cl2, eqc, gl = mkEq R2L cl1 c t 1 gl in
+  apply_type (mkProd (x, t, cl2)) [c; eqc] gl
+
+let pushcaseeqtac cl gl =
+  let cl1, args = destApplication cl in
+  let n = Array.length args in
+  let dc, cl2 = decompose_lam_n n cl1 in
+  let _, t = List.nth dc (n - 1) in
+  let cl3, eqc, gl = mkEq R2L cl2 args.(0) t n gl in
+  let gl, clty = pf_type_of gl cl in
+  let prot, gl = mkProt clty cl3 gl in
+  let cl4 = mkApp (compose_lam dc prot, args) in
+  let gl, _ = pf_e_type_of gl cl4 in
+  tclTHEN (apply_type cl4 [eqc])
+    (Proofview.V82.of_tactic (convert_concl cl4)) gl
+
+let pushelimeqtac gl =
+  let _, args = destApplication (pf_concl gl) in
+  let x, t, _ = destLambda args.(1) in
+  let cl1 = mkApp (args.(1), Array.sub args 2 (Array.length args - 2)) in
+  let cl2, eqc, gl = mkEq L2R cl1 args.(2) t 1 gl in
+  tclTHEN (apply_type (mkProd (x, t, cl2)) [args.(2); eqc])
+    (Proofview.V82.of_tactic intro) gl
+
+(** Bookkeeping (discharge-intro) argument *)
+
+(* Since all bookkeeping ssr commands have the same discharge-intro    *)
+(* argument format we use a single grammar entry point to parse them.  *)
+(* the entry point parses only non-empty arguments to avoid conflicts  *)
+(* with the basic Coq tactics.                                         *)
+
+(* type ssrarg = ssrview * (ssreqid * (ssrdgens * ssripats)) *)
+
+let pr_ssrarg _ _ _ (view, (eqid, (dgens, ipats))) =
+  let pri = pr_intros (gens_sep dgens) in
+  pr_view view ++ pr_eqid eqid ++ pr_dgens pr_gen dgens ++ pri ipats
+
+ARGUMENT EXTEND ssrarg TYPED AS ssrview * (ssreqid * (ssrdgens * ssrintros))
+   PRINTED BY pr_ssrarg
+| [ ssrview(view) ssreqid(eqid) ssrdgens(dgens) ssrintros(ipats) ] ->
+  [ view, (eqid, (dgens, ipats)) ]
+| [ ssrview(view) ssrclear(clr) ssrintros(ipats) ] ->
+  [ view, (None, (([], clr), ipats)) ]
+| [ ssreqid(eqid) ssrdgens(dgens) ssrintros(ipats) ] ->
+  [ [], (eqid, (dgens, ipats)) ]
+| [ ssrclear_ne(clr) ssrintros(ipats) ] ->
+  [ [], (None, (([], clr), ipats)) ]
+| [ ssrintros_ne(ipats) ] ->
+  [ [], (None, (([], []), ipats)) ]
+END
+
+(** The "clear" tactic *)
+
+(* We just add a numeric version that clears the n top assumptions. *)
+
+let poptac ist n = introstac ~ist (List.init n (fun _ -> IpatWild))
+
+TACTIC EXTEND ssrclear
+  | [ "clear" natural(n) ] -> [ Proofview.V82.tactic (poptac ist n) ]
+END
+
+(** The "move" tactic *)
+
+let rec improper_intros = function
+  | IpatSimpl _ :: ipats -> improper_intros ipats
+  | (IpatId _ | IpatAnon | IpatCase _ | IpatAll) :: _ -> false
+  | _ -> true
+
+let check_movearg = function
+  | view, (eqid, _) when view <> [] && eqid <> None ->
+    CErrors.error "incompatible view and equation in move tactic"
+  | view, (_, (([gen :: _], _), _)) when view <> [] && has_occ gen ->
+    CErrors.error "incompatible view and occurrence switch in move tactic"
+  | _, (_, ((dgens, _), _)) when List.length dgens > 1 ->
+    CErrors.error "dependents switch `/' in move tactic"
+  | _, (eqid, (_, ipats)) when eqid <> None && improper_intros ipats ->
+    CErrors.error "no proper intro pattern for equation in move tactic"
+  | arg -> arg
+
+ARGUMENT EXTEND ssrmovearg TYPED AS ssrarg PRINTED BY pr_ssrarg
+| [ ssrarg(arg) ] -> [ check_movearg arg ]
+END
+
+let viewmovetac_aux clear name_ref (_, vl as v) _ gen ist gl =
+  let cl, c, clr, gl, gen_pat =
+    let _, gen_pat, a, b, c, ucst, gl = pf_interp_gen_aux ist gl false gen in
+    a, b ,c, pf_merge_uc ucst gl, gen_pat in
+  let cl, c, gl = if vl = [] then cl, c, gl else pf_with_view ist gl v cl c in
+  let clr = if clear then clr else [] in
+  name_ref := (match id_of_pattern gen_pat with Some id -> id | _ -> top_id);
+  genclrtac cl [c] clr gl
+
+let () = move_top_with_view := 
+   (fun c r v -> with_defective (viewmovetac_aux c r v) [] [])
+
+let viewmovetac v deps gen ist gl = 
+  viewmovetac_aux true (ref top_id) v deps gen ist gl
+
+let eqmovetac _ gen ist gl =
+  let cl, c, _, gl = pf_interp_gen ist gl false gen in pushmoveeqtac cl c gl
+
+let movehnftac gl = match kind_of_term (pf_concl gl) with
+  | Prod _ | LetIn _ -> tclIDTAC gl
+  | _ -> Proofview.V82.of_tactic hnf_in_concl gl
+
+let ssrmovetac ist = function
+  | _::_ as view, (_, (dgens, ipats)) ->
+    let dgentac = with_dgens dgens (viewmovetac (true, view)) ist in
+    tclTHEN dgentac (introstac ~ist ipats)
+  | _, (Some pat, (dgens, ipats)) ->
+    let dgentac = with_dgens dgens eqmovetac ist in
+    tclTHEN dgentac (introstac ~ist (eqmoveipats pat ipats))
+  | _, (_, (([gens], clr), ipats)) ->
+    let gentac = genstac (gens, clr) ist in
+    tclTHEN gentac (introstac ~ist ipats)
+  | _, (_, ((_, clr), ipats)) ->
+    tclTHENLIST [movehnftac; cleartac clr; introstac ~ist ipats]
+
+TACTIC EXTEND ssrmove
+| [ "move" ssrmovearg(arg) ssrrpat(pat) ] ->
+  [ Proofview.V82.tactic (tclTHEN (ssrmovetac ist arg) (introstac ~ist [pat])) ]
+| [ "move" ssrmovearg(arg) ssrclauses(clauses) ] ->
+  [ Proofview.V82.tactic (tclCLAUSES ist (ssrmovetac ist arg) clauses) ]
+| [ "move" ssrrpat(pat) ] -> [ Proofview.V82.tactic (introstac ~ist [pat]) ]
+| [ "move" ] -> [ Proofview.V82.tactic (movehnftac) ]
+END
+
+(* TASSI: given the type of an elimination principle, it finds the higher order
+ * argument (index), it computes it's arity and the arity of the eliminator and
+ * checks if the eliminator is recursive or not *)
+let analyze_eliminator elimty env sigma =
+  let rec loop ctx t = match kind_of_type t with
+  | AtomicType (hd, args) when isRel hd -> 
+    ctx, destRel hd, not (noccurn 1 t), Array.length args
+  | CastType (t, _) -> loop ctx t
+  | ProdType (x, ty, t) -> loop (RelDecl.LocalAssum (x, ty) :: ctx) t
+  | LetInType (x,b,ty,t) -> loop (RelDecl.LocalDef (x, b, ty) :: ctx) (subst1 b t)
+  | _ ->
+    let env' = Environ.push_rel_context ctx env in
+    let t' = Reductionops.whd_all env' sigma t in
+    if not (Term.eq_constr t t') then loop ctx t' else
+      errorstrm (str"The eliminator has the wrong shape."++spc()++
+      str"A (applied) bound variable was expected as the conclusion of "++
+      str"the eliminator's"++Pp.cut()++str"type:"++spc()++pr_constr elimty) in
+  let ctx, pred_id, elim_is_dep, n_pred_args = loop [] elimty in
+  let n_elim_args = Context.Rel.nhyps ctx in
+  let is_rec_elim = 
+     let count_occurn n term =
+       let count = ref 0 in
+       let rec occur_rec n c = match kind_of_term c with
+         | Rel m -> if m = n then incr count
+         | _ -> iter_constr_with_binders succ occur_rec n c
+       in
+       occur_rec n term; !count in
+     let occurr2 n t = count_occurn n t > 1 in
+     not (List.for_all_i 
+       (fun i (_,rd) -> pred_id <= i || not (occurr2 (pred_id - i) rd))
+       1 (assums_of_rel_context ctx))
+  in
+  n_elim_args - pred_id, n_elim_args, is_rec_elim, elim_is_dep, n_pred_args
+  
+(* TASSI: This version of unprotects inlines the unfold tactic definition, 
+ * since we don't want to wipe out let-ins, and it seems there is no flag
+ * to change that behaviour in the standard unfold code *)
+let unprotecttac gl =
+  let c, gl = pf_mkSsrConst "protect_term" gl in
+  let prot, _ = destConst c in
+  onClause (fun idopt ->
+    let hyploc = Option.map (fun id -> id, InHyp) idopt in
+    Proofview.V82.of_tactic (reduct_option 
+      (Reductionops.clos_norm_flags 
+        (CClosure.RedFlags.mkflags 
+          [CClosure.RedFlags.fBETA;
+           CClosure.RedFlags.fCONST prot;
+           CClosure.RedFlags.fMATCH;
+           CClosure.RedFlags.fFIX;
+           CClosure.RedFlags.fCOFIX]), DEFAULTcast) hyploc))
+    allHypsAndConcl gl
+
+let dependent_apply_error =
+  try CErrors.error "Could not fill dependent hole in \"apply\"" with err -> err
+
+(* TASSI: Sometimes Coq's apply fails. According to my experience it may be
+ * related to goals that are products and with beta redexes. In that case it
+ * guesses the wrong number of implicit arguments for your lemma. What follows
+ * is just like apply, but with a user-provided number n of implicits.
+ *
+ * Refine.refine function that handles type classes and evars but fails to
+ * handle "dependently typed higher order evars". 
+ *
+ * Refiner.refiner that does not handle metas with a non ground type but works
+ * with dependently typed higher order metas. *)
+let applyn ~with_evars ?beta ?(with_shelve=false) n t gl =
+  if with_evars then
+    let refine gl =
+      let t, ty, args, gl = pf_saturate ?beta ~bi_types:true gl t n in
+(*       pp(lazy(str"sigma@saturate=" ++ pr_evar_map None (project gl))); *)
+      let gl = pf_unify_HO gl ty (pf_concl gl) in
+      let gs = CList.map_filter (fun (_, e) ->
+        if isEvar (pf_nf_evar gl e) then Some e else None)
+        args in
+      pf_partial_solution gl t gs
+    in
+    Proofview.(V82.of_tactic
+      (tclTHEN (V82.tactic refine)
+        (if with_shelve then shelve_unifiable else tclUNIT ()))) gl
+  else
+    let t, gl = if n = 0 then t, gl else
+      let sigma, si = project gl, sig_it gl in
+      let rec loop sigma bo args = function (* saturate with metas *)
+        | 0 -> mkApp (t, Array.of_list (List.rev args)), re_sig si sigma 
+        | n -> match kind_of_term bo with
+          | Lambda (_, ty, bo) -> 
+              if not (closed0 ty) then raise dependent_apply_error;
+              let m = Evarutil.new_meta () in
+              loop (meta_declare m ty sigma) bo ((mkMeta m)::args) (n-1)
+          | _ -> assert false
+      in loop sigma t [] n in
+    pp(lazy(str"Refiner.refiner " ++ pr_constr t));
+    Refiner.refiner (Proof_type.Refine t) gl
+
+let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc gl =
+  let rec mkRels = function 1 -> [] | n -> mkRel n :: mkRels (n-1) in
+  let uct = Evd.evar_universe_context (fst oc) in
+  let n, oc = pf_abs_evars_pirrel gl oc in
+  let gl = pf_unsafe_merge_uc uct gl in
+  let oc = if not first_goes_last || n <= 1 then oc else
+    let l, c = decompose_lam oc in
+    if not (List.for_all_i (fun i (_,t) -> closedn ~-i t) (1-n) l) then oc else
+    compose_lam (let xs,y = List.chop (n-1) l in y @ xs) 
+      (mkApp (compose_lam l c, Array.of_list (mkRel 1 :: mkRels n)))
+  in
+  pp(lazy(str"after: " ++ pr_constr oc));
+  try applyn ~with_evars ~with_shelve:true ?beta n oc gl
+  with e when CErrors.noncritical e -> raise dependent_apply_error
+
+let pf_fresh_inductive_instance ind gl =
+  let sigma, env, it = project gl, pf_env gl, sig_it gl in
+  let sigma, indu = Evd.fresh_inductive_instance env sigma ind in
+  indu, re_sig it sigma
+
+(** The "case" and "elim" tactic *)
+
+(* A case without explicit dependent terms but with both a view and an    *)
+(* occurrence switch and/or an equation is treated as dependent, with the *)
+(* viewed term as the dependent term (the occurrence switch would be      *)
+(* meaningless otherwise). When both a view and explicit dependents are   *)
+(* present, it is forbidden to put a (meaningless) occurrence switch on   *)
+(* the viewed term.                                                       *)
+
+(* This is both elim and case (defaulting to the former). If ~elim is omitted
+ * the standard eliminator is chosen. The code is made of 4 parts:
+ * 1. find the eliminator if not given as ~elim and analyze it
+ * 2. build the patterns to be matched against the conclusion, looking at
+ *    (occ, c), deps and the pattern inferred from the type of the eliminator
+ * 3. build the new predicate matching the patterns, and the tactic to 
+ *    generalize the equality in case eqid is not None
+ * 4. build the tactic handle intructions and clears as required in ipats and
+ *    by eqid *)
+let ssrelim ?(is_case=false) ?ist deps what ?elim eqid ipats gl =
+  (* some sanity checks *)
+  let oc, orig_clr, occ, c_gen, gl = match what with
+  | `EConstr(_,_,t) when isEvar t ->
+    anomaly "elim called on a constr evar"
+  | `EGen _ when ist = None ->
+    anomaly "no ist and non simple elimination"
+  | `EGen (_, g) when elim = None && is_wildcard g ->
+       errorstrm(str"Indeterminate pattern and no eliminator")
+  | `EGen ((Some clr,occ), g) when is_wildcard g ->
+       None, clr, occ, None, gl
+  | `EGen ((None, occ), g) when is_wildcard g -> None,[],occ,None,gl
+  | `EGen ((_, occ), p as gen) ->
+       let _, c, clr,gl = pf_interp_gen (Option.get ist) gl true gen in
+       Some c, clr, occ, Some p,gl
+  | `EConstr (clr, occ, c) -> Some c, clr, occ, None,gl in
+  let orig_gl, concl, env = gl, pf_concl gl, pf_env gl in
+  pp(lazy(str(if is_case then "==CASE==" else "==ELIM==")));
+  (* Utils of local interest only *)
+  let iD s ?t gl = let t = match t with None -> pf_concl gl | Some x -> x in
+    pp(lazy(str s ++ pr_constr t)); tclIDTAC gl in
+  let eq, gl = pf_fresh_global (build_coq_eq ()) gl in
+  let protectC, gl = pf_mkSsrConst "protect_term" gl in
+  let fire_subst gl t = Reductionops.nf_evar (project gl) t in
+  let fire_sigma sigma t = Reductionops.nf_evar sigma t in
+  let is_undef_pat = function
+  | sigma, T t ->  
+      (match kind_of_term (fire_sigma sigma t) with Evar _ -> true | _ -> false)
+  | _ -> false in
+  let match_pat env p occ h cl = 
+    let sigma0 = project orig_gl in
+    pp(lazy(str"matching: " ++ pr_occ occ ++ pp_pattern p));
+    let (c,ucst), cl =
+      fill_occ_pattern ~raise_NoMatch:true env sigma0 cl p occ h in
+    pp(lazy(str"     got: " ++ pr_constr c));
+    c, cl, ucst in
+  let mkTpat gl t = (* takes a term, refreshes it and makes a T pattern *)
+    let n, t, _, ucst = pf_abs_evars orig_gl (project gl, fire_subst gl t) in 
+    let t, _, _, sigma = saturate ~beta:true env (project gl) t n in
+    Evd.merge_universe_context sigma ucst, T t in
+  let unif_redex gl (sigma, r as p) t = (* t is a hint for the redex of p *)
+    let n, t, _, ucst = pf_abs_evars orig_gl (project gl, fire_subst gl t) in 
+    let t, _, _, sigma = saturate ~beta:true env sigma t n in
+    let sigma = Evd.merge_universe_context sigma ucst in
+    match r with
+    | X_In_T (e, p) -> sigma, E_As_X_In_T (t, e, p)
+    | _ ->
+       try unify_HO env sigma t (fst (redex_of_pattern env p)), r
+       with e when CErrors.noncritical e -> p in
+  (* finds the eliminator applies it to evars and c saturated as needed  *)
+  (* obtaining "elim ??? (c ???)". pred is the higher order evar         *)
+  (* cty is None when the user writes _ (hence we can't make a pattern *)
+  let cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl =
+    match elim with
+    | Some elim ->
+      let gl, elimty = pf_e_type_of gl elim in
+      let pred_id, n_elim_args, is_rec, elim_is_dep, n_pred_args =
+        analyze_eliminator elimty env (project gl) in
+      let elim, elimty, elim_args, gl =
+        pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in
+      let pred = List.assoc pred_id elim_args in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
+      let cty, gl =
+        if Option.is_empty oc then None, gl
+        else
+          let c = Option.get oc in let gl, c_ty = pf_type_of gl c in
+          let pc = match c_gen with
+            | Some p -> interp_cpattern (Option.get ist) orig_gl p None 
+            | _ -> mkTpat gl c in
+          Some(c, c_ty, pc), gl in
+      cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl
+    | None ->
+      let c = Option.get oc in let gl, c_ty = pf_type_of gl c in
+      let ((kn, i) as ind, _ as indu), unfolded_c_ty =
+        pf_reduce_to_quantified_ind gl c_ty in
+      let sort = elimination_sort_of_goal gl in
+      let gl, elim =
+        if not is_case then
+          let t, gl = pf_fresh_global (Indrec.lookup_eliminator ind sort) gl in
+          gl, t
+        else
+          pf_eapply (fun env sigma () ->
+            let sigma = Sigma.Unsafe.of_evar_map sigma in
+            let Sigma (ind, sigma, _) = Indrec.build_case_analysis_scheme env sigma indu true sort in
+            let sigma = Sigma.to_evar_map sigma in
+            (sigma, ind)) gl () in
+      let gl, elimty = pf_type_of gl elim in
+      let pred_id,n_elim_args,is_rec,elim_is_dep,n_pred_args =
+        analyze_eliminator elimty env (project gl) in
+      let rctx = fst (decompose_prod_assum unfolded_c_ty) in
+      let n_c_args = Context.Rel.length rctx in
+      let c, c_ty, t_args, gl = pf_saturate gl c ~ty:c_ty n_c_args in
+      let elim, elimty, elim_args, gl =
+        pf_saturate ~beta:is_case gl elim ~ty:elimty n_elim_args in
+      let pred = List.assoc pred_id elim_args in
+      let pc = match n_c_args, c_gen with
+        | 0, Some p -> interp_cpattern (Option.get ist) orig_gl p None 
+        | _ -> mkTpat gl c in
+      let cty = Some (c, c_ty, pc) in
+      let elimty = Reductionops.whd_all env (project gl) elimty in
+      cty, elim, elimty, elim_args, n_elim_args, elim_is_dep, is_rec, pred, gl
+  in
+  pp(lazy(str"elim= "++ pr_constr_pat elim));
+  pp(lazy(str"elimty= "++ pr_constr_pat elimty));
+  let inf_deps_r = match kind_of_type elimty with
+    | AtomicType (_, args) -> List.rev (Array.to_list args)
+    | _ -> assert false in
+  let saturate_until gl c c_ty f =
+    let rec loop n = try
+      let c, c_ty, _, gl = pf_saturate gl c ~ty:c_ty n in
+      let gl' = f c c_ty gl in
+      Some (c, c_ty, gl, gl')
+    with
+    | NotEnoughProducts -> None
+    | e when CErrors.noncritical e -> loop (n+1) in loop 0 in
+  (* Here we try to understand if the main pattern/term the user gave is
+   * the first pattern to be matched (i.e. if elimty ends in P t1 .. tn,
+   * weather tn is the t the user wrote in 'elim: t' *)
+  let c_is_head_p, gl = match cty with
+    | None -> true, gl  (* The user wrote elim: _ *)
+    | Some (c, c_ty, _) ->
+    let res = 
+      (* we try to see if c unifies with the last arg of elim *)
+      if elim_is_dep then None else
+      let arg = List.assoc (n_elim_args - 1) elim_args in
+      let gl, arg_ty = pf_type_of gl arg in
+      match saturate_until gl c c_ty (fun c c_ty gl ->
+        pf_unify_HO (pf_unify_HO gl c_ty arg_ty) arg c) with
+      | Some (c, _, _, gl) -> Some (false, gl)
+      | None -> None in
+    match res with
+    | Some x -> x
+    | None ->
+      (* we try to see if c unifies with the last inferred pattern *)
+      let inf_arg = List.hd inf_deps_r in
+      let gl, inf_arg_ty = pf_type_of gl inf_arg in
+      match saturate_until gl c c_ty (fun _ c_ty gl ->
+              pf_unify_HO gl c_ty inf_arg_ty) with
+      | Some (c, _, _,gl) -> true, gl
+      | None ->
+        errorstrm (str"Unable to apply the eliminator to the term"++
+          spc()++pr_constr c++spc()++str"or to unify it's type with"++
+          pr_constr inf_arg_ty) in
+  pp(lazy(str"c_is_head_p= " ++ bool c_is_head_p));
+  let gl, predty = pf_type_of gl pred in
+  (* Patterns for the inductive types indexes to be bound in pred are computed
+   * looking at the ones provided by the user and the inferred ones looking at
+   * the type of the elimination principle *)
+  let pp_pat (_,p,_,occ) = pr_occ occ ++ pp_pattern p in
+  let pp_inf_pat gl (_,_,t,_) = pr_constr_pat (fire_subst gl t) in
+  let patterns, clr, gl =
+    let rec loop patterns clr i = function
+      | [],[] -> patterns, clr, gl
+      | ((oclr, occ), t):: deps, inf_t :: inf_deps ->
+          let ist = match ist with Some x -> x | None -> assert false in
+          let p = interp_cpattern ist orig_gl t None in
+          let clr_t =
+            interp_clr (oclr,(tag_of_cpattern t,fst (redex_of_pattern env p)))in
+          (* if we are the index for the equation we do not clear *)
+          let clr_t = if deps = [] && eqid <> None then [] else clr_t in
+          let p = if is_undef_pat p then mkTpat gl inf_t else p in
+          loop (patterns @ [i, p, inf_t, occ]) 
+            (clr_t @ clr) (i+1) (deps, inf_deps)
+      | [], c :: inf_deps -> 
+          pp(lazy(str"adding inf pattern " ++ pr_constr_pat c));
+          loop (patterns @ [i, mkTpat gl c, c, allocc]) 
+            clr (i+1) ([], inf_deps)
+      | _::_, [] -> errorstrm (str "Too many dependent abstractions") in
+    let deps, head_p, inf_deps_r = match what, c_is_head_p, cty with
+    | `EConstr _, _, None -> anomaly "Simple elim with no term"
+    | _, false, _ -> deps, [], inf_deps_r
+    | `EGen gen, true, None -> deps @ [gen], [], inf_deps_r
+    | _, true, Some (c, _, pc) ->
+         let occ = if occ = None then allocc else occ in
+         let inf_p, inf_deps_r = List.hd inf_deps_r, List.tl inf_deps_r in
+         deps, [1, pc, inf_p, occ], inf_deps_r in
+    let patterns, clr, gl = 
+      loop [] orig_clr (List.length head_p+1) (List.rev deps, inf_deps_r) in
+    head_p @ patterns, Util.List.uniquize clr, gl
+  in
+  pp(lazy(pp_concat (str"patterns=") (List.map pp_pat patterns)));
+  pp(lazy(pp_concat (str"inf. patterns=") (List.map (pp_inf_pat gl) patterns)));
+  (* Predicate generation, and (if necessary) tactic to generalize the
+   * equation asked by the user *)
+  let elim_pred, gen_eq_tac, clr, gl = 
+    let error gl t inf_t = errorstrm (str"The given pattern matches the term"++
+      spc()++pp_term gl t++spc()++str"while the inferred pattern"++
+      spc()++pr_constr_pat (fire_subst gl inf_t)++spc()++ str"doesn't") in
+    let match_or_postpone (cl, gl, post) (h, p, inf_t, occ) =
+      let p = unif_redex gl p inf_t in
+      if is_undef_pat p then
+        let () = pp(lazy(str"postponing " ++ pp_pattern p)) in
+        cl, gl, post @ [h, p, inf_t, occ]
+      else try
+        let c, cl, ucst = match_pat env p occ h cl in
+        let gl = pf_merge_uc ucst gl in
+        let gl = try pf_unify_HO gl inf_t c with _ -> error gl c inf_t in
+        cl, gl, post
+      with 
+      | NoMatch | NoProgress ->
+          let e, ucst = redex_of_pattern env p in
+          let gl = pf_merge_uc ucst gl in
+          let n, e, _, _ucst =  pf_abs_evars gl (fst p, e) in
+          let e, _, _, gl = pf_saturate ~beta:true gl e n in 
+          let gl = try pf_unify_HO gl inf_t e with _ -> error gl e inf_t in
+          cl, gl, post
+    in        
+    let rec match_all concl gl patterns =
+      let concl, gl, postponed = 
+        List.fold_left match_or_postpone (concl, gl, []) patterns in
+      if postponed = [] then concl, gl
+      else if List.length postponed = List.length patterns then
+        errorstrm (str "Some patterns are undefined even after all"++spc()++
+          str"the defined ones matched")
+      else match_all concl gl postponed in
+    let concl, gl = match_all concl gl patterns in
+    let pred_rctx, _ = decompose_prod_assum (fire_subst gl predty) in
+    let concl, gen_eq_tac, clr, gl = match eqid with 
+    | Some (IpatId _) when not is_rec -> 
+        let k = List.length deps in
+        let c = fire_subst gl (List.assoc (n_elim_args - k - 1) elim_args) in
+        let gl, t = pf_type_of gl c in
+        let gen_eq_tac, gl =
+          let refl = mkApp (eq, [|t; c; c|]) in
+          let new_concl = mkArrow refl (lift 1 (pf_concl orig_gl)) in 
+          let new_concl = fire_subst gl new_concl in
+          let erefl, gl = mkRefl t c gl in
+          let erefl = fire_subst gl erefl in
+          apply_type new_concl [erefl], gl in
+        let rel = k + if c_is_head_p then 1 else 0 in
+        let src, gl = mkProt mkProp (mkApp (eq,[|t; c; mkRel rel|])) gl in
+        let concl = mkArrow src (lift 1 concl) in
+        let clr = if deps <> [] then clr else [] in
+        concl, gen_eq_tac, clr, gl
+    | _ -> concl, tclIDTAC, clr, gl in
+    let mk_lam t r = mkLambda_or_LetIn r t in
+    let concl = List.fold_left mk_lam concl pred_rctx in
+    let gl, concl = 
+      if eqid <> None && is_rec then
+        let gl, concls = pf_type_of gl concl in
+        let concl, gl = mkProt concls concl gl in
+        let gl, _ = pf_e_type_of gl concl in
+        gl, concl
+      else gl, concl in
+    concl, gen_eq_tac, clr, gl in
+  let gl, pty = pf_e_type_of gl elim_pred in
+  pp(lazy(str"elim_pred=" ++ pp_term gl elim_pred));
+  pp(lazy(str"elim_pred_ty=" ++ pp_term gl pty));
+  let gl = pf_unify_HO gl pred elim_pred in
+  let elim = fire_subst gl elim in
+  let gl, _ = pf_e_type_of gl elim in
+  (* check that the patterns do not contain non instantiated dependent metas *)
+  let () = 
+    let evars_of_term = Evarutil.undefined_evars_of_term (project gl) in
+    let patterns = List.map (fun (_,_,t,_) -> fire_subst gl t) patterns in
+    let patterns_ev = List.map evars_of_term patterns in 
+    let ev = List.fold_left Intset.union Intset.empty patterns_ev in
+    let ty_ev = Intset.fold (fun i e ->
+         let ex = i in
+         let i_ty = Evd.evar_concl (Evd.find (project gl) ex) in
+         Intset.union e (evars_of_term i_ty))
+      ev Intset.empty in
+    let inter = Intset.inter ev ty_ev in
+    if not (Intset.is_empty inter) then begin
+      let i = Intset.choose inter in
+      let pat = List.find (fun t -> Intset.mem i (evars_of_term t)) patterns in
+      errorstrm(str"Pattern"++spc()++pr_constr_pat pat++spc()++
+        str"was not completely instantiated and one of its variables"++spc()++
+        str"occurs in the type of another non-instantiated pattern variable");
+    end
+  in
+  (* the elim tactic, with the eliminator and the predicated we computed *)
+  let elim = project gl, elim in 
+  let elim_tac gl = 
+    tclTHENLIST [refine_with ~with_evars:false elim; cleartac clr] gl in
+  (* handling of following intro patterns and equation introduction if any *)
+  let elim_intro_tac gl = 
+    let intro_eq = 
+      match eqid with 
+      | Some (IpatId ipat) when not is_rec -> 
+          let rec intro_eq gl = match kind_of_type (pf_concl gl) with
+          | ProdType (_, src, tgt) -> 
+             (match kind_of_type src with
+             | AtomicType (hd, _) when Term.eq_constr hd protectC -> 
+                tclTHENLIST [unprotecttac; introid ipat] gl
+             | _ -> tclTHENLIST [ iD "IA"; introstac [IpatAnon]; intro_eq] gl)
+          |_ -> errorstrm (str "Too many names in intro pattern") in
+          intro_eq
+      | Some (IpatId ipat) -> 
+        let name gl = mk_anon_id "K" gl in
+        let intro_lhs gl = 
+          let elim_name = match orig_clr, what with
+            | [SsrHyp(_, x)], _ -> x
+            | _, `EConstr(_,_,t) when isVar t -> destVar t
+            | _ -> name gl in
+          if is_name_in_ipats elim_name ipats then introid (name gl) gl
+          else introid elim_name gl
+        in
+        let rec gen_eq_tac gl =
+          let concl = pf_concl gl in
+          let ctx, last = decompose_prod_assum concl in
+          let args = match kind_of_type last with
+          | AtomicType (hd, args) -> assert(Term.eq_constr hd protectC); args
+          | _ -> assert false in
+          let case = args.(Array.length args-1) in
+          if not(closed0 case) then tclTHEN (introstac [IpatAnon]) gen_eq_tac gl
+          else
+          let gl, case_ty = pf_type_of gl case in 
+          let refl = mkApp (eq, [|lift 1 case_ty; mkRel 1; lift 1 case|]) in
+          let new_concl = fire_subst gl
+            (mkProd (Name (name gl), case_ty, mkArrow refl (lift 2 concl))) in 
+          let erefl, gl = mkRefl case_ty case gl in
+          let erefl = fire_subst gl erefl in
+          apply_type new_concl [case;erefl] gl in
+        tclTHENLIST [gen_eq_tac; intro_lhs; introid ipat]
+      | _ -> tclIDTAC in
+    let unprot = if eqid <> None && is_rec then unprotecttac else tclIDTAC in
+    tclEQINTROS ?ist elim_tac (tclTHENLIST [intro_eq; unprot]) ipats gl
+  in
+  tclTHENLIST [gen_eq_tac; elim_intro_tac] orig_gl
+;;
+
+let simplest_newelim x= ssrelim ~is_case:false [] (`EConstr ([],None,x)) None []
+let simplest_newcase x= ssrelim ~is_case:true [] (`EConstr ([],None,x)) None []
+let _ = simplest_newcase_ref := simplest_newcase
+
+let check_casearg = function
+| view, (_, (([_; gen :: _], _), _)) when view <> [] && has_occ gen ->
+  CErrors.error "incompatible view and occurrence switch in dependent case tactic"
+| arg -> arg
+
+ARGUMENT EXTEND ssrcasearg TYPED AS ssrarg PRINTED BY pr_ssrarg
+| [ ssrarg(arg) ] -> [ check_casearg arg ]
+END
+
+let ssrcasetac ist (view, (eqid, (dgens, ipats))) =
+  let ndefectcasetac view eqid ipats deps ((_, occ), _ as gen) ist gl =
+    let simple = (eqid = None && deps = [] && occ = None) in
+    let cl, c, clr, gl = pf_interp_gen ist gl true gen in
+    let _, vc, gl =
+      if view = [] then c, c, gl else pf_with_view ist gl (false, view) cl c in
+    if simple && is_injection_case vc gl then
+      tclTHENLIST [perform_injection vc; cleartac clr; introstac ~ist ipats] gl
+    else 
+      (* macro for "case/v E: x" ---> "case E: x / (v x)" *)
+      let deps, clr, occ = 
+        if view <> [] && eqid <> None && deps = [] then [gen], [], None
+        else deps, clr, occ in
+      ssrelim ~is_case:true ~ist deps (`EConstr (clr,occ, vc)) eqid ipats gl
+  in
+  with_dgens dgens (ndefectcasetac view eqid ipats) ist
+
+TACTIC EXTEND ssrcase
+| [ "case" ssrcasearg(arg) ssrclauses(clauses) ] ->
+  [ Proofview.V82.tactic (tclCLAUSES ist (ssrcasetac ist arg) clauses) ]
+| [ "case" ] -> [ Proofview.V82.tactic (with_top ssrscasetac) ]
+END
+
+(** The "elim" tactic *)
+
+(* Elim views are elimination lemmas, so the eliminated term is not addded *)
+(* to the dependent terms as for "case", unless it actually occurs in the  *)
+(* goal, the "all occurrences" {+} switch is used, or the equation switch  *)
+(* is used and there are no dependents.                                    *)
+
+let ssrelimtac ist (view, (eqid, (dgens, ipats))) =
+  let ndefectelimtac view eqid ipats deps gen ist gl =
+    let elim = match view with [v] -> Some (snd(force_term ist gl v)) | _ -> None in
+    ssrelim ~ist deps (`EGen gen) ?elim eqid ipats gl
+  in
+  with_dgens dgens (ndefectelimtac view eqid ipats) ist 
+
+TACTIC EXTEND ssrelim
+| [ "elim" ssrarg(arg) ssrclauses(clauses) ] ->
+  [ Proofview.V82.tactic (tclCLAUSES ist (ssrelimtac ist arg) clauses) ]
+| [ "elim" ] -> [ Proofview.V82.tactic (with_top simplest_newelim) ]
+END
+
+(** 6. Backward chaining tactics: apply, exact, congr. *)
+
+(** The "apply" tactic *)
+
+let pr_agen (docc, dt) = pr_docc docc ++ pr_term dt
+let pr_ssragen _ _ _ = pr_agen
+let pr_ssragens _ _ _ = pr_dgens pr_agen
+
+ARGUMENT EXTEND ssragen TYPED AS ssrdocc * ssrterm PRINTED BY pr_ssragen
+| [ "{" ne_ssrhyp_list(clr) "}" ssrterm(dt) ] -> [ mkclr clr, dt ]
+| [ ssrterm(dt) ] -> [ nodocc, dt ]
+END
+
+ARGUMENT EXTEND ssragens TYPED AS ssragen list list * ssrclear 
+PRINTED BY pr_ssragens
+| [ "{" ne_ssrhyp_list(clr) "}" ssrterm(dt) ssragens(agens) ] ->
+  [ cons_gen (mkclr clr, dt) agens ]
+| [ "{" ne_ssrhyp_list(clr) "}" ] -> [ [[]], clr]
+| [ ssrterm(dt) ssragens(agens) ] ->
+  [ cons_gen (nodocc, dt) agens ]
+| [ ] -> [ [[]], [] ]
+END
+
+let mk_applyarg views agens intros = views, (None, (agens, intros))
+
+let pr_ssraarg _ _ _ (view, (eqid, (dgens, ipats))) =
+  let pri = pr_intros (gens_sep dgens) in
+  pr_view view ++ pr_eqid eqid ++ pr_dgens pr_agen dgens ++ pri ipats
+
+ARGUMENT EXTEND ssrapplyarg 
+TYPED AS ssrview * (ssreqid * (ssragens * ssrintros))
+PRINTED BY pr_ssraarg
+| [ ":" ssragen(gen) ssragens(dgens) ssrintros(intros) ] ->
+  [ mk_applyarg [] (cons_gen gen dgens) intros ]
+| [ ssrclear_ne(clr) ssrintros(intros) ] ->
+  [ mk_applyarg [] ([], clr) intros ]
+| [ ssrintros_ne(intros) ] ->
+  [ mk_applyarg [] ([], []) intros ]
+| [ ssrview(view) ":" ssragen(gen) ssragens(dgens) ssrintros(intros) ] ->
+  [ mk_applyarg view (cons_gen gen dgens) intros ]
+| [ ssrview(view) ssrclear(clr) ssrintros(intros) ] ->
+  [ mk_applyarg view ([], clr) intros ]
+END
+
+let interp_agen ist gl ((goclr, _), (k, gc)) (clr, rcs) =
+(* pp(lazy(str"sigma@interp_agen=" ++ pr_evar_map None (project gl))); *)
+  let rc = glob_constr ist (pf_env gl) gc in
+  let rcs' = rc :: rcs in
+  match goclr with
+  | None -> clr, rcs'
+  | Some ghyps ->
+    let clr' = snd (interp_hyps ist gl ghyps) @ clr in
+    if k <> ' ' then clr', rcs' else
+    match rc with
+    | GVar (loc, id) when not_section_id id -> SsrHyp (loc, id) :: clr', rcs'
+    | GRef (loc, VarRef id, _) when not_section_id id ->
+        SsrHyp (loc, id) :: clr', rcs'
+    | _ -> clr', rcs'
+
+let interp_agens ist gl gagens =
+  match List.fold_right (interp_agen ist gl) gagens ([], []) with
+  | clr, rlemma :: args ->
+    let n = interp_nbargs ist gl rlemma - List.length args in
+    let rec loop i =
+      if i > n then
+         errorstrm (str "Cannot apply lemma " ++ pf_pr_glob_constr gl rlemma)
+      else
+        try interp_refine ist gl (mkRApp rlemma (mkRHoles i @ args))
+        with _ -> loop (i + 1) in
+    clr, loop 0
+  | _ -> assert false
+
+let apply_rconstr ?ist t gl =
+(* pp(lazy(str"sigma@apply_rconstr=" ++ pr_evar_map None (project gl))); *)
+  let n = match ist, t with
+    | None, (GVar (_, id) | GRef (_, VarRef id,_)) -> pf_nbargs gl (mkVar id)
+    | Some ist, _ -> interp_nbargs ist gl t
+    | _ -> anomaly "apply_rconstr without ist and not RVar" in
+  let mkRlemma i = mkRApp t (mkRHoles i) in
+  let cl = pf_concl gl in
+  let rec loop i =
+    if i > n then
+      errorstrm (str"Cannot apply lemma "++pf_pr_glob_constr gl t)
+    else try pf_match gl (mkRlemma i) (OfType cl) with _ -> loop (i + 1) in
+  refine_with (loop 0) gl
+
+let mkRAppView ist gl rv gv =
+  let nb_view_imps = interp_view_nbimps ist gl rv in
+  mkRApp rv (mkRHoles (abs nb_view_imps))
+
+let prof_apply_interp_with = mk_profiler "ssrapplytac.interp_with";;
+
+let refine_interp_apply_view i ist gl gv =
+  let pair i = List.map (fun x -> i, x) in
+  let rv = pf_intern_term ist gl gv in
+  let v = mkRAppView ist gl rv gv in
+  let interp_with (i, hint) =
+    interp_refine ist gl (mkRApp hint (v :: mkRHoles i)) in
+  let interp_with x = prof_apply_interp_with.profile interp_with x in
+  let rec loop = function
+  | [] -> (try apply_rconstr ~ist rv gl with _ -> view_error "apply" gv)
+  | h :: hs -> (try refine_with (snd (interp_with h)) gl with _ -> loop hs) in
+  loop (pair i viewtab.(i) @ if i = 2 then pair 1 viewtab.(1) else [])
+
+let apply_top_tac gl =
+  tclTHENLIST [introid top_id; apply_rconstr (mkRVar top_id); Proofview.V82.of_tactic (clear [top_id])] gl
+    
+let inner_ssrapplytac gviews ggenl gclr ist gl =
+ let _, clr = interp_hyps ist gl gclr in
+ let vtac gv i gl' = refine_interp_apply_view i ist gl' gv in
+ let ggenl, tclGENTAC =
+   if gviews <> [] && ggenl <> [] then
+     let ggenl= List.map (fun (x,g) -> x, cpattern_of_term g) (List.hd ggenl) in
+     [], tclTHEN (genstac (ggenl,[]) ist)
+   else ggenl, tclTHEN tclIDTAC in
+ tclGENTAC (fun gl ->
+  match gviews, ggenl with
+  | v :: tl, [] ->
+    let dbl = if List.length tl = 1 then 2 else 1 in
+    tclTHEN
+      (List.fold_left (fun acc v -> tclTHENLAST acc (vtac v dbl)) (vtac v 1) tl)
+      (cleartac clr) gl
+  | [], [agens] ->
+    let clr', (sigma, lemma) = interp_agens ist gl agens in
+    let gl = pf_merge_uc_of sigma gl in
+    tclTHENLIST [cleartac clr; refine_with ~beta:true lemma; cleartac clr'] gl
+  | _, _ -> tclTHEN apply_top_tac (cleartac clr) gl) gl
+
+let ssrapplytac ist (views, (_, ((gens, clr), intros))) =
+  tclINTROS ist (inner_ssrapplytac views gens clr) intros
+
+TACTIC EXTEND ssrapply
+| [ "apply" ssrapplyarg(arg) ] -> [ Proofview.V82.tactic (ssrapplytac ist arg) ]
+| [ "apply" ] -> [ Proofview.V82.tactic apply_top_tac ]
+END
+
+(** The "exact" tactic *)
+
+let mk_exactarg views dgens = mk_applyarg views dgens []
+
+ARGUMENT EXTEND ssrexactarg TYPED AS ssrapplyarg PRINTED BY pr_ssraarg
+| [ ":" ssragen(gen) ssragens(dgens) ] ->
+  [ mk_exactarg [] (cons_gen gen dgens) ]
+| [ ssrview(view) ssrclear(clr) ] ->
+  [ mk_exactarg view ([], clr) ]
+| [ ssrclear_ne(clr) ] ->
+  [ mk_exactarg [] ([], clr) ]
+END
+
+let vmexacttac pf =
+  Proofview.Goal.nf_enter { enter = begin fun gl ->
+  exact_no_check (mkCast (pf, VMcast, Tacmach.New.pf_concl gl))
+  end }
+
+TACTIC EXTEND ssrexact
+| [ "exact" ssrexactarg(arg) ] -> [ Proofview.V82.tactic (tclBY (ssrapplytac ist arg)) ]
+| [ "exact" ] -> [ Proofview.V82.tactic (tclORELSE donetac (tclBY apply_top_tac)) ]
+| [ "exact" "<:" lconstr(pf) ] -> [ vmexacttac pf ]
+END
+
+(** The "congr" tactic *)
+
+(* type ssrcongrarg = open_constr * (int * constr) *)
+
+let pr_ssrcongrarg _ _ _ ((n, f), dgens) =
+  (if n <= 0 then mt () else str " " ++ int n) ++
+  str " " ++ pr_term f ++ pr_dgens pr_gen dgens
+
+ARGUMENT EXTEND ssrcongrarg TYPED AS (int * ssrterm) * ssrdgens
+  PRINTED BY pr_ssrcongrarg
+| [ natural(n) constr(c) ssrdgens(dgens) ] -> [ (n, mk_term ' ' c), dgens ]
+| [ natural(n) constr(c) ] -> [ (n, mk_term ' ' c),([[]],[]) ]
+| [ constr(c) ssrdgens(dgens) ] -> [ (0, mk_term ' ' c), dgens ]
+| [ constr(c) ] -> [ (0, mk_term ' ' c), ([[]],[]) ]
+END
+
+let rec mkRnat n =
+  if n <= 0 then GRef (dummy_loc, glob_O, None) else
+  mkRApp (GRef (dummy_loc, glob_S, None)) [mkRnat (n - 1)]
+
+let interp_congrarg_at ist gl n rf ty m =
+  pp(lazy(str"===interp_congrarg_at==="));
+  let congrn, _ = mkSsrRRef "nary_congruence" in
+  let args1 = mkRnat n :: mkRHoles n @ [ty] in
+  let args2 = mkRHoles (3 * n) in
+  let rec loop i =
+    if i + n > m then None else
+    try
+      let rt = mkRApp congrn (args1 @  mkRApp rf (mkRHoles i) :: args2) in
+      pp(lazy(str"rt=" ++ pr_glob_constr rt));
+      Some (interp_refine ist gl rt)
+    with _ -> loop (i + 1) in
+  loop 0
+
+let pattern_id = mk_internal_id "pattern value"
+
+let congrtac ((n, t), ty) ist gl =
+  pp(lazy(str"===congr==="));
+  pp(lazy(str"concl=" ++ pr_constr (pf_concl gl)));
+  let sigma, _ as it = interp_term ist gl t in
+  let gl = pf_merge_uc_of sigma gl in
+  let _, f, _, _ucst = pf_abs_evars gl it in
+  let ist' = {ist with lfun =
+    Id.Map.add pattern_id (Value.of_constr f) Id.Map.empty } in
+  let rf = mkRltacVar pattern_id in
+  let m = pf_nbargs gl f in
+  let _, cf = if n > 0 then
+    match interp_congrarg_at ist' gl n rf ty m with
+    | Some cf -> cf
+    | None -> errorstrm (str "No " ++ int n ++ str "-congruence with "
+                         ++ pr_term t)
+    else let rec loop i =
+      if i > m then errorstrm (str "No congruence with " ++ pr_term t)
+      else match interp_congrarg_at ist' gl i rf ty m with
+      | Some cf -> cf
+      | None -> loop (i + 1) in
+      loop 1 in
+  tclTHEN (refine_with cf) (tclTRY (Proofview.V82.of_tactic reflexivity)) gl
+
+let newssrcongrtac arg ist gl =
+  pp(lazy(str"===newcongr==="));
+  pp(lazy(str"concl=" ++ pr_constr (pf_concl gl)));
+  (* utils *)
+  let fs gl t = Reductionops.nf_evar (project gl) t in
+  let tclMATCH_GOAL (c, gl_c) proj t_ok t_fail gl =
+    match try Some (pf_unify_HO gl_c (pf_concl gl) c) with _ -> None with  
+    | Some gl_c ->
+        tclTHEN (Proofview.V82.of_tactic (convert_concl (fs gl_c c)))
+          (t_ok (proj gl_c)) gl
+    | None -> t_fail () gl in 
+  let mk_evar gl ty = 
+    let env, sigma, si = pf_env gl, project gl, sig_it gl in
+    let sigma = create_evar_defs sigma in
+    let sigma = Sigma.Unsafe.of_evar_map sigma in
+    let Sigma (x, sigma, _) = Evarutil.new_evar env sigma ty in
+    let sigma = Sigma.to_evar_map sigma in
+    x, re_sig si sigma in
+  let arr, gl = pf_mkSsrConst "ssr_congr_arrow" gl in
+  let ssr_congr lr = mkApp (arr, lr) in
+  (* here thw two cases: simple equality or arrow *)
+  let equality, _, eq_args, gl' =
+    let eq, gl = pf_fresh_global (build_coq_eq ()) gl in
+    pf_saturate gl eq 3 in
+  tclMATCH_GOAL (equality, gl') (fun gl' -> fs gl' (List.assoc 0 eq_args))
+  (fun ty -> congrtac (arg, Detyping.detype false [] (pf_env gl) (project gl) ty) ist)
+  (fun () ->
+    let lhs, gl' = mk_evar gl mkProp in let rhs, gl' = mk_evar gl' mkProp in
+    let arrow = mkArrow lhs (lift 1 rhs) in
+    tclMATCH_GOAL (arrow, gl') (fun gl' -> [|fs gl' lhs;fs gl' rhs|])
+    (fun lr -> tclTHEN (Proofview.V82.of_tactic (apply (ssr_congr lr))) (congrtac (arg, mkRType) ist))
+    (fun _ _ -> errorstrm (str"Conclusion is not an equality nor an arrow")))
+    gl
+;;
+
+TACTIC EXTEND ssrcongr
+| [ "congr" ssrcongrarg(arg) ] ->
+[ let arg, dgens = arg in
+  Proofview.V82.tactic begin
+    match dgens with
+    | [gens], clr -> tclTHEN (genstac (gens,clr) ist) (newssrcongrtac arg ist)
+    | _ -> errorstrm (str"Dependent family abstractions not allowed in congr")
+  end]
+END
+
+(** 7. Rewriting tactics (rewrite, unlock) *)
+
+(** Coq rewrite compatibility flag *)
+
+let ssr_strict_match = ref false
+
+let _ =
+  Goptions.declare_bool_option 
+    { Goptions.optsync  = true;
+      Goptions.optname  = "strict redex matching";
+      Goptions.optkey   = ["Match"; "Strict"];
+      Goptions.optread  = (fun () -> !ssr_strict_match);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> ssr_strict_match := b) }
+
+(** Rewrite multiplier *)
+
+type ssrmult = int * ssrmmod
+
+let notimes = 0
+let nomult = 1, Once
+
+let pr_mult (n, m) =
+  if n > 0 && m <> Once then int n ++ pr_mmod m else pr_mmod m
+
+let pr_ssrmult _ _ _ = pr_mult
+
+ARGUMENT EXTEND ssrmult_ne TYPED AS int * ssrmmod PRINTED BY pr_ssrmult
+  | [ natural(n) ssrmmod(m) ] -> [ check_index loc n, m ]
+  | [ ssrmmod(m) ]            -> [ notimes, m ]
+END
+
+ARGUMENT EXTEND ssrmult TYPED AS ssrmult_ne PRINTED BY pr_ssrmult
+  | [ ssrmult_ne(m) ] -> [ m ]
+  | [ ] -> [ nomult ]
+END
+
+(** Rewrite clear/occ switches *)
+
+let pr_rwocc = function
+  | None, None -> mt ()
+  | None, occ -> pr_occ occ
+  | Some clr,  _ ->  pr_clear_ne clr
+
+let pr_ssrrwocc _ _ _ = pr_rwocc
+
+ARGUMENT EXTEND ssrrwocc TYPED AS ssrdocc PRINTED BY pr_ssrrwocc
+| [ "{" ssrhyp_list(clr) "}" ] -> [ mkclr clr ]
+| [ "{" ssrocc(occ) "}" ] -> [ mkocc occ ]
+| [ ] -> [ noclr ]
+END
+
+(** Rewrite rules *)
+
+type ssrwkind = RWred of ssrsimpl | RWdef | RWeq
+(* type ssrrule = ssrwkind * ssrterm *)
+
+let pr_rwkind = function
+  | RWred s -> pr_simpl s
+  | RWdef -> str "/"
+  | RWeq -> mt ()
+
+let wit_ssrrwkind = add_genarg "ssrrwkind" pr_rwkind
+
+let pr_rule = function
+  | RWred s, _ -> pr_simpl s
+  | RWdef, r-> str "/" ++ pr_term r
+  | RWeq, r -> pr_term r
+
+let pr_ssrrule _ _ _ = pr_rule
+
+let noruleterm loc = mk_term ' ' (mkCProp loc)
+
+ARGUMENT EXTEND ssrrule_ne TYPED AS ssrrwkind * ssrterm PRINTED BY pr_ssrrule
+  | [ ssrsimpl_ne(s) ] -> [ RWred s, noruleterm loc ]
+  | [ "/" ssrterm(t) ] -> [ RWdef, t ] 
+  | [ ssrterm(t) ] -> [ RWeq, t ] 
+END
+
+ARGUMENT EXTEND ssrrule TYPED AS ssrrule_ne PRINTED BY pr_ssrrule
+  | [ ssrrule_ne(r) ] -> [ r ]
+  | [ ] -> [ RWred Nop, noruleterm loc ]
+END
+
+(** Rewrite arguments *)
+
+(* type ssrrwarg = (ssrdir * ssrmult) * ((ssrdocc * ssrpattern) * ssrrule) *)
+
+let pr_option f = function None -> mt() | Some x -> f x
+let pr_pattern_squarep= pr_option (fun r -> str "[" ++ pr_rpattern r ++ str "]")
+let pr_ssrpattern_squarep _ _ _ = pr_pattern_squarep
+let pr_rwarg ((d, m), ((docc, rx), r)) =
+  pr_rwdir d ++ pr_mult m ++ pr_rwocc docc ++ pr_pattern_squarep rx ++ pr_rule r
+
+let pr_ssrrwarg _ _ _ = pr_rwarg
+
+let mk_rwarg (d, (n, _ as m)) ((clr, occ as docc), rx) (rt, _ as r) =   
+ if rt <> RWeq then begin
+   if rt = RWred Nop && not (m = nomult && occ = None && rx = None)
+                     && (clr = None || clr = Some []) then
+     anomaly "Improper rewrite clear switch";
+   if d = R2L && rt <> RWdef then
+     CErrors.error "Right-to-left switch on simplification";
+   if n <> 1 && rt = RWred Cut then
+     CErrors.error "Bad or useless multiplier";
+   if occ <> None && rx = None && rt <> RWdef then
+     CErrors.error "Missing redex for simplification occurrence"
+ end; (d, m), ((docc, rx), r)
+
+let norwmult = L2R, nomult
+let norwocc = noclr, None
+
+(*
+let pattern_ident = Prim.pattern_ident in
+GEXTEND Gram
+GLOBAL: pattern_ident;
+pattern_ident: 
+[[c = pattern_ident -> (CRef (Ident (loc,c)), NoBindings)]];
+END
+*)
+
+ARGUMENT EXTEND ssrpattern_squarep
+TYPED AS rpattern option PRINTED BY pr_ssrpattern_squarep
+  | [ "[" rpattern(rdx) "]" ] -> [ Some rdx ]
+  | [ ] -> [ None ]
+END
+
+ARGUMENT EXTEND ssrpattern_ne_squarep
+TYPED AS rpattern option PRINTED BY pr_ssrpattern_squarep
+  | [ "[" rpattern(rdx) "]" ] -> [ Some rdx ]
+END
+
+
+ARGUMENT EXTEND ssrrwarg
+  TYPED AS (ssrdir * ssrmult) * ((ssrdocc * rpattern option) * ssrrule)
+  PRINTED BY pr_ssrrwarg
+  | [ "-" ssrmult(m) ssrrwocc(docc) ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg (R2L, m) (docc, rx) r ]
+  | [ "-/" ssrterm(t) ] ->     (* just in case '-/' should become a token *)
+    [ mk_rwarg (R2L, nomult) norwocc (RWdef, t) ]
+  | [ ssrmult_ne(m) ssrrwocc(docc) ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg (L2R, m) (docc, rx) r ]
+  | [ "{" ne_ssrhyp_list(clr) "}" ssrpattern_ne_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (mkclr clr, rx) r ]
+  | [ "{" ne_ssrhyp_list(clr) "}" ssrrule(r) ] ->
+    [ mk_rwarg norwmult (mkclr clr, None) r ]
+  | [ "{" ssrocc(occ) "}" ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (mkocc occ, rx) r ]
+  | [ "{" "}" ssrpattern_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (nodocc, rx) r ]
+  | [ ssrpattern_ne_squarep(rx) ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult (noclr, rx) r ]
+  | [ ssrrule_ne(r) ] ->
+    [ mk_rwarg norwmult norwocc r ]
+END
+
+let simplintac occ rdx sim gl = 
+  let simptac gl = 
+    let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+    let simp env c _ _ = red_safe Tacred.simpl env sigma0 c in
+    Proofview.V82.of_tactic
+      (convert_concl_no_check (eval_pattern env0 sigma0 concl0 rdx occ simp))
+      gl in
+  match sim with
+  | Simpl -> simptac gl
+  | SimplCut -> tclTHEN simptac (tclTRY donetac) gl
+  | _ -> simpltac sim gl
+
+let rec get_evalref c =  match kind_of_term c with
+  | Var id -> EvalVarRef id
+  | Const (k,_) -> EvalConstRef k
+  | App (c', _) -> get_evalref c'
+  | Cast (c', _, _) -> get_evalref c'
+  | _ -> errorstrm (str "The term " ++ pr_constr c ++ str " is not unfoldable")
+
+(* Strip a pattern generated by a prenex implicit to its constant. *)
+let strip_unfold_term ((sigma, t) as p) kt = match kind_of_term t with
+  | App (f, a) when kt = ' ' && Array.for_all isEvar a && isConst f -> 
+    (sigma, f), true
+  | Const _ | Var _ -> p, true
+  | _ -> p, false
+
+let unfoldintac occ rdx t (kt,_) gl = 
+  let fs sigma x = Reductionops.nf_evar sigma x in
+  let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+  let (sigma, t), const = strip_unfold_term t kt in
+  let body env t c =
+    Tacred.unfoldn [OnlyOccurrences [1], get_evalref t] env sigma0 c in
+  let easy = occ = None && rdx = None in
+  let red_flags = if easy then CClosure.betaiotazeta else CClosure.betaiota in
+  let beta env = Reductionops.clos_norm_flags red_flags env sigma0 in
+  let unfold, conclude = match rdx with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+    let ise = create_evar_defs sigma in
+    let ise, u = mk_tpattern env0 sigma0 (ise,t) all_ok L2R t in
+    let find_T, end_T =
+      mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[u]) in
+    (fun env c _ h -> 
+      try find_T env c h (fun env c _ _ -> body env t c)
+      with NoMatch when easy -> c
+      | NoMatch | NoProgress -> errorstrm (str"No occurrence of "
+        ++ pr_constr_pat t ++ spc() ++ str "in " ++ pr_constr c)),
+    (fun () -> try end_T () with 
+      | NoMatch when easy -> fake_pmatcher_end () 
+      | NoMatch -> anomaly "unfoldintac")
+  | _ -> 
+    (fun env (c as orig_c) _ h ->
+      if const then
+          let rec aux c = 
+            match kind_of_term c with
+            | Const _ when Term.eq_constr c t -> body env t t
+            | App (f,a) when Term.eq_constr f t -> mkApp (body env f f,a)
+            | _ -> let c = Reductionops.whd_betaiotazeta sigma0 c in
+            match kind_of_term c with
+            | Const _ when Term.eq_constr c t -> body env t t
+            | App (f,a) when Term.eq_constr f t -> mkApp (body env f f,a)
+            | Const f -> aux (body env c c)
+            | App (f, a) -> aux (mkApp (body env f f, a))
+            | _ -> errorstrm (str "The term "++pr_constr orig_c++
+                str" contains no " ++ pr_constr t ++ str" even after unfolding")
+          in aux c
+      else
+        try body env t (fs (unify_HO env sigma c t) t)
+        with _ -> errorstrm (str "The term " ++
+          pr_constr c ++spc()++ str "does not unify with " ++ pr_constr_pat t)),
+    fake_pmatcher_end in
+  let concl = 
+    try beta env0 (eval_pattern env0 sigma0 concl0 rdx occ unfold) 
+    with Option.IsNone -> errorstrm (str"Failed to unfold " ++ pr_constr_pat t) in
+  let _ = conclude () in
+  Proofview.V82.of_tactic (convert_concl concl) gl
+;;
+
+let foldtac occ rdx ft gl = 
+  let fs sigma x = Reductionops.nf_evar sigma x in
+  let sigma0, concl0, env0 = project gl, pf_concl gl, pf_env gl in
+  let sigma, t = ft in
+  let fold, conclude = match rdx with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+    let ise = create_evar_defs sigma in
+    let ut = red_product_skip_id env0 sigma t in
+    let ise, ut = mk_tpattern env0 sigma0 (ise,t) all_ok L2R ut in
+    let find_T, end_T =
+      mk_tpattern_matcher ~raise_NoMatch:true sigma0 occ (ise,[ut]) in
+    (fun env c _ h -> try find_T env c h (fun env t _ _ -> t) with NoMatch ->c),
+    (fun () -> try end_T () with NoMatch -> fake_pmatcher_end ())
+  | _ -> 
+    (fun env c _ h -> try let sigma = unify_HO env sigma c t in fs sigma t
+    with _ -> errorstrm (str "fold pattern " ++ pr_constr_pat t ++ spc ()
+      ++ str "does not match redex " ++ pr_constr_pat c)), 
+    fake_pmatcher_end in
+  let concl = eval_pattern env0 sigma0 concl0 rdx occ fold in
+  let _ = conclude () in
+  Proofview.V82.of_tactic (convert_concl concl) gl
+;;
+
+let converse_dir = function L2R -> R2L | R2L -> L2R
+
+let rw_progress rhs lhs ise = not (Term.eq_constr lhs (Evarutil.nf_evar ise rhs))
+
+(* Coq has a more general form of "equation" (any type with a single *)
+(* constructor with no arguments with_rect_r elimination lemmas).    *)
+(* However there is no clear way of determining the LHS and RHS of   *)
+(* such a generic Leibnitz equation -- short of inspecting the type  *)
+(* of the elimination lemmas.                                        *)
+
+let rec strip_prod_assum c = match kind_of_term c with
+  | Prod (_, _, c') -> strip_prod_assum c'
+  | LetIn (_, v, _, c') -> strip_prod_assum (subst1 v c)
+  | Cast (c', _, _) -> strip_prod_assum c'
+  | _ -> c
+
+let rule_id = mk_internal_id "rewrite rule"
+
+exception PRtype_error
+exception PRindetermined_rhs of constr
+
+let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
+(*   pp(lazy(str"sigma@pirrel_rewrite=" ++ pr_evar_map None sigma)); *)
+  let env = pf_env gl in
+  let beta = Reductionops.clos_norm_flags CClosure.beta env sigma in
+  let sigma, p = 
+    let sigma = create_evar_defs sigma in
+    let sigma = Sigma.Unsafe.of_evar_map sigma in
+    let Sigma (ev, sigma, _) = Evarutil.new_evar env sigma (beta (subst1 new_rdx pred)) in
+    let sigma = Sigma.to_evar_map sigma in
+    (sigma, ev)
+  in
+  let pred = mkNamedLambda pattern_id rdx_ty pred in
+  let elim, gl = 
+    let ((kn, i) as ind, _), unfolded_c_ty = pf_reduce_to_quantified_ind gl c_ty in
+    let sort = elimination_sort_of_goal gl in
+    let elim, gl = pf_fresh_global (Indrec.lookup_eliminator ind sort) gl in
+    if dir = R2L then elim, gl else (* taken from Coq's rewrite *)
+    let elim, _ = destConst elim in          
+    let mp,dp,l = repr_con (constant_of_kn (canonical_con elim)) in
+    let l' = label_of_id (Nameops.add_suffix (id_of_label l) "_r")  in 
+    let c1' = Global.constant_of_delta_kn (canonical_con (make_con mp dp l')) in
+    mkConst c1', gl in
+  let proof = mkApp (elim, [| rdx_ty; new_rdx; pred; p; rdx; c |]) in
+  (* We check the proof is well typed *)
+  let sigma, proof_ty =
+    try Typing.type_of env sigma proof with _ -> raise PRtype_error in
+  pp(lazy(str"pirrel_rewrite proof term of type: " ++ pr_constr proof_ty));
+  try refine_with 
+    ~first_goes_last:(not !ssroldreworder) ~with_evars:false (sigma, proof) gl
+  with _ -> 
+    (* we generate a msg like: "Unable to find an instance for the variable" *)
+    let c = Reductionops.nf_evar sigma c in
+    let hd_ty, miss = match kind_of_term c with
+    | App (hd, args) -> 
+        let hd_ty = Retyping.get_type_of env sigma hd in
+        let names = let rec aux t = function 0 -> [] | n ->
+          let t = Reductionops.whd_all env sigma t in
+          match kind_of_type t with
+          | ProdType (name, _, t) -> name :: aux t (n-1)
+          | _ -> assert false in aux hd_ty (Array.length args) in
+        hd_ty, Util.List.map_filter (fun (t, name) ->
+          let evs = Intset.elements (Evarutil.undefined_evars_of_term sigma t) in
+          let open_evs = List.filter (fun k ->
+            InProp <> Retyping.get_sort_family_of
+              env sigma (Evd.evar_concl (Evd.find sigma k)))
+            evs in
+          if open_evs <> [] then Some name else None)
+          (List.combine (Array.to_list args) names)
+    | _ -> anomaly "rewrite rule not an application" in
+    errorstrm (Himsg.explain_refiner_error (Logic.UnresolvedBindings miss)++
+      (Pp.fnl()++str"Rule's type:" ++ spc() ++ pr_constr hd_ty))
+;;
+
+let is_const_ref c r = isConst c && eq_gr (ConstRef (fst(destConst c))) r
+let is_construct_ref c r =
+  isConstruct c && eq_gr (ConstructRef (fst(destConstruct c))) r
+let is_ind_ref c r = isInd c && eq_gr (IndRef (fst(destInd c))) r
+
+let rwcltac cl rdx dir sr gl =
+  let n, r_n,_, ucst = pf_abs_evars gl sr in
+  let r_n' = pf_abs_cterm gl n r_n in
+  let r' = subst_var pattern_id r_n' in
+  let gl = pf_unsafe_merge_uc ucst gl in
+  let rdxt = Retyping.get_type_of (pf_env gl) (fst sr) rdx in
+(*         pp(lazy(str"sigma@rwcltac=" ++ pr_evar_map None (fst sr))); *)
+        pp(lazy(str"r@rwcltac=" ++ pr_constr (snd sr)));
+  let cvtac, rwtac, gl =
+    if closed0 r' then 
+      let env, sigma, c, c_eq = pf_env gl, fst sr, snd sr, build_coq_eq () in
+      let sigma, c_ty = Typing.type_of env sigma c in
+        pp(lazy(str"c_ty@rwcltac=" ++ pr_constr c_ty));
+      match kind_of_type (Reductionops.whd_all env sigma c_ty) with
+      | AtomicType(e, a) when is_ind_ref e c_eq ->
+          let new_rdx = if dir = L2R then a.(2) else a.(1) in
+          pirrel_rewrite cl rdx rdxt new_rdx dir (sigma,c) c_ty, tclIDTAC, gl
+      | _ -> 
+          let cl' = mkApp (mkNamedLambda pattern_id rdxt cl, [|rdx|]) in
+          let sigma, _ = Typing.type_of env sigma cl' in
+          let gl = pf_merge_uc_of sigma gl in
+          Proofview.V82.of_tactic (convert_concl cl'), rewritetac dir r', gl
+    else
+      let dc, r2 = decompose_lam_n n r' in
+      let r3, _, r3t  = 
+        try destCast r2 with _ ->
+        errorstrm (str "no cast from " ++ pr_constr_pat (snd sr)
+                    ++ str " to " ++ pr_constr r2) in
+      let cl' = mkNamedProd rule_id (compose_prod dc r3t) (lift 1 cl) in
+      let cl'' = mkNamedProd pattern_id rdxt cl' in
+      let itacs = [introid pattern_id; introid rule_id] in
+      let cltac = Proofview.V82.of_tactic (clear [pattern_id; rule_id]) in
+      let rwtacs = [rewritetac dir (mkVar rule_id); cltac] in
+      apply_type cl'' [rdx; compose_lam dc r3], tclTHENLIST (itacs @ rwtacs), gl
+  in
+  let cvtac' _ =
+    try cvtac gl with
+    | PRtype_error ->
+      if occur_existential (pf_concl gl)
+      then errorstrm (str "Rewriting impacts evars")
+      else errorstrm (str "Dependent type error in rewrite of "
+        ++ pf_pr_constr gl (project gl) (mkNamedLambda pattern_id rdxt cl))
+    | CErrors.UserError _ as e -> raise e
+    | e -> anomaly ("cvtac's exception: " ^ Printexc.to_string e);
+  in
+  tclTHEN cvtac' rwtac gl
+
+let prof_rwcltac = mk_profiler "rwrxtac.rwcltac";;
+let rwcltac cl rdx dir sr gl =
+  prof_rwcltac.profile (rwcltac cl rdx dir sr) gl
+;;
+
+
+let lz_coq_prod =
+  let prod = lazy (build_prod ()) in fun () -> Lazy.force prod
+
+let lz_setoid_relation =
+  let sdir = ["Classes"; "RelationClasses"] in
+  let last_srel = ref (Environ.empty_env, None) in
+  fun env -> match !last_srel with
+  | env', srel when env' == env -> srel
+  | _ ->
+    let srel =
+       try Some (coq_constant "Class_setoid" sdir "RewriteRelation")
+       with _ -> None in
+    last_srel := (env, srel); srel
+
+let ssr_is_setoid env =
+  match lz_setoid_relation env with
+  | None -> fun _ _ _ -> false
+  | Some srel ->
+  fun sigma r args ->
+    Rewrite.is_applied_rewrite_relation env 
+      sigma [] (mkApp (r, args)) <> None
+
+let prof_rwxrtac_find_rule = mk_profiler "rwrxtac.find_rule";;
+
+let closed0_check cl p gl =
+  if closed0 cl then
+    errorstrm (str"No occurrence of redex "++pf_pr_constr gl (project gl) p)
+
+let rwprocess_rule dir rule gl =
+  let env = pf_env gl in
+  let coq_prod = lz_coq_prod () in
+  let is_setoid = ssr_is_setoid env in
+  let r_sigma, rules =
+    let rec loop d sigma r t0 rs red =
+      let t =
+        if red = 1 then Tacred.hnf_constr env sigma t0
+        else Reductionops.whd_betaiotazeta sigma t0 in
+      pp(lazy(str"rewrule="++pr_constr_pat t));
+      match kind_of_term t with
+      | Prod (_, xt, at) ->
+        let sigma = create_evar_defs sigma in
+        let sigma = Sigma.Unsafe.of_evar_map sigma in
+        let Sigma (x, sigma, _) = Evarutil.new_evar env sigma xt in
+        let ise = Sigma.to_evar_map sigma in
+        loop d ise (mkApp (r, [|x|])) (subst1 x at) rs 0
+      | App (pr, a) when is_ind_ref pr coq_prod.Coqlib.typ ->
+        let sr sigma = match kind_of_term (Tacred.hnf_constr env sigma r) with
+        | App (c, ra) when is_construct_ref c coq_prod.Coqlib.intro ->
+          fun i -> ra.(i + 1), sigma
+        | _ -> let ra = Array.append a [|r|] in
+          function 1 ->
+            let sigma, pi1 = Evd.fresh_global env sigma coq_prod.Coqlib.proj1 in
+            mkApp (pi1, ra), sigma
+          | _ ->
+            let sigma, pi2 = Evd.fresh_global env sigma coq_prod.Coqlib.proj2 in
+            mkApp (pi2, ra), sigma in
+        if Term.eq_constr a.(0) (build_coq_True ()) then
+         let s, sigma = sr sigma 2 in
+         loop (converse_dir d) sigma s a.(1) rs 0
+        else
+         let s, sigma = sr sigma 2 in
+         let sigma, rs2 = loop d sigma s a.(1) rs 0 in
+         let s, sigma = sr sigma 1 in
+         loop d sigma s a.(0) rs2 0
+      | App (r_eq, a) when Hipattern.match_with_equality_type t != None ->
+        let indu = destInd r_eq and rhs = Array.last a in
+        let np = Inductiveops.inductive_nparamdecls (fst indu) in
+        let ind_ct = Inductiveops.type_of_constructors env indu in
+        let lhs0 = last_arg (strip_prod_assum ind_ct.(0)) in
+        let rdesc = match kind_of_term lhs0 with
+        | Rel i ->
+          let lhs = a.(np - i) in
+          let lhs, rhs = if d = L2R then lhs, rhs else rhs, lhs in
+(* msgnl (str "RW: " ++ pr_rwdir d ++ str " " ++ pr_constr_pat r ++ str " : "
+            ++ pr_constr_pat lhs ++ str " ~> " ++ pr_constr_pat rhs); *)
+          d, r, lhs, rhs
+(*
+          let l_i, r_i = if d = L2R then i, 1 - ndep else 1 - ndep, i in
+          let lhs = a.(np - l_i) and rhs = a.(np - r_i) in
+          let a' = Array.copy a in let _ = a'.(np - l_i) <- mkVar pattern_id in
+          let r' = mkCast (r, DEFAULTcast, mkApp (r_eq, a')) in
+          (d, r', lhs, rhs)
+*)
+        | _ ->
+          let lhs = substl (array_list_of_tl (Array.sub a 0 np)) lhs0 in
+          let lhs, rhs = if d = R2L then lhs, rhs else rhs, lhs in
+          let d' = if Array.length a = 1 then d else converse_dir d in
+          d', r, lhs, rhs in
+        sigma, rdesc :: rs
+      | App (s_eq, a) when is_setoid sigma s_eq a ->
+        let np = Array.length a and i = 3 - dir_org d in
+        let lhs = a.(np - i) and rhs = a.(np + i - 3) in
+        let a' = Array.copy a in let _ = a'.(np - i) <- mkVar pattern_id in
+        let r' = mkCast (r, DEFAULTcast, mkApp (s_eq, a')) in
+        sigma, (d, r', lhs, rhs) :: rs
+      | _ ->
+        if red = 0 then loop d sigma r t rs 1
+        else errorstrm (str "not a rewritable relation: " ++ pr_constr_pat t
+                        ++ spc() ++ str "in rule " ++ pr_constr_pat (snd rule))
+        in
+    let sigma, r = rule in
+    let t = Retyping.get_type_of env sigma r in
+    loop dir sigma r t [] 0
+  in
+    r_sigma, rules
+
+let rwrxtac occ rdx_pat dir rule gl =
+  let env = pf_env gl in
+  let r_sigma, rules = rwprocess_rule dir rule gl in
+  let find_rule rdx =
+    let rec rwtac = function
+      | [] ->
+        errorstrm (str "pattern " ++ pr_constr_pat rdx ++
+                   str " does not match " ++ pr_dir_side dir ++
+                   str " of " ++ pr_constr_pat (snd rule))
+      | (d, r, lhs, rhs) :: rs ->
+        try
+          let ise = unify_HO env (create_evar_defs r_sigma) lhs rdx in
+          if not (rw_progress rhs rdx ise) then raise NoMatch else
+          d, (ise, Evd.evar_universe_context ise, Reductionops.nf_evar ise r)
+        with _ -> rwtac rs in
+     rwtac rules in
+  let find_rule rdx = prof_rwxrtac_find_rule.profile find_rule rdx in
+  let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in
+  let find_R, conclude = match rdx_pat with
+  | Some (_, (In_T _ | In_X_In_T _)) | None ->
+      let upats_origin = dir, snd rule in
+      let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
+        let sigma, pat =
+          mk_tpattern env sigma0 (sigma,r) (rw_progress rhs) d lhs in
+        sigma, pats @ [pat] in
+      let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
+      let find_R, end_R = mk_tpattern_matcher sigma0 occ ~upats_origin rpats in
+      (fun e c _ i -> find_R ~k:(fun _ _ _ h -> mkRel h) e c i), 
+      fun cl -> let rdx,d,r = end_R () in closed0_check cl rdx gl; (d,r),rdx
+  | Some(_, (T e | X_In_T (_,e) | E_As_X_In_T (e,_,_) | E_In_X_In_T (e,_,_))) ->
+      let r = ref None in
+      (fun env c _ h -> do_once r (fun () -> find_rule c, c); mkRel h),
+      (fun concl -> closed0_check concl e gl; assert_done r) in
+  let concl = eval_pattern env0 sigma0 concl0 rdx_pat occ find_R in
+  let (d, r), rdx = conclude concl in
+  let r = Evd.merge_universe_context (pi1 r) (pi2 r), pi3 r in
+  rwcltac concl rdx d r gl
+;;
+
+let prof_rwxrtac = mk_profiler "rwrxtac";;
+let rwrxtac occ rdx_pat dir rule gl =
+  prof_rwxrtac.profile (rwrxtac occ rdx_pat dir rule) gl
+;;
+
+let ssrinstancesofrule ist dir arg gl =
+  let sigma0, env0, concl0 = project gl, pf_env gl, pf_concl gl in
+  let rule = interp_term ist gl arg in
+  let r_sigma, rules = rwprocess_rule dir rule gl in
+  let find, conclude =
+    let upats_origin = dir, snd rule in
+    let rpat env sigma0 (sigma, pats) (d, r, lhs, rhs) =
+      let sigma, pat =
+        mk_tpattern env sigma0 (sigma,r) (rw_progress rhs) d lhs in
+      sigma, pats @ [pat] in
+    let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
+    mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true sigma0 None ~upats_origin rpats in
+  let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr c)); c in
+  ppnl (str"BEGIN INSTANCES");
+  try
+    while true do
+      ignore(find env0 concl0 1 ~k:print)
+    done; raise NoMatch
+  with NoMatch -> ppnl (str"END INSTANCES"); tclIDTAC gl
+
+TACTIC EXTEND ssrinstofruleL2R
+| [ "ssrinstancesofruleL2R" ssrterm(arg) ] -> [ Proofview.V82.tactic (ssrinstancesofrule ist L2R arg) ]
+END
+TACTIC EXTEND ssrinstofruleR2L
+| [ "ssrinstancesofruleR2L" ssrterm(arg) ] -> [ Proofview.V82.tactic (ssrinstancesofrule ist R2L arg) ]
+END
+
+(* Resolve forward reference *)
+let _ = 
+  ipat_rewritetac := fun occ dir c gl -> rwrxtac occ None dir (project gl, c) gl
+
+let rwargtac ist ((dir, mult), (((oclr, occ), grx), (kind, gt))) gl =
+  let fail = ref false in
+  let interp_rpattern ist gl gc =
+    try interp_rpattern ist gl gc
+    with _ when snd mult = May -> fail := true; project gl, T mkProp in
+  let interp gc gl =
+    try interp_term ist gl gc
+    with _ when snd mult = May -> fail := true; (project gl, mkProp) in
+  let rwtac gl = 
+    let rx = Option.map (interp_rpattern ist gl) grx in
+    let t = interp gt gl in
+    (match kind with
+    | RWred sim -> simplintac occ rx sim
+    | RWdef -> if dir = R2L then foldtac occ rx t else unfoldintac occ rx t gt
+    | RWeq -> rwrxtac occ rx dir t) gl in
+  let ctac = cleartac (interp_clr (oclr, (fst gt, snd (interp gt gl)))) in
+  if !fail then ctac gl else tclTHEN (tclMULT mult rwtac) ctac gl
+
+(** Rewrite argument sequence *)
+
+(* type ssrrwargs = ssrrwarg list *)
+
+let pr_ssrrwargs _ _ _ rwargs = pr_list spc pr_rwarg rwargs
+
+ARGUMENT EXTEND ssrrwargs TYPED AS ssrrwarg list PRINTED BY pr_ssrrwargs
+  | [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let ssr_rw_syntax = Summary.ref ~name:"SSR:rewrite" true
+
+let _ =
+  Goptions.declare_bool_option
+    { Goptions.optsync  = true;
+      Goptions.optname  = "ssreflect rewrite";
+      Goptions.optkey   = ["SsrRewrite"];
+      Goptions.optread  = (fun _ -> !ssr_rw_syntax);
+      Goptions.optdepr  = false;
+      Goptions.optwrite = (fun b -> ssr_rw_syntax := b) }
+
+let test_ssr_rw_syntax =
+  let test strm  =
+    if not !ssr_rw_syntax then raise Stream.Failure else
+    if is_ssr_loaded () then () else
+    match Compat.get_tok (Util.stream_nth 0 strm) with
+    | Tok.KEYWORD key when List.mem key.[0] ['{'; '['; '/'] -> ()
+    | _ -> raise Stream.Failure in
+  Gram.Entry.of_parser "test_ssr_rw_syntax" test
+
+GEXTEND Gram
+  GLOBAL: ssrrwargs;
+  ssrrwargs: [[ test_ssr_rw_syntax; a = LIST1 ssrrwarg -> a ]];
+END
+
+(** The "rewrite" tactic *)
+
+let ssrrewritetac ist rwargs =
+  tclTHENLIST (List.map (rwargtac ist) rwargs)
+
+TACTIC EXTEND ssrrewrite
+  | [ "rewrite" ssrrwargs(args) ssrclauses(clauses) ] ->
+    [ Proofview.V82.tactic (tclCLAUSES ist (ssrrewritetac ist args) clauses) ]
+END
+
+(** The "unlock" tactic *)
+
+let pr_unlockarg (occ, t) = pr_occ occ ++ pr_term t
+let pr_ssrunlockarg _ _ _ = pr_unlockarg
+
+ARGUMENT EXTEND ssrunlockarg TYPED AS ssrocc * ssrterm
+  PRINTED BY pr_ssrunlockarg
+  | [  "{" ssrocc(occ) "}" ssrterm(t) ] -> [ occ, t ]
+  | [  ssrterm(t) ] -> [ None, t ]
+END
+
+let pr_ssrunlockargs _ _ _ args = pr_list spc pr_unlockarg args
+
+ARGUMENT EXTEND ssrunlockargs TYPED AS ssrunlockarg list
+  PRINTED BY pr_ssrunlockargs
+  | [  ssrunlockarg_list(args) ] -> [ args ]
+END
+
+let unfoldtac occ ko t kt gl =
+  let cl, c = pf_fill_occ_term gl occ (fst (strip_unfold_term t kt)) in
+  let cl' = subst1 (pf_unfoldn [OnlyOccurrences [1], get_evalref c] gl c) cl in
+  let f = if ko = None then CClosure.betaiotazeta else CClosure.betaiota in
+  Proofview.V82.of_tactic
+    (convert_concl (pf_reduce (Reductionops.clos_norm_flags f) gl cl')) gl
+
+let unlocktac ist args gl =
+  let utac (occ, gt) gl =
+    unfoldtac occ occ (interp_term ist gl gt) (fst gt) gl in
+  let locked, gl = pf_mkSsrConst "locked" gl in
+  let key, gl = pf_mkSsrConst "master_key" gl in
+  let ktacs = [
+    (fun gl -> unfoldtac None None (project gl,locked) '(' gl); 
+    simplest_newcase key ] in
+  tclTHENLIST (List.map utac args @ ktacs) gl
+
+TACTIC EXTEND ssrunlock
+  | [ "unlock" ssrunlockargs(args) ssrclauses(clauses) ] ->
+[  Proofview.V82.tactic (tclCLAUSES ist (unlocktac ist args) clauses) ]
+END
+
+(** 8. Forward chaining tactics (pose, set, have, suffice, wlog) *)
+
+(** Defined identifier *)
+
+type ssrfwdid = identifier
+
+let pr_ssrfwdid _ _ _ id = pr_spc () ++ pr_id id
+
+(* We use a primitive parser for the head identifier of forward *)
+(* tactis to avoid syntactic conflicts with basic Coq tactics. *)
+ARGUMENT EXTEND ssrfwdid TYPED AS ident PRINTED BY pr_ssrfwdid
+  | [ "YouShouldNotTypeThis" ] -> [ anomaly "Grammar placeholder match" ]
+END
+
+let accept_ssrfwdid strm =
+  match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.IDENT id -> accept_before_syms_or_any_id [":"; ":="; "("] strm
+  | _ -> raise Stream.Failure
+
+
+let test_ssrfwdid = Gram.Entry.of_parser "test_ssrfwdid" accept_ssrfwdid
+
+GEXTEND Gram
+  GLOBAL: ssrfwdid;
+  ssrfwdid: [[ test_ssrfwdid; id = Prim.ident -> id ]];
+  END
+
+
+
+(** Definition value formatting *)
+
+(* We use an intermediate structure to correctly render the binder list  *)
+(* abbreviations. We use a list of hints to extract the binders and      *)
+(* base term from a term, for the two first levels of representation of  *)
+(* of constr terms.                                                      *)
+
+type 'term ssrbind =
+  | Bvar of name
+  | Bdecl of name list * 'term
+  | Bdef of name * 'term option * 'term
+  | Bstruct of name
+  | Bcast of 'term
+
+let pr_binder prl = function
+  | Bvar x ->
+    pr_name x
+  | Bdecl (xs, t) ->
+    str "(" ++ pr_list pr_spc pr_name xs ++ str " : " ++ prl t ++ str ")"
+  | Bdef (x, None, v) ->
+    str "(" ++ pr_name x ++ str " := " ++ prl v ++ str ")"
+  | Bdef (x, Some t, v) ->
+    str "(" ++ pr_name x ++ str " : " ++ prl t ++
+                            str " := " ++ prl v ++ str ")"
+  | Bstruct x ->
+    str "{struct " ++ pr_name x ++ str "}"
+  | Bcast t ->
+    str ": " ++ prl t
+
+type 'term ssrbindval = 'term ssrbind list * 'term
+
+type ssrbindfmt =
+  | BFvar
+  | BFdecl of int        (* #xs *)
+  | BFcast               (* final cast *)
+  | BFdef of bool        (* has cast? *)
+  | BFrec of bool * bool (* has struct? * has cast? *)
+
+let rec mkBstruct i = function
+  | Bvar x :: b ->
+    if i = 0 then [Bstruct x] else mkBstruct (i - 1) b
+  | Bdecl (xs, _) :: b ->
+    let i' = i - List.length xs in
+    if i' < 0 then [Bstruct (List.nth xs i)] else mkBstruct i' b
+  | _ :: b -> mkBstruct i b
+  | [] -> []
+
+let rec format_local_binders h0 bl0 = match h0, bl0 with
+  | BFvar :: h, LocalRawAssum ([_, x], _,  _) :: bl ->
+    Bvar x :: format_local_binders h bl
+  | BFdecl _ :: h, LocalRawAssum (lxs, _, t) :: bl ->
+    Bdecl (List.map snd lxs, t) :: format_local_binders h bl
+  | BFdef false :: h, LocalRawDef ((_, x), v) :: bl ->
+    Bdef (x, None, v) :: format_local_binders h bl
+  | BFdef true :: h,
+      LocalRawDef ((_, x), CCast (_, v, CastConv t)) :: bl ->
+    Bdef (x, Some t, v) :: format_local_binders h bl
+  | _ -> []
+  
+let rec format_constr_expr h0 c0 = match h0, c0 with
+  | BFvar :: h, CLambdaN (_, [[_, x], _, _], c) ->
+    let bs, c' = format_constr_expr h c in
+    Bvar x :: bs, c'
+  | BFdecl _:: h, CLambdaN (_, [lxs, _, t], c) ->
+    let bs, c' = format_constr_expr h c in
+    Bdecl (List.map snd lxs, t) :: bs, c'
+  | BFdef false :: h, CLetIn(_, (_, x), v, c) ->
+    let bs, c' = format_constr_expr h c in
+    Bdef (x, None, v) :: bs, c'
+  | BFdef true :: h, CLetIn(_, (_, x), CCast (_, v, CastConv t), c) ->
+    let bs, c' = format_constr_expr h c in
+    Bdef (x, Some t, v) :: bs, c'
+  | [BFcast], CCast (_, c, CastConv t) ->
+    [Bcast t], c
+  | BFrec (has_str, has_cast) :: h, 
+    CFix (_, _, [_, (Some locn, CStructRec), bl, t, c]) ->
+    let bs = format_local_binders h bl in
+    let bstr = if has_str then [Bstruct (Name (snd locn))] else [] in
+    bs @ bstr @ (if has_cast then [Bcast t] else []), c 
+  | BFrec (_, has_cast) :: h, CCoFix (_, _, [_, bl, t, c]) ->
+    format_local_binders h bl @ (if has_cast then [Bcast t] else []), c
+  | _, c ->
+    [], c
+
+let rec format_glob_decl h0 d0 = match h0, d0 with
+  | BFvar :: h, (x, _, None, _) :: d ->
+    Bvar x :: format_glob_decl h d
+  | BFdecl 1 :: h,  (x, _, None, t) :: d ->
+    Bdecl ([x], t) :: format_glob_decl h d
+  | BFdecl n :: h, (x, _, None, t) :: d when n > 1 ->
+    begin match format_glob_decl (BFdecl (n - 1) :: h) d with
+    | Bdecl (xs, _) :: bs -> Bdecl (x :: xs, t) :: bs
+    | bs -> Bdecl ([x], t) :: bs
+    end
+  | BFdef false :: h, (x, _, Some v, _)  :: d ->
+    Bdef (x, None, v) :: format_glob_decl h d
+  | BFdef true:: h, (x, _, Some (GCast (_, v, CastConv t)), _) :: d ->
+    Bdef (x, Some t, v) :: format_glob_decl h d
+  | _, (x, _, None, t) :: d ->
+    Bdecl ([x], t) :: format_glob_decl [] d
+  | _, (x, _, Some v, _) :: d ->
+     Bdef (x, None, v) :: format_glob_decl [] d
+  | _, [] -> []
+
+let rec format_glob_constr h0 c0 = match h0, c0 with
+  | BFvar :: h, GLambda (_, x, _, _, c) ->
+    let bs, c' = format_glob_constr h c in
+    Bvar x :: bs, c'
+  | BFdecl 1 :: h,  GLambda (_, x, _, t, c) ->
+    let bs, c' = format_glob_constr h c in
+    Bdecl ([x], t) :: bs, c'
+  | BFdecl n :: h,  GLambda (_, x, _, t, c) when n > 1 ->
+    begin match format_glob_constr (BFdecl (n - 1) :: h) c with
+    | Bdecl (xs, _) :: bs, c' -> Bdecl (x :: xs, t) :: bs, c'
+    | _ -> [Bdecl ([x], t)], c
+    end
+  | BFdef false :: h, GLetIn(_, x, v, c) ->
+    let bs, c' = format_glob_constr h c in
+    Bdef (x, None, v) :: bs, c'
+  | BFdef true :: h, GLetIn(_, x, GCast (_, v, CastConv t), c) ->
+    let bs, c' = format_glob_constr h c in
+    Bdef (x, Some t, v) :: bs, c'
+  | [BFcast], GCast (_, c, CastConv t) ->
+    [Bcast t], c
+  | BFrec (has_str, has_cast) :: h, GRec (_, f, _, bl, t, c)
+      when Array.length c = 1 ->
+    let bs = format_glob_decl h bl.(0) in
+    let bstr = match has_str, f with
+    | true, GFix ([|Some i, GStructRec|], _) -> mkBstruct i bs
+    | _ -> [] in
+    bs @ bstr @ (if has_cast then [Bcast t.(0)] else []), c.(0)
+  | _, c ->
+    [], c
+
+(** Forward chaining argument *)
+
+(* There are three kinds of forward definitions:           *)
+(*   - Hint: type only, cast to Type, may have proof hint. *)
+(*   - Have: type option + value, no space before type     *)
+(*   - Pose: binders + value, space before binders.        *)
+
+type ssrfwdkind = FwdHint of string * bool | FwdHave | FwdPose
+
+type ssrfwdfmt = ssrfwdkind * ssrbindfmt list
+
+let pr_fwdkind = function
+  | FwdHint (s,_) -> str (s ^ " ") | _ -> str " :=" ++ spc ()
+let pr_fwdfmt (fk, _ : ssrfwdfmt) = pr_fwdkind fk
+
+let wit_ssrfwdfmt = add_genarg "ssrfwdfmt" pr_fwdfmt
+
+(* type ssrfwd = ssrfwdfmt * ssrterm *)
+
+let mkFwdVal fk c = ((fk, []), mk_term ' ' c)
+let mkssrFwdVal fk c = ((fk, []), (c,None))
+
+let mkFwdCast fk loc t c = ((fk, [BFcast]), mk_term ' ' (CCast (loc, c, dC t)))
+let mkssrFwdCast fk loc t c = ((fk, [BFcast]), (c, Some t))
+
+let mkFwdHint s t =
+  let loc = constr_loc t in
+  mkFwdCast (FwdHint (s,false)) loc t (mkCHole loc)
+let mkFwdHintNoTC s t =
+  let loc = constr_loc t in
+  mkFwdCast (FwdHint (s,true)) loc t (mkCHole loc)
+
+let pr_gen_fwd prval prc prlc fk (bs, c) =
+  let prc s = str s ++ spc () ++ prval prc prlc c in
+  match fk, bs with
+  | FwdHint (s,_), [Bcast t] -> str s ++ spc () ++ prlc t
+  | FwdHint (s,_), _ ->  prc (s ^ "(* typeof *)")
+  | FwdHave, [Bcast t] -> str ":" ++ spc () ++ prlc t ++ prc " :="
+  | _, [] -> prc " :="
+  | _, _ -> spc () ++ pr_list spc (pr_binder prlc) bs ++ prc " :="
+
+let pr_fwd_guarded prval prval' = function
+| (fk, h), (_, (_, Some c)) ->
+  pr_gen_fwd prval pr_constr_expr prl_constr_expr fk (format_constr_expr h c)
+| (fk, h), (_, (c, None)) ->
+  pr_gen_fwd prval' pr_glob_constr prl_glob_constr fk (format_glob_constr h c)
+
+let pr_unguarded prc prlc = prlc
+
+let pr_fwd = pr_fwd_guarded pr_unguarded pr_unguarded
+let pr_ssrfwd _ _ _ = pr_fwd
+ 
+ARGUMENT EXTEND ssrfwd TYPED AS (ssrfwdfmt * ssrterm) PRINTED BY pr_ssrfwd
+  | [ ":=" lconstr(c) ] -> [ mkFwdVal FwdPose c ]
+  | [ ":" lconstr (t) ":=" lconstr(c) ] -> [ mkFwdCast FwdPose loc t c ]
+END
+
+(** Independent parsing for binders *)
+
+(* The pose, pose fix, and pose cofix tactics use these internally to  *)
+(* parse argument fragments.                                           *)
+
+let pr_ssrbvar prc _ _ v = prc v
+
+ARGUMENT EXTEND ssrbvar TYPED AS constr PRINTED BY pr_ssrbvar
+| [ ident(id) ] -> [ mkCVar loc id ]
+| [ "_" ] -> [ mkCHole loc ]
+END
+
+let bvar_lname = function
+  | CRef (Ident (loc, id), _) -> loc, Name id
+  | c -> constr_loc c, Anonymous
+
+let pr_ssrbinder prc _ _ (_, c) = prc c
+
+ARGUMENT EXTEND ssrbinder TYPED AS ssrfwdfmt * constr PRINTED BY pr_ssrbinder
+ | [ ssrbvar(bv) ] ->
+   [ let xloc, _ as x = bvar_lname bv in
+     (FwdPose, [BFvar]),
+     CLambdaN (loc,[[x],Default Explicit,mkCHole xloc],mkCHole loc) ]
+ | [ "(" ssrbvar(bv) ")" ] ->
+   [ let xloc, _ as x = bvar_lname bv in
+     (FwdPose, [BFvar]),
+     CLambdaN (loc,[[x],Default Explicit,mkCHole xloc],mkCHole loc) ]
+ | [ "(" ssrbvar(bv) ":" lconstr(t) ")" ] ->
+   [ let x = bvar_lname bv in
+     (FwdPose, [BFdecl 1]),
+     CLambdaN (loc, [[x], Default Explicit, t], mkCHole loc) ]
+ | [ "(" ssrbvar(bv) ne_ssrbvar_list(bvs) ":" lconstr(t) ")" ] ->
+   [ let xs = List.map bvar_lname (bv :: bvs) in
+     let n = List.length xs in
+     (FwdPose, [BFdecl n]),
+     CLambdaN (loc, [xs, Default Explicit, t], mkCHole loc) ]
+ | [ "(" ssrbvar(id) ":" lconstr(t) ":=" lconstr(v) ")" ] ->
+   [ let loc' = Loc.join_loc (constr_loc t) (constr_loc v) in
+     let v' = CCast (loc', v, dC t) in
+     (FwdPose,[BFdef true]), CLetIn (loc,bvar_lname id, v',mkCHole loc) ]
+ | [ "(" ssrbvar(id) ":=" lconstr(v) ")" ] ->
+   [ (FwdPose,[BFdef false]), CLetIn (loc,bvar_lname id, v,mkCHole loc) ]
+END
+
+GEXTEND Gram
+  GLOBAL: ssrbinder;
+  ssrbinder: [
+  [  ["of" | "&"]; c = operconstr LEVEL "99" ->
+     let loc = !@loc in
+     (FwdPose, [BFvar]),
+     CLambdaN (loc,[[loc,Anonymous],Default Explicit,c],mkCHole loc) ]
+  ];
+END
+
+let rec binders_fmts = function
+  | ((_, h), _) :: bs -> h @ binders_fmts bs
+  | _ -> []
+
+let push_binders c2 bs =
+  let loc2 = constr_loc c2 in let mkloc loc1 = Loc.join_loc loc1 loc2 in
+  let rec loop ty c = function
+  | (_, CLambdaN (loc1, b, _)) :: bs when ty ->
+      CProdN (mkloc loc1, b, loop ty c bs)
+  | (_, CLambdaN (loc1, b, _)) :: bs ->
+      CLambdaN (mkloc loc1, b, loop ty c bs)
+  | (_, CLetIn (loc1, x, v, _)) :: bs ->
+      CLetIn (mkloc loc1, x, v, loop ty c bs)
+  | [] -> c
+  | _ -> anomaly "binder not a lambda nor a let in" in
+  match c2 with
+  | CCast (x, ct, CastConv cty) ->
+      (CCast (x, loop false ct bs, CastConv (loop true cty bs)))
+  | ct -> loop false ct bs
+
+let rec fix_binders = function
+  | (_, CLambdaN (_, [xs, _, t], _)) :: bs ->
+      LocalRawAssum (xs, Default Explicit, t) :: fix_binders bs
+  | (_, CLetIn (_, x, v, _)) :: bs ->
+    LocalRawDef (x, v) :: fix_binders bs
+  | _ -> []
+
+let pr_ssrstruct _ _ _ = function
+  | Some id -> str "{struct " ++ pr_id id ++ str "}"
+  | None -> mt ()
+
+ARGUMENT EXTEND ssrstruct TYPED AS ident option PRINTED BY pr_ssrstruct
+| [ "{" "struct" ident(id) "}" ] -> [ Some id ]
+| [ ] -> [ None ]
+END
+
+(** The "pose" tactic *)
+
+(* The plain pose form. *)
+
+let bind_fwd bs = function
+  | (fk, h), (ck, (rc, Some c)) ->
+    (fk,binders_fmts bs @ h), (ck,(rc,Some (push_binders c bs)))
+  | fwd -> fwd
+
+ARGUMENT EXTEND ssrposefwd TYPED AS ssrfwd PRINTED BY pr_ssrfwd
+  | [ ssrbinder_list(bs) ssrfwd(fwd) ] -> [ bind_fwd bs fwd ]
+END
+
+(* The pose fix form. *)
+
+let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd
+
+let bvar_locid = function
+  | CRef (Ident (loc, id), _) -> loc, id
+  | _ -> CErrors.error "Missing identifier after \"(co)fix\""
+
+
+ARGUMENT EXTEND ssrfixfwd TYPED AS ident * ssrfwd PRINTED BY pr_ssrfixfwd
+  | [ "fix" ssrbvar(bv) ssrbinder_list(bs) ssrstruct(sid) ssrfwd(fwd) ] ->
+    [ let (_, id) as lid = bvar_locid bv in
+      let (fk, h), (ck, (rc, oc)) = fwd in
+      let c = Option.get oc in
+      let has_cast, t', c' = match format_constr_expr h c with
+      | [Bcast t'], c' -> true, t', c'
+      | _ -> false, mkCHole (constr_loc c), c in
+      let lb = fix_binders bs in
+      let has_struct, i =
+        let rec loop = function
+          (l', Name id') :: _ when Option.equal Id.equal sid (Some id') -> true, (l', id')
+          | [l', Name id'] when sid = None -> false, (l', id')
+          | _ :: bn -> loop bn
+          | [] -> CErrors.error "Bad structural argument" in
+        loop (names_of_local_assums lb) in
+      let h' = BFrec (has_struct, has_cast) :: binders_fmts bs in
+      let fix = CFix (loc, lid, [lid, (Some i, CStructRec), lb, t', c']) in
+      id, ((fk, h'), (ck, (rc, Some fix))) ]
+END
+
+
+(* The pose cofix form. *)
+
+let pr_ssrcofixfwd _ _ _ (id, fwd) = str " cofix " ++ pr_id id ++ pr_fwd fwd
+
+ARGUMENT EXTEND ssrcofixfwd TYPED AS ssrfixfwd PRINTED BY pr_ssrcofixfwd
+  | [ "cofix" ssrbvar(bv) ssrbinder_list(bs) ssrfwd(fwd) ] ->
+    [ let _, id as lid = bvar_locid bv in
+      let (fk, h), (ck, (rc, oc)) = fwd in
+      let c = Option.get oc in
+      let has_cast, t', c' = match format_constr_expr h c with
+      | [Bcast t'], c' -> true, t', c'
+      | _ -> false, mkCHole (constr_loc c), c in
+      let h' = BFrec (false, has_cast) :: binders_fmts bs in
+      let cofix = CCoFix (loc, lid, [lid, fix_binders bs, t', c']) in
+      id, ((fk, h'), (ck, (rc, Some cofix)))
+    ]
+END
+
+let ssrposetac ist (id, (_, t)) gl =
+  let sigma, t, ucst, _ = pf_abs_ssrterm ist gl t in
+  posetac id t (pf_merge_uc ucst gl)
+
+
+let prof_ssrposetac = mk_profiler "ssrposetac";;
+let ssrposetac arg gl = prof_ssrposetac.profile (ssrposetac arg) gl;;
+  
+TACTIC EXTEND ssrpose
+| [ "pose" ssrfixfwd(ffwd) ] -> [ Proofview.V82.tactic (ssrposetac ist ffwd) ]
+| [ "pose" ssrcofixfwd(ffwd) ] -> [ Proofview.V82.tactic (ssrposetac ist ffwd) ]
+| [ "pose" ssrfwdid(id) ssrposefwd(fwd) ] -> [ Proofview.V82.tactic (ssrposetac ist (id, fwd)) ]
+END
+
+(** The "set" tactic *)
+
+(* type ssrsetfwd = ssrfwd * ssrdocc *)
+
+let guard_setrhs s i = s.[i] = '{'
+
+let pr_setrhs occ prc prlc c =
+  if occ = nodocc then pr_guarded guard_setrhs prlc c else pr_docc occ ++ prc c
+
+let pr_fwd_guarded prval prval' = function
+| (fk, h), (_, (_, Some c)) ->
+  pr_gen_fwd prval pr_constr_expr prl_constr_expr fk (format_constr_expr h c)
+| (fk, h), (_, (c, None)) ->
+  pr_gen_fwd prval' pr_glob_constr prl_glob_constr fk (format_glob_constr h c)
+
+(* This does not print the type, it should be fixed... *)
+let pr_ssrsetfwd _ _ _ (((fk,_),(t,_)), docc) =
+  pr_gen_fwd (fun _ _ -> pr_cpattern)
+    (fun _ -> mt()) (fun _ -> mt()) fk ([Bcast ()],t)
+
+ARGUMENT EXTEND ssrsetfwd
+TYPED AS (ssrfwdfmt * (lcpattern * ssrterm option)) * ssrdocc
+PRINTED BY pr_ssrsetfwd
+| [ ":" lconstr(t) ":=" "{" ssrocc(occ) "}" cpattern(c) ] ->
+  [ mkssrFwdCast FwdPose loc (mk_lterm t) c, mkocc occ ]
+| [ ":" lconstr(t) ":=" lcpattern(c) ] ->
+  [ mkssrFwdCast FwdPose loc (mk_lterm t) c, nodocc ]
+| [ ":=" "{" ssrocc(occ) "}" cpattern(c) ] ->
+  [ mkssrFwdVal FwdPose c, mkocc occ ]
+| [ ":=" lcpattern(c) ] -> [ mkssrFwdVal FwdPose c, nodocc ]
+END
+
+let ssrsettac ist id ((_, (pat, pty)), (_, occ)) gl =
+  let pat = interp_cpattern ist gl pat (Option.map snd pty) in
+  let cl, sigma, env = pf_concl gl, project gl, pf_env gl in
+  let (c, ucst), cl = 
+    try fill_occ_pattern ~raise_NoMatch:true env sigma cl pat occ 1
+    with NoMatch -> redex_of_pattern ~resolve_typeclasses:true env pat, cl in
+  if occur_existential c then errorstrm(str"The pattern"++spc()++
+    pr_constr_pat c++spc()++str"did not match and has holes."++spc()++
+    str"Did you mean pose?") else
+  let c, (gl, cty) =  match kind_of_term c with
+  | Cast(t, DEFAULTcast, ty) -> t, (gl, ty)
+  | _ -> c, pf_type_of gl c in
+  let cl' = mkLetIn (Name id, c, cty, cl) in
+  let gl = pf_merge_uc ucst gl in
+  tclTHEN (Proofview.V82.of_tactic (convert_concl cl')) (introid id) gl
+
+TACTIC EXTEND ssrset
+| [ "set" ssrfwdid(id) ssrsetfwd(fwd) ssrclauses(clauses) ] ->
+  [ Proofview.V82.tactic (tclCLAUSES ist (ssrsettac ist id fwd) clauses) ]
+END
+
+(** The "have" tactic *)
+
+(* type ssrhavefwd = ssrfwd * ssrhint *)
+
+let pr_ssrhavefwd _ _ prt (fwd, hint) = pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrhavefwd TYPED AS ssrfwd * ssrhint PRINTED BY pr_ssrhavefwd
+| [ ":" lconstr(t) ssrhint(hint) ] -> [ mkFwdHint ":" t, hint ]
+| [ ":" lconstr(t) ":=" lconstr(c) ] -> [ mkFwdCast FwdHave loc t c, nohint ]
+| [ ":" lconstr(t) ":=" ] -> [ mkFwdHintNoTC ":" t, nohint ]
+| [ ":=" lconstr(c) ] -> [ mkFwdVal FwdHave c, nohint ]
+END
+
+let intro_id_to_binder = List.map (function 
+  | IpatId id ->
+      let xloc, _ as x = bvar_lname (mkCVar dummy_loc id) in
+      (FwdPose, [BFvar]),
+        CLambdaN (dummy_loc, [[x], Default Explicit, mkCHole xloc],
+          mkCHole dummy_loc)
+  | _ -> anomaly "non-id accepted as binder")
+
+let binder_to_intro_id = List.map (function
+  | (FwdPose, [BFvar]), CLambdaN (_,[ids,_,_],_)
+  | (FwdPose, [BFdecl _]), CLambdaN (_,[ids,_,_],_) ->
+      List.map (function (_, Name id) -> IpatId id | _ -> IpatAnon) ids
+  | (FwdPose, [BFdef _]), CLetIn (_,(_,Name id),_,_) -> [IpatId id]
+  | (FwdPose, [BFdef _]), CLetIn (_,(_,Anonymous),_,_) -> [IpatAnon]
+  | _ -> anomaly "ssrbinder is not a binder")
+
+let pr_ssrhavefwdwbinders _ _ prt (tr,((hpats, (fwd, hint)))) =
+  pr_hpats hpats ++ pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrhavefwdwbinders
+  TYPED AS bool * (ssrhpats * (ssrfwd * ssrhint))
+  PRINTED BY pr_ssrhavefwdwbinders
+| [ ssrhpats_wtransp(trpats) ssrbinder_list(bs) ssrhavefwd(fwd) ] ->
+  [ let tr, pats = trpats in
+    let ((clr, pats), binders), simpl = pats in
+    let allbs = intro_id_to_binder binders @ bs in
+    let allbinders = binders @ List.flatten (binder_to_intro_id bs) in
+    let hint = bind_fwd allbs (fst fwd), snd fwd in
+    tr, ((((clr, pats), allbinders), simpl), hint) ]
+END
+
+(* Tactic. *)
+
+let is_Evar_or_CastedMeta x =
+  isEvar_or_Meta x ||
+  (isCast x && isEvar_or_Meta (pi1 (destCast x)))
+
+let occur_existential_or_casted_meta c =
+  let rec occrec c = match kind_of_term c with
+    | Evar _ -> raise Not_found
+    | Cast (m,_,_) when isMeta m -> raise Not_found
+    | _ -> iter_constr occrec c
+  in try occrec c; false with Not_found -> true
+
+let examine_abstract id gl =
+  let gl, tid = pf_type_of gl id in
+  let abstract, gl = pf_mkSsrConst "abstract" gl in
+  if not (isApp tid) || not (Term.eq_constr (fst(destApp tid)) abstract) then
+    errorstrm(strbrk"not an abstract constant: "++pr_constr id);
+  let _, args_id = destApp tid in
+  if Array.length args_id <> 3 then
+    errorstrm(strbrk"not a proper abstract constant: "++pr_constr id);
+  if not (is_Evar_or_CastedMeta args_id.(2)) then
+    errorstrm(strbrk"abstract constant "++pr_constr id++str" already used");
+  tid, args_id
+
+let pf_find_abstract_proof check_lock gl abstract_n = 
+  let fire gl t = Reductionops.nf_evar (project gl) t in
+  let abstract, gl = pf_mkSsrConst "abstract" gl in
+  let l = Evd.fold_undefined (fun e ei l ->
+    match kind_of_term ei.Evd.evar_concl with
+    | App(hd, [|ty; n; lock|])
+      when (not check_lock || 
+                 (occur_existential_or_casted_meta (fire gl ty) &&
+                  is_Evar_or_CastedMeta (fire gl lock))) &&
+      Term.eq_constr hd abstract && Term.eq_constr n abstract_n -> e::l
+    | _ -> l) (project gl) [] in
+  match l with
+  | [e] -> e
+  | _ -> errorstrm(strbrk"abstract constant "++pr_constr abstract_n++
+           strbrk" not found in the evar map exactly once. "++
+           strbrk"Did you tamper with it?")
+
+let unfold cl =
+  let module R = Reductionops in let module F = CClosure.RedFlags in
+  reduct_in_concl (R.clos_norm_flags (F.mkflags
+    (List.map (fun c -> F.fCONST (fst (destConst c))) cl @
+       [F.fBETA; F.fMATCH; F.fFIX; F.fCOFIX])))
+
+let havegentac ist t gl =
+  let sigma, c, ucst, _ = pf_abs_ssrterm ist gl t in
+  let gl = pf_merge_uc ucst gl in
+  let gl, cty = pf_type_of gl c in
+  apply_type (mkArrow cty (pf_concl gl)) [c] gl
+
+let havetac ist
+  (transp,((((clr, pats), binders), simpl), (((fk, _), t), hint)))
+  suff namefst gl 
+=
+ let concl = pf_concl gl in
+ let skols, pats =
+   List.partition (function IpatNewHidden _ -> true | _ -> false) pats in
+ let itac_mkabs = introstac ~ist skols in
+ let itac_c = introstac ~ist (IpatSimpl(clr,Nop) :: pats) in
+ let itac, id, clr = introstac ~ist pats, tclIDTAC, cleartac clr in
+ let binderstac n =
+   let rec aux = function 0 -> [] | n -> IpatAnon :: aux (n-1) in
+   tclTHEN (if binders <> [] then introstac ~ist (aux n) else tclIDTAC)
+     (introstac ~ist binders) in
+ let simpltac = introstac ~ist simpl in
+ let fixtc =
+   not !ssrhaveNOtcresolution &&
+   match fk with FwdHint(_,true) -> false | _ -> true in
+ let hint = hinttac ist true hint in
+ let cuttac t gl =
+   if transp then
+     let have_let, gl = pf_mkSsrConst "ssr_have_let" gl in
+     let step = mkApp (have_let, [|concl;t|]) in
+     let gl, _ = pf_e_type_of gl step in
+     applyn ~with_evars:true ~with_shelve:false 2 step gl
+   else basecuttac "ssr_have" t gl in
+ (* Introduce now abstract constants, so that everything sees them *)
+ let abstract_key, gl = pf_mkSsrConst "abstract_key" gl in
+ let unlock_abs (idty,args_id) gl =
+    let gl, _ = pf_e_type_of gl idty in
+    pf_unify_HO gl args_id.(2) abstract_key in
+ tclTHENFIRST itac_mkabs (fun gl ->
+  let mkt t = mk_term ' ' t in
+  let mkl t = (' ', (t, None)) in
+  let interp gl rtc t = pf_abs_ssrterm ~resolve_typeclasses:rtc ist gl t in
+  let interp_ty gl rtc t =
+    let a,b,_,u = pf_interp_ty ~resolve_typeclasses:rtc ist gl t in a,b,u in
+  let ct, cty, hole, loc = match t with
+    | _, (_, Some (CCast (loc, ct, CastConv cty))) ->
+      mkt ct, mkt cty, mkt (mkCHole dummy_loc), loc
+    | _, (_, Some ct) ->
+      mkt ct, mkt (mkCHole dummy_loc), mkt (mkCHole dummy_loc), dummy_loc
+    | _, (GCast (loc, ct, CastConv cty), None) ->
+      mkl ct, mkl cty, mkl mkRHole, loc
+    | _, (t, None) -> mkl t, mkl mkRHole, mkl mkRHole, dummy_loc in
+  let gl, cut, sol, itac1, itac2 =
+   match fk, namefst, suff with
+   | FwdHave, true, true ->
+     errorstrm (str"Suff have does not accept a proof term")
+   | FwdHave, false, true ->
+     let cty = combineCG cty hole (mkCArrow loc) mkRArrow in
+     let _,t,uc,_ = interp gl false (combineCG ct cty (mkCCast loc) mkRCast) in
+     let gl = pf_merge_uc uc gl in
+     let gl, ty = pf_type_of gl t in
+     let ctx, _ = decompose_prod_n 1 ty in
+     let assert_is_conv gl =
+       try Proofview.V82.of_tactic (convert_concl (compose_prod ctx concl)) gl
+       with _ -> errorstrm (str "Given proof term is not of type " ++
+         pr_constr (mkArrow (mkVar (id_of_string "_")) concl)) in
+     gl, ty, tclTHEN assert_is_conv (Proofview.V82.of_tactic (apply t)), id, itac_c
+   | FwdHave, false, false ->
+     let skols = List.flatten (List.map (function
+       | IpatNewHidden ids -> ids
+       | _ -> assert false) skols) in
+     let skols_args =
+       List.map (fun id -> examine_abstract (mkVar id) gl) skols in
+     let gl = List.fold_right unlock_abs skols_args gl in
+     let sigma, t, uc, n_evars =
+       interp gl false (combineCG ct cty (mkCCast loc) mkRCast) in
+     if skols <> [] && n_evars <> 0 then
+       CErrors.error ("Automatic generalization of unresolved implicit "^
+                     "arguments together with abstract variables is "^
+                     "not supported");
+     let gl = re_sig (sig_it gl) (Evd.merge_universe_context sigma uc) in
+     let gs =
+       List.map (fun (_,a) ->
+         pf_find_abstract_proof false gl a.(1)) skols_args in
+     let tacopen_skols gl =
+        let stuff, g = Refiner.unpackage gl in
+        Refiner.repackage stuff (gs @ [g]) in
+     let gl, ty = pf_e_type_of gl t in
+     gl, ty, Proofview.V82.of_tactic (apply t), id,
+       tclTHEN (tclTHEN itac_c simpltac)
+         (tclTHEN tacopen_skols (fun gl ->
+            let abstract, gl = pf_mkSsrConst "abstract" gl in
+            Proofview.V82.of_tactic (unfold [abstract; abstract_key]) gl))
+   | _,true,true  ->
+     let _, ty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, mkArrow ty concl, hint, itac, clr
+   | _,false,true ->
+     let _, ty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, mkArrow ty concl, hint, id, itac_c
+   | _, false, false -> 
+     let n, cty, uc = interp_ty gl fixtc cty in let gl = pf_merge_uc uc gl in
+     gl, cty, tclTHEN (binderstac n) hint, id, tclTHEN itac_c simpltac
+   | _, true, false -> assert false in
+  tclTHENS (cuttac cut) [ tclTHEN sol itac1; itac2 ] gl)
+ gl
+;;
+
+(* to extend the abstract value one needs:
+  Utility lemma to partially instantiate an abstract constant type.
+  Lemma use_abstract T n l (x : abstract T n l) : T.
+  Proof. by case: l x. Qed.
+*)
+let ssrabstract ist gens (*last*) gl =
+  let main _ (_,cid) ist gl =
+(*
+    let proj1, proj2, prod =
+      let pdata = build_prod () in
+      pdata.Coqlib.proj1, pdata.Coqlib.proj2, pdata.Coqlib.typ in
+*)
+    let concl, env = pf_concl gl, pf_env gl in
+    let fire gl t = Reductionops.nf_evar (project gl) t in
+    let abstract, gl = pf_mkSsrConst "abstract" gl in
+    let abstract_key, gl = pf_mkSsrConst "abstract_key" gl in
+    let cid_interpreted = interp_cpattern ist gl cid None in
+    let id = mkVar (Option.get (id_of_pattern cid_interpreted)) in
+    let idty, args_id = examine_abstract id gl in
+    let abstract_n = args_id.(1) in
+    let abstract_proof = pf_find_abstract_proof true gl abstract_n in 
+    let gl, proof =
+      let pf_unify_HO gl a b =
+        try pf_unify_HO gl a b
+        with _ -> errorstrm(strbrk"The abstract variable "++pr_constr id++
+          strbrk" cannot abstract this goal.  Did you generalize it?") in
+      let rec find_hole p t =
+        match kind_of_term t with
+        | Evar _ (*when last*) -> pf_unify_HO gl concl t, p
+        | Meta _ (*when last*) -> pf_unify_HO gl concl t, p
+        | Cast(m,_,_) when isEvar_or_Meta m (*when last*) -> pf_unify_HO gl concl t, p
+(*
+        | Evar _ ->
+            let sigma, it = project gl, sig_it gl in
+            let sigma, ty = Evarutil.new_type_evar sigma env in
+            let gl = re_sig it sigma in
+            let p = mkApp (proj2,[|ty;concl;p|]) in
+            let concl = mkApp(prod,[|ty; concl|]) in
+            pf_unify_HO gl concl t, p
+        | App(hd, [|left; right|]) when Term.eq_constr hd prod ->
+            find_hole (mkApp (proj1,[|left;right;p|])) left
+*)
+        | _ -> errorstrm(strbrk"abstract constant "++pr_constr abstract_n++
+               strbrk" has an unexpected shape. Did you tamper with it?")
+      in
+        find_hole
+          ((*if last then*) id
+          (*else mkApp(mkSsrConst "use_abstract",Array.append args_id [|id|])*))
+          (fire gl args_id.(0)) in
+    let gl = (*if last then*) pf_unify_HO gl abstract_key args_id.(2) (*else gl*) in
+    let gl, _ = pf_e_type_of gl idty in
+    let proof = fire gl proof in
+(*     if last then *)
+      let tacopen gl =
+        let stuff, g = Refiner.unpackage gl in
+        Refiner.repackage stuff [ g; abstract_proof ] in
+      tclTHENS tacopen [tclSOLVE [Proofview.V82.of_tactic (apply proof)]; Proofview.V82.of_tactic (unfold[abstract;abstract_key])] gl
+(* else apply proof gl *)
+  in
+  let introback ist (gens, _) =
+    introstac ~ist
+      (List.map (fun (_,cp) -> match id_of_pattern (interp_cpattern ist gl cp None) with
+        | None -> IpatAnon
+        | Some id -> IpatId id)
+        (List.tl (List.hd gens))) in
+  tclTHEN (with_dgens gens main ist) (introback ist gens) gl
+
+(* The standard TACTIC EXTEND does not work for abstract *)
+GEXTEND Gram
+  GLOBAL: tactic_expr;
+  tactic_expr: LEVEL "3"
+    [ RIGHTA [ IDENT "abstract"; gens = ssrdgens ->
+               ssrtac_expr !@loc "abstract"
+                [Tacexpr.TacGeneric (Genarg.in_gen (Genarg.rawwit wit_ssrdgens) gens)] ]];
+END
+TACTIC EXTEND ssrabstract
+| [ "abstract" ssrdgens(gens) ] -> [
+    if List.length (fst gens) <> 1 then
+      errorstrm (str"dependents switches '/' not allowed here");
+    Proofview.V82.tactic (ssrabstract ist gens) ]
+END
+
+let prof_havetac = mk_profiler "havetac";;
+let havetac arg a b gl = prof_havetac.profile (havetac arg a b) gl;;
+
+TACTIC EXTEND ssrhave
+| [ "have" ssrhavefwdwbinders(fwd) ] ->
+  [ Proofview.V82.tactic (havetac ist fwd false false) ]
+END
+
+TACTIC EXTEND ssrhavesuff
+| [ "have" "suff" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ Proofview.V82.tactic (havetac ist (false,(pats,fwd)) true false) ]
+END
+
+TACTIC EXTEND ssrhavesuffices
+| [ "have" "suffices" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ Proofview.V82.tactic (havetac ist (false,(pats,fwd)) true false) ]
+END
+
+TACTIC EXTEND ssrsuffhave
+| [ "suff" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ Proofview.V82.tactic (havetac ist (false,(pats,fwd)) true true) ]
+END
+
+TACTIC EXTEND ssrsufficeshave
+| [ "suffices" "have" ssrhpats_nobs(pats) ssrhavefwd(fwd) ] ->
+  [ Proofview.V82.tactic (havetac ist (false,(pats,fwd)) true true) ]
+END
+
+(** The "suffice" tactic *)
+
+let pr_ssrsufffwdwbinders _ _ prt (hpats, (fwd, hint)) =
+  pr_hpats hpats ++ pr_fwd fwd ++ pr_hint prt hint
+
+ARGUMENT EXTEND ssrsufffwd
+  TYPED AS ssrhpats * (ssrfwd * ssrhint) PRINTED BY pr_ssrsufffwdwbinders
+| [ ssrhpats(pats) ssrbinder_list(bs)  ":" lconstr(t) ssrhint(hint) ] ->
+  [ let ((clr, pats), binders), simpl = pats in
+    let allbs = intro_id_to_binder binders @ bs in
+    let allbinders = binders @ List.flatten (binder_to_intro_id bs) in
+    let fwd = mkFwdHint ":" t in
+    (((clr, pats), allbinders), simpl), (bind_fwd allbs fwd, hint) ]
+END
+
+let sufftac ist ((((clr, pats),binders),simpl), ((_, c), hint)) =
+  let htac = tclTHEN (introstac ~ist pats) (hinttac ist true hint) in
+  let c = match c with
+  | (a, (b, Some (CCast (_, _, CastConv cty)))) -> a, (b, Some cty)
+  | (a, (GCast (_, _, CastConv cty), None)) -> a, (cty, None)
+  | _ -> anomaly "suff: ssr cast hole deleted by typecheck" in
+  let ctac gl =
+    let _,ty,_,uc = pf_interp_ty ist gl c in let gl = pf_merge_uc uc gl in
+    basecuttac "ssr_suff" ty gl in
+  tclTHENS ctac [htac; tclTHEN (cleartac clr) (introstac ~ist (binders@simpl))]
+
+TACTIC EXTEND ssrsuff
+| [ "suff" ssrsufffwd(fwd) ] -> [ Proofview.V82.tactic (sufftac ist fwd) ]
+END
+
+TACTIC EXTEND ssrsuffices
+| [ "suffices" ssrsufffwd(fwd) ] -> [ Proofview.V82.tactic (sufftac ist fwd) ]
+END
+
+(** The "wlog" (Without Loss Of Generality) tactic *)
+
+(* type ssrwlogfwd = ssrwgen list * ssrfwd *)
+
+let pr_ssrwlogfwd _ _ _ (gens, t) =
+  str ":" ++ pr_list mt pr_wgen gens ++ spc() ++ pr_fwd t
+
+ARGUMENT EXTEND ssrwlogfwd TYPED AS ssrwgen list * ssrfwd
+                         PRINTED BY pr_ssrwlogfwd
+| [ ":" ssrwgen_list(gens) "/" lconstr(t) ] -> [ gens, mkFwdHint "/" t]
+END
+
+let destProd_or_LetIn c =
+  match kind_of_term c with
+  | Prod (n,ty,c) -> RelDecl.LocalAssum (n, ty), c
+  | LetIn (n,bo,ty,c) -> RelDecl.LocalDef (n, bo, ty), c
+  | _ -> raise DestKO
+        
+let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
+  let mkabs gen = abs_wgen false ist (fun x -> x) gen in
+  let mkclr gen clrs = clr_of_wgen gen clrs in
+  let mkpats = function
+  | _, Some ((x, _), _) -> fun pats -> IpatId (hoi_id x) :: pats
+  | _ -> fun x -> x in
+  let ct = match ct with
+  | (a, (b, Some (CCast (_, _, CastConv cty)))) -> a, (b, Some cty)
+  | (a, (GCast (_, _, CastConv cty), None)) -> a, (cty, None)
+  | _ -> anomaly "wlog: ssr cast hole deleted by typecheck" in
+  let cut_implies_goal = not (suff || ghave <> `NoGen) in
+  let c, args, ct, gl =
+    let gens = List.filter (function _, Some _ -> true | _ -> false) gens in
+    let concl = pf_concl gl in
+    let c = mkProp in
+    let c = if cut_implies_goal then mkArrow c concl else c in
+    let gl, args, c = List.fold_right mkabs gens (gl,[],c) in
+    let env, _ =
+      List.fold_left (fun (env, c) _ ->
+        let rd, c = destProd_or_LetIn c in
+        Environ.push_rel rd env, c) (pf_env gl, c) gens in
+    let sigma = project gl in
+    let sigma = Sigma.Unsafe.of_evar_map sigma in
+    let Sigma (ev, sigma, _) = Evarutil.new_evar env sigma Term.mkProp in
+    let sigma = Sigma.to_evar_map sigma in
+    let k, _ = Term.destEvar ev in
+    let fake_gl = {Evd.it = k; Evd.sigma = sigma} in
+    let _, ct, _, uc = pf_interp_ty ist fake_gl ct in
+    let rec var2rel c g s = match kind_of_term c, g with
+      | Prod(Anonymous,_,c), [] -> mkProd(Anonymous, Vars.subst_vars s ct, c)
+      | Sort _, [] -> Vars.subst_vars s ct
+      | LetIn(Name id as n,b,ty,c), _::g -> mkLetIn (n,b,ty,var2rel c g (id::s))
+      | Prod(Name id as n,ty,c), _::g -> mkProd (n,ty,var2rel c g (id::s))
+      | _ -> CErrors.anomaly(str"SSR: wlog: var2rel: " ++ pr_constr c) in
+    let c = var2rel c gens [] in
+    let rec pired c = function
+      | [] -> c
+      | t::ts as args -> match kind_of_term c with
+         | Prod(_,_,c) -> pired (subst1 t c) ts
+         | LetIn(id,b,ty,c) -> mkLetIn (id,b,ty,pired c args)
+         | _ -> CErrors.anomaly(str"SSR: wlog: pired: " ++ pr_constr c) in
+    c, args, pired c args, pf_merge_uc uc gl in
+  let tacipat pats = introstac ~ist pats in
+  let tacigens = 
+    tclTHEN
+      (tclTHENLIST(List.rev(List.fold_right mkclr gens [cleartac clr0])))
+      (introstac ~ist (List.fold_right mkpats gens [])) in
+  let hinttac = hinttac ist true hint in
+  let cut_kind, fst_goal_tac, snd_goal_tac =
+    match suff, ghave with
+    | true, `NoGen -> "ssr_wlog", tclTHEN hinttac (tacipat pats), tacigens
+    | false, `NoGen -> "ssr_wlog", hinttac, tclTHEN tacigens (tacipat pats)
+    | true, `Gen _ -> assert false
+    | false, `Gen id ->
+      if gens = [] then errorstrm(str"gen have requires some generalizations");
+      let clear0 = cleartac clr0 in
+      let id, name_general_hyp, cleanup, pats = match id, pats with
+      | None, (IpatId id as ip)::pats -> Some id, tacipat [ip], clear0, pats
+      | None, _ -> None, tclIDTAC, clear0, pats
+      | Some (Some id),_ -> Some id, introid id, clear0, pats
+      | Some _,_ ->
+          let id = mk_anon_id "tmp" gl in
+          Some id, introid id, tclTHEN clear0 (Proofview.V82.of_tactic (clear [id])), pats in
+      let tac_specialize = match id with
+      | None -> tclIDTAC
+      | Some id ->
+        if pats = [] then tclIDTAC else
+        let args = Array.of_list args in
+        pp(lazy(str"specialized="++pr_constr (mkApp (mkVar id,args))));
+        pp(lazy(str"specialized_ty="++pr_constr ct));
+        tclTHENS (basecuttac "ssr_have" ct)
+          [Proofview.V82.of_tactic (apply (mkApp (mkVar id,args))); tclIDTAC] in
+      "ssr_have",
+      (if hint = nohint then tacigens else hinttac),
+      tclTHENLIST [name_general_hyp; tac_specialize; tacipat pats; cleanup]
+  in
+  tclTHENS (basecuttac cut_kind c) [fst_goal_tac; snd_goal_tac] gl
+
+TACTIC EXTEND ssrwlog
+| [ "wlog" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint false `NoGen) ]
+END
+
+TACTIC EXTEND ssrwlogs
+| [ "wlog" "suff" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwlogss
+| [ "wlog" "suffices" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutloss
+| [ "without" "loss" ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint false `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutlosss
+| [ "without" "loss" "suff" 
+    ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+TACTIC EXTEND ssrwithoutlossss
+| [ "without" "loss" "suffices" 
+    ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ]->
+  [ Proofview.V82.tactic (wlogtac ist pats fwd hint true `NoGen) ]
+END
+
+(* Generally have *)
+let pr_idcomma _ _ _ = function
+  | None -> mt()
+  | Some None -> str"_, "
+  | Some (Some id) -> pr_id id ++ str", "
+
+ARGUMENT EXTEND ssr_idcomma TYPED AS ident option option PRINTED BY pr_idcomma
+  | [ ] -> [ None ]
+END
+
+let accept_idcomma strm =
+  match Compat.get_tok (stream_nth 0 strm) with
+  | Tok.IDENT _ | Tok.KEYWORD "_" -> accept_before_syms [","] strm
+  | _ -> raise Stream.Failure
+
+let test_idcomma = Gram.Entry.of_parser "test_idcomma" accept_idcomma
+
+GEXTEND Gram
+  GLOBAL: ssr_idcomma;
+  ssr_idcomma: [ [ test_idcomma; 
+    ip = [ id = IDENT -> Some (id_of_string id) | "_" -> None ]; "," ->
+    Some ip
+  ] ];
+END
+
+let augment_preclr clr1 (((clr0, x),y),z) = (((clr1 @ clr0, x),y),z)
+
+TACTIC EXTEND ssrgenhave
+| [ "gen" "have" ssrclear(clr)
+    ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ let pats = augment_preclr clr pats in
+    Proofview.V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) ]
+END
+
+TACTIC EXTEND ssrgenhave2
+| [ "generally" "have" ssrclear(clr)
+    ssr_idcomma(id) ssrhpats_nobs(pats) ssrwlogfwd(fwd) ssrhint(hint) ] ->
+  [ let pats = augment_preclr clr pats in
+    Proofview.V82.tactic (wlogtac ist pats fwd hint false (`Gen id)) ]
+END
+
+(** Canonical Structure alias *)
+
+GEXTEND Gram
+  GLOBAL: gallina_ext;
+
+  gallina_ext:
+      (* Canonical structure *)
+     [[ IDENT "Canonical"; qid = Constr.global ->
+	  Vernacexpr.VernacCanonical (AN qid)
+      | IDENT "Canonical"; ntn = Prim.by_notation ->
+	  Vernacexpr.VernacCanonical (ByNotation ntn)
+      | IDENT "Canonical"; qid = Constr.global;
+          d = G_vernac.def_body ->
+          let s = coerce_reference_to_id qid in
+	  Vernacexpr.VernacDefinition
+	    ((Some Decl_kinds.Global,Decl_kinds.CanonicalStructure),
+             ((dummy_loc,s),None),(d  ))
+  ]];
+END
+
+(** 9. Keyword compatibility fixes. *)
+
+(* Coq v8.1 notation uses "by" and "of" quasi-keywords, i.e., reserved *)
+(* identifiers used as keywords. This is incompatible with ssreflect.v *)
+(* which makes "by" and "of" true keywords, because of technicalities  *)
+(* in the internal lexer-parser API of Coq. We patch this here by      *)
+(* adding new parsing rules that recognize the new keywords.           *)
+(*   To make matters worse, the Coq grammar for tactics fails to       *)
+(* export the non-terminals we need to patch. Fortunately, the CamlP5  *)
+(* API provides a backdoor access (with loads of Obj.magic trickery).  *)
+
+(* Coq v8.3 defines "by" as a keyword, some hacks are not needed any   *)
+(* longer and thus comment out. Such comments are marked with v8.3     *)
+
+GEXTEND Gram
+  GLOBAL: Tactic.hypident;
+  Tactic.hypident: [
+  [ "("; IDENT "type"; "of"; id = Prim.identref; ")" -> id, InHypTypeOnly
+  | "("; IDENT "value"; "of"; id = Prim.identref; ")" -> id, InHypValueOnly
+  ] ];
+END
+
+GEXTEND Gram
+  GLOBAL: hloc;
+hloc: [
+  [ "in"; "("; "Type"; "of"; id = ident; ")" -> 
+    HypLocation ((dummy_loc,id), InHypTypeOnly)
+  | "in"; "("; IDENT "Value"; "of"; id = ident; ")" -> 
+    HypLocation ((dummy_loc,id), InHypValueOnly)
+  ] ];
+END
+
+GEXTEND Gram
+  GLOBAL: Tactic.constr_eval;
+  Tactic.constr_eval: [
+    [ IDENT "type"; "of"; c = Constr.constr -> Genredexpr.ConstrTypeOf c ]
+  ];
+END
+
+(* We wipe out all the keywords generated by the grammar rules we defined. *)
+(* The user is supposed to Require Import ssreflect or Require ssreflect   *)
+(* and Import ssreflect.SsrSyntax to obtain these keywords and as a         *)
+(* consequence the extended ssreflect grammar.                             *)
+let () = CLexer.unfreeze frozen_lexer ;;
+
+(* vim: set filetype=ocaml foldmethod=marker: *)
diff --git a/mathcomp/ssreflect/plugin/v8.6/ssreflect_plugin.mlpack b/mathcomp/ssreflect/plugin/v8.6/ssreflect_plugin.mlpack
new file mode 100644
index 0000000..006b70f
--- /dev/null
+++ b/mathcomp/ssreflect/plugin/v8.6/ssreflect_plugin.mlpack
@@ -0,0 +1,2 @@
+Ssrmatching
+Ssreflect
diff --git a/mathcomp/ssreflect/prime.v b/mathcomp/ssreflect/prime.v
index 6b9720b..5c6acce 100644
--- a/mathcomp/ssreflect/prime.v
+++ b/mathcomp/ssreflect/prime.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/seq.v b/mathcomp/ssreflect/seq.v
index 6c8e23e..b622543 100644
--- a/mathcomp/ssreflect/seq.v
+++ b/mathcomp/ssreflect/seq.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/ssrbool.v b/mathcomp/ssreflect/ssrbool.v
index 9049608..bb8606f 100644
--- a/mathcomp/ssreflect/ssrbool.v
+++ b/mathcomp/ssreflect/ssrbool.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssreflect/ssreflect.v b/mathcomp/ssreflect/ssreflect.v
index a271eb2..079bf72 100644
--- a/mathcomp/ssreflect/ssreflect.v
+++ b/mathcomp/ssreflect/ssreflect.v
@@ -1,8 +1,8 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import Bool. (* For bool_scope delimiter 'bool'. *)
 Require Import ssrmatching.
-Declare ML Module "ssreflect".
+Declare ML Module "ssreflect_plugin".
 Set SsrAstVersion.
 
 (******************************************************************************)
@@ -422,3 +422,14 @@ End ApplyIff.
 Hint View for move/ iffLRn|2 iffRLn|2 iffLR|2 iffRL|2.
 Hint View for apply/ iffRLn|2 iffLRn|2 iffRL|2 iffLR|2.
 
+(* To focus non-ssreflect tactics on a subterm, eg vm_compute. *)
+(* Usage:                                                      *)
+(*   elim/abstract_context: (pattern) => G defG.               *)
+(*   vm_compute; rewrite {}defG {G}.                           *)
+(* Note that vm_cast are not stored in the proof term          *)
+(* for reductions occuring in the context, hence               *)
+(*   set here := pattern; vm_compute in (value of here)        *)
+(* blows up at Qed time.                                       *)
+Lemma abstract_context T (P : T -> Type) x :
+  (forall Q, Q = P -> Q x) -> P x.
+Proof. by move=> /(_ P); apply. Qed.
diff --git a/mathcomp/ssreflect/ssrfun.v b/mathcomp/ssreflect/ssrfun.v
index 32b84ad..48cf417 100644
--- a/mathcomp/ssreflect/ssrfun.v
+++ b/mathcomp/ssreflect/ssrfun.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import ssreflect.
 
diff --git a/mathcomp/ssreflect/ssrnat.v b/mathcomp/ssreflect/ssrnat.v
index 9b9f6a5..4b9523f 100644
--- a/mathcomp/ssreflect/ssrnat.v
+++ b/mathcomp/ssreflect/ssrnat.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
@@ -441,15 +441,18 @@ CoInductive eqn0_xor_gt0 n : bool -> bool -> Set :=
 Lemma posnP n : eqn0_xor_gt0 n (n == 0) (0 < n).
 Proof. by case: n; constructor. Qed.
 
-CoInductive compare_nat m n : bool -> bool -> bool -> Set :=
-  | CompareNatLt of m < n : compare_nat m n true false false
-  | CompareNatGt of m > n : compare_nat m n false true false
-  | CompareNatEq of m = n : compare_nat m n false false true.
+CoInductive compare_nat m n : bool -> bool -> bool -> bool -> bool -> bool -> Set :=
+  | CompareNatLt of m < n : compare_nat m n true false true false false false
+  | CompareNatGt of m > n : compare_nat m n false true false true false false
+  | CompareNatEq of m = n : compare_nat m n true true false false true true.
 
-Lemma ltngtP m n : compare_nat m n (m < n) (n < m) (m == n).
+Lemma ltngtP m n : compare_nat m n (m <= n) (n <= m) (m < n) (n < m) (n == m) (m == n).
 Proof.
-rewrite ltn_neqAle eqn_leq; case: ltnP; first by constructor.
-by rewrite leq_eqVlt orbC; case: leqP; constructor; first apply/eqnP.
+rewrite !ltn_neqAle [_ == m]eq_sym; case: ltnP => [mn|].
+  by rewrite ltnW // gtn_eqF //; constructor.
+rewrite leq_eqVlt; case: ltnP; rewrite ?(orbT, orbF) => //= lt_nm eq_mn.
+  by rewrite ltn_eqF //; constructor.
+by rewrite eq_mn; constructor; apply/eqP.
 Qed.
 
 (* Monotonicity lemmas *)
@@ -562,7 +565,7 @@ Lemma maxnC : commutative maxn.
 Proof. by move=> m n; rewrite /maxn; case ltngtP. Qed.
 
 Lemma maxnE m n : maxn m n = m + (n - m).
-Proof. by rewrite /maxn addnC; case: leqP => [/eqnP-> | /ltnW/subnK]. Qed.
+Proof. by rewrite /maxn addnC; case: leqP => [/eqnP->|/ltnW/subnK]. Qed.
 
 Lemma maxnAC : right_commutative maxn.
 Proof. by move=> m n p; rewrite !maxnE -!addnA !subnDA -!maxnE maxnC. Qed.
@@ -1591,3 +1594,15 @@ Ltac nat_congr := first
      apply: (congr1 (addn X1) _);
      symmetry
    end ].
+
+Module mc_1_6.
+
+CoInductive compare_nat m n : bool -> bool -> bool -> Set :=
+  | CompareNatLt of m < n : compare_nat m n true false false
+  | CompareNatGt of m > n : compare_nat m n false true false
+  | CompareNatEq of m = n : compare_nat m n false false true.
+
+Lemma ltngtP m n : compare_nat m n (m < n) (n < m) (m == n).
+Proof. by case: ltngtP; constructor. Qed.
+
+End mc_1_6.
diff --git a/mathcomp/ssreflect/tuple.v b/mathcomp/ssreflect/tuple.v
index a6a154f..7023bb4 100644
--- a/mathcomp/ssreflect/tuple.v
+++ b/mathcomp/ssreflect/tuple.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/Make b/mathcomp/ssrtest/Make
index 716dc4a..ab4c666 100644
--- a/mathcomp/ssrtest/Make
+++ b/mathcomp/ssrtest/Make
@@ -39,7 +39,6 @@ view_case.v
 wlogletin.v
 wlog_suff.v
 wlong_intro.v
-tacnotationpattern.v
 
 -R ../theories Ssreflect
 -I ../src/
diff --git a/mathcomp/ssrtest/absevarprop.v b/mathcomp/ssrtest/absevarprop.v
index 0d2e192..b8ae7d6 100644
--- a/mathcomp/ssrtest/absevarprop.v
+++ b/mathcomp/ssrtest/absevarprop.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/binders.v b/mathcomp/ssrtest/binders.v
index 7350e38..32e351f 100644
--- a/mathcomp/ssrtest/binders.v
+++ b/mathcomp/ssrtest/binders.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/binders_of.v b/mathcomp/ssrtest/binders_of.v
index 465d290..2a88502 100644
--- a/mathcomp/ssrtest/binders_of.v
+++ b/mathcomp/ssrtest/binders_of.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 Require Import mathcomp.ssreflect.ssreflect.
diff --git a/mathcomp/ssrtest/caseview.v b/mathcomp/ssrtest/caseview.v
index e1d21b1..478f573 100644
--- a/mathcomp/ssrtest/caseview.v
+++ b/mathcomp/ssrtest/caseview.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/congr.v b/mathcomp/ssrtest/congr.v
index faca4f0..2a7b824 100644
--- a/mathcomp/ssrtest/congr.v
+++ b/mathcomp/ssrtest/congr.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/deferclear.v b/mathcomp/ssrtest/deferclear.v
index 312eed8..849a7c9 100644
--- a/mathcomp/ssrtest/deferclear.v
+++ b/mathcomp/ssrtest/deferclear.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/dependent_type_err.v b/mathcomp/ssrtest/dependent_type_err.v
index f845a73..ef2dc9d 100644
--- a/mathcomp/ssrtest/dependent_type_err.v
+++ b/mathcomp/ssrtest/dependent_type_err.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/elim.v b/mathcomp/ssrtest/elim.v
index 028d589..bc8701e 100644
--- a/mathcomp/ssrtest/elim.v
+++ b/mathcomp/ssrtest/elim.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/elim2.v b/mathcomp/ssrtest/elim2.v
index 0eff79d..55c7a81 100644
--- a/mathcomp/ssrtest/elim2.v
+++ b/mathcomp/ssrtest/elim2.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/elim_pattern.v b/mathcomp/ssrtest/elim_pattern.v
index 35ade86..24bd0fb 100644
--- a/mathcomp/ssrtest/elim_pattern.v
+++ b/mathcomp/ssrtest/elim_pattern.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/first_n.v b/mathcomp/ssrtest/first_n.v
index 2cb6c32..126f8a5 100644
--- a/mathcomp/ssrtest/first_n.v
+++ b/mathcomp/ssrtest/first_n.v
@@ -1,11 +1,11 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
 Require Import ssrbool.
 
 Lemma test : False -> (bool -> False -> True -> True) -> True.
-move=> F; let w := 2 in apply; last w first.
+move=> F; let w := constr:(2) in apply; last w first.
 - by apply: F.
 - by apply: I.
 by apply: true.
diff --git a/mathcomp/ssrtest/gen_have.v b/mathcomp/ssrtest/gen_have.v
index 2ccfb2e..d08cabe 100644
--- a/mathcomp/ssrtest/gen_have.v
+++ b/mathcomp/ssrtest/gen_have.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/gen_pattern.v b/mathcomp/ssrtest/gen_pattern.v
index 732fca8..eb4aee8 100644
--- a/mathcomp/ssrtest/gen_pattern.v
+++ b/mathcomp/ssrtest/gen_pattern.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/have_TC.v b/mathcomp/ssrtest/have_TC.v
index 75381ca..c95b224 100644
--- a/mathcomp/ssrtest/have_TC.v
+++ b/mathcomp/ssrtest/have_TC.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/have_transp.v b/mathcomp/ssrtest/have_transp.v
index 4a0b2ff..fec720c 100644
--- a/mathcomp/ssrtest/have_transp.v
+++ b/mathcomp/ssrtest/have_transp.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/have_view_idiom.v b/mathcomp/ssrtest/have_view_idiom.v
index 1287870..07cfa11 100644
--- a/mathcomp/ssrtest/have_view_idiom.v
+++ b/mathcomp/ssrtest/have_view_idiom.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/havesuff.v b/mathcomp/ssrtest/havesuff.v
index 36d8735..f97f445 100644
--- a/mathcomp/ssrtest/havesuff.v
+++ b/mathcomp/ssrtest/havesuff.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/if_isnt.v b/mathcomp/ssrtest/if_isnt.v
index 883c996..08e242e 100644
--- a/mathcomp/ssrtest/if_isnt.v
+++ b/mathcomp/ssrtest/if_isnt.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/indetLHS.v b/mathcomp/ssrtest/indetLHS.v
index f394b17..edaf128 100644
--- a/mathcomp/ssrtest/indetLHS.v
+++ b/mathcomp/ssrtest/indetLHS.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/intro_beta.v b/mathcomp/ssrtest/intro_beta.v
index f9d241a..6b1b96d 100644
--- a/mathcomp/ssrtest/intro_beta.v
+++ b/mathcomp/ssrtest/intro_beta.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/intro_noop.v b/mathcomp/ssrtest/intro_noop.v
index 5310e2e..9b75bcf 100644
--- a/mathcomp/ssrtest/intro_noop.v
+++ b/mathcomp/ssrtest/intro_noop.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/ipatalternation.v b/mathcomp/ssrtest/ipatalternation.v
index 1732328..65f3760 100644
--- a/mathcomp/ssrtest/ipatalternation.v
+++ b/mathcomp/ssrtest/ipatalternation.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/ltac_have.v b/mathcomp/ssrtest/ltac_have.v
index a5923d9..1b30951 100644
--- a/mathcomp/ssrtest/ltac_have.v
+++ b/mathcomp/ssrtest/ltac_have.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/ltac_in.v b/mathcomp/ssrtest/ltac_in.v
index 43c5755..06d8dc7 100644
--- a/mathcomp/ssrtest/ltac_in.v
+++ b/mathcomp/ssrtest/ltac_in.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/move_after.v b/mathcomp/ssrtest/move_after.v
index d5fc4db..a6c455c 100644
--- a/mathcomp/ssrtest/move_after.v
+++ b/mathcomp/ssrtest/move_after.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/multiview.v b/mathcomp/ssrtest/multiview.v
index 9cf4cd0..57a26ff 100644
--- a/mathcomp/ssrtest/multiview.v
+++ b/mathcomp/ssrtest/multiview.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/occarrow.v b/mathcomp/ssrtest/occarrow.v
index 4765702..927473f 100644
--- a/mathcomp/ssrtest/occarrow.v
+++ b/mathcomp/ssrtest/occarrow.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/patnoX.v b/mathcomp/ssrtest/patnoX.v
index 0d21c4f..a879b37 100644
--- a/mathcomp/ssrtest/patnoX.v
+++ b/mathcomp/ssrtest/patnoX.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/rewpatterns.v b/mathcomp/ssrtest/rewpatterns.v
index 4af3648..95c3c00 100644
--- a/mathcomp/ssrtest/rewpatterns.v
+++ b/mathcomp/ssrtest/rewpatterns.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 
 Require Import mathcomp.ssreflect.ssreflect.
diff --git a/mathcomp/ssrtest/set_lamda.v b/mathcomp/ssrtest/set_lamda.v
index f004346..6366130 100644
--- a/mathcomp/ssrtest/set_lamda.v
+++ b/mathcomp/ssrtest/set_lamda.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/set_pattern.v b/mathcomp/ssrtest/set_pattern.v
index 86de57c..25b6967 100644
--- a/mathcomp/ssrtest/set_pattern.v
+++ b/mathcomp/ssrtest/set_pattern.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/ssrsyntax1.v b/mathcomp/ssrtest/ssrsyntax1.v
index 5eabcc3..9116ba2 100644
--- a/mathcomp/ssrtest/ssrsyntax1.v
+++ b/mathcomp/ssrtest/ssrsyntax1.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require mathcomp.ssreflect.ssreflect.
 Require Import Arith.
diff --git a/mathcomp/ssrtest/ssrsyntax2.v b/mathcomp/ssrtest/ssrsyntax2.v
index b3537ad..5e174a2 100644
--- a/mathcomp/ssrtest/ssrsyntax2.v
+++ b/mathcomp/ssrtest/ssrsyntax2.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssrtest.ssrsyntax1.
 Require Import Arith.
diff --git a/mathcomp/ssrtest/tacnotationpattern.v b/mathcomp/ssrtest/tacnotationpattern.v
deleted file mode 100644
index 13de4bc..0000000
--- a/mathcomp/ssrtest/tacnotationpattern.v
+++ /dev/null
@@ -1,14 +0,0 @@
-Require Import mathcomp.ssreflect.ssreflect.
-Tactic Notation "at" ssrpatternarg(p) tactic(t)
- := 
-    ssrpattern p; let top := fresh in intro top;
-    t top; try unfold top in * |- *; try clear top.
-
-Goal forall x y, x + y = 4.
-intros.
-at [RHS] (fun top => remember top as E eqn:E_def).
-match goal with
-| |- x + y = E => idtac
-| |- _ => fail
-end.
-Admitted.
diff --git a/mathcomp/ssrtest/tc.v b/mathcomp/ssrtest/tc.v
index 871d6ad..7a95b66 100644
--- a/mathcomp/ssrtest/tc.v
+++ b/mathcomp/ssrtest/tc.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/testmx.v b/mathcomp/ssrtest/testmx.v
index 0fc8d5e..95c62bd 100644
--- a/mathcomp/ssrtest/testmx.v
+++ b/mathcomp/ssrtest/testmx.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/typeof.v b/mathcomp/ssrtest/typeof.v
index f336a46..f2cb1d4 100644
--- a/mathcomp/ssrtest/typeof.v
+++ b/mathcomp/ssrtest/typeof.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 
diff --git a/mathcomp/ssrtest/unkeyed.v b/mathcomp/ssrtest/unkeyed.v
index 39e0c23..5ab6eba 100644
--- a/mathcomp/ssrtest/unkeyed.v
+++ b/mathcomp/ssrtest/unkeyed.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/view_case.v b/mathcomp/ssrtest/view_case.v
index 974b916..e9104a9 100644
--- a/mathcomp/ssrtest/view_case.v
+++ b/mathcomp/ssrtest/view_case.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/wlog_suff.v b/mathcomp/ssrtest/wlog_suff.v
index adb1874..bc931e1 100644
--- a/mathcomp/ssrtest/wlog_suff.v
+++ b/mathcomp/ssrtest/wlog_suff.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/wlogletin.v b/mathcomp/ssrtest/wlogletin.v
index 841edaf..1553621 100644
--- a/mathcomp/ssrtest/wlogletin.v
+++ b/mathcomp/ssrtest/wlogletin.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp
diff --git a/mathcomp/ssrtest/wlong_intro.v b/mathcomp/ssrtest/wlong_intro.v
index 61e069e..836dd4b 100644
--- a/mathcomp/ssrtest/wlong_intro.v
+++ b/mathcomp/ssrtest/wlong_intro.v
@@ -1,4 +1,4 @@
-(* (c) Copyright 2006-2015 Microsoft Corporation and Inria.                  *)
+(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
 (* Distributed under the terms of CeCILL-B.                                  *)
 Require Import mathcomp.ssreflect.ssreflect.
 From mathcomp