(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)

(****************************************************************************

          Buchberger : reduction plus

          Laurent Thery May 97 (revised April 01)

  ****************************************************************************)
Require Export Preduce.
Section Preduceplus.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hReduce".

Inductive reduceplus (Q : list (poly A0 eqA ltM)) :
list (Term A n) -> list (Term A n) -> Prop :=
  | Rstar_0 :
      forall x y : list (Term A n), eqP A eqA n x y -> reduceplus Q x y
  | Rstar_n :
      forall x y z : list (Term A n),
      reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q x y ->
      reduceplus Q y z -> reduceplus Q x z.
Hint Resolve Rstar_0.

Theorem reduceplus_eqp_com :
 forall (Q : list (poly A0 eqA ltM)) (p q r s : list (Term A n)),
 reduceplus Q p q ->
 canonical A0 eqA ltM p ->
 eqP A eqA n p r -> eqP A eqA n q s -> reduceplus Q r s.
intros Q p q r s H'; generalize r s; clear r s; elim H'; auto.
intros x y H'0 r s H'1 H'2 H'3.
apply Rstar_0; auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := y); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := x); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
intros x y z H'0 H'1 H'2 r s H'3 H'4 H'5.
apply Rstar_n with (y := y); auto.
apply reduce_eqp_com with (1 := cs) (p := x) (q := y); auto.
apply H'2; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
Qed.

Theorem reduceplus_trans :
 forall (Q : list (poly A0 eqA ltM)) (x y z : list (Term A n)),
 reduceplus Q x y ->
 canonical A0 eqA ltM x -> reduceplus Q y z -> reduceplus Q x z.
intros Q x y z H'; elim H'; auto.
intros x0 y0 H'0 H'1 H'2.
apply reduceplus_eqp_com with (p := y0) (q := z); auto.
apply eqp_imp_canonical with (1 := cs) (p := x0); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
intros x0 y0 z0 H'0 H'1 H'2 H'3 H'4.
apply Rstar_n with (y := y0); auto.
apply H'2; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
Qed.

Theorem canonical_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q p q -> canonical A0 eqA ltM p -> canonical A0 eqA ltM q.
intros Q p q H'; elim H'; auto.
intros x y H H0.
apply eqp_imp_canonical with (1 := cs) (p := x); auto.
intros x y z H'0 H'1 H'2 H'3.
apply H'2; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
Qed.

Theorem order_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q p q ->
 canonical A0 eqA ltM p -> ltP (A:=A) (n:=n) ltM q p \/ eqP A eqA n p q.
intros Q p q H'; elim H'; auto.
intros x y z H'0 H'1 H'2 H'3; left; try assumption.
elim H'2;
 [ intros H'5; try exact H'5; clear H'2 | intros H'5; clear H'2 | clear H'2 ].
apply ltP_trans with (y := y); auto.
apply ltP_reduce with (1 := cs) (3 := H'0); auto.
apply (ltp_eqp_comp A A0 eqA) with (p := y) (q := x); auto.
apply ltP_reduce with (1 := cs) (3 := H'0); auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
Qed.

Theorem reduceplus_skip :
 forall (Q : list (poly A0 eqA ltM)) (a b : Term A n) (p q : list (Term A n)),
 reduceplus Q p q ->
 canonical A0 eqA ltM (pX a p) ->
 eqTerm (A:=A) eqA (n:=n) a b -> reduceplus Q (pX a p) (pX b q).
intros Q a b p q H'; generalize a b; clear a b; elim H'; auto.
intros x y z H'0 H'1 H'2 a b H'3 H'4.
apply Rstar_n with (y := pX b y); auto.
apply H'2; auto.
apply ltP_pX_canonical; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
apply canonical_imp_canonical with (a := a); auto.
apply canonical_nzeroP with (ltM := ltM) (p := x); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX a x); auto.
apply ltP_trans with (y := x); auto.
apply ltP_reduce with (1 := cs) (3 := H'0); auto.
apply canonical_imp_canonical with (a := a); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX a x); auto.
Qed.
Hint Resolve reduceplus_skip.

Theorem reduce_imp_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q p q ->
 reduceplus Q p q.
intros Q p q H'.
apply Rstar_n with (y := q); auto.
Qed.
Hint Resolve reduce_imp_reduceplus.

Lemma pO_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q (pO A n) p -> p = pO A n.
intros Q p q H'; inversion H'; auto.
inversion H; auto.
case (pO_reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q y);
 auto.
Qed.

Theorem rep_plus_reduce :
 forall (Q : list (poly A0 eqA ltM)) (p q s : list (Term A n)),
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
   (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p q)
   s ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 exists p1 : list (Term A n),
   (exists q1 : list (Term A n),
      reduceplus Q p p1 /\
      reduceplus Q q q1 /\
      eqP A eqA n s
        (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
           p1 q1)).
intros Q p q; pattern p, q in |- *.
apply (Opm_ind A n ltM ltM_dec); intros; auto.
exists (pO A n); exists s; split; [ idtac | split ]; auto.
apply reduce_imp_reduceplus.
apply
 reduce_eqp_com
  with
    (1 := cs)
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pO A n) p0)
    (q := s); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
exists s; exists (pO A n); split; [ idtac | split ]; auto.
apply reduce_imp_reduceplus.
apply
 reduce_eqp_com
  with
    (1 := cs)
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p0 (pO A n))
    (q := s); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
cut (canonical A0 eqA ltM p0);
 [ intros C0 | apply canonical_imp_canonical with (a := a); auto ].
cut (canonical A0 eqA ltM q0);
 [ intros C1 | apply canonical_imp_canonical with (a := b); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros nZ1 | apply canonical_nzeroP with (ltM := ltM) (p := p0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros nZ2 | apply canonical_nzeroP with (ltM := ltM) (p := q0); auto ].
inversion H1.
cut (canonical A0 eqA ltM (pX b0 q1));
 [ intros C2 | apply inPolySet_imp_canonical with (L := Q); auto ].
cut (canonical A0 eqA ltM q1);
 [ intros C3 | apply canonical_imp_canonical with (a := b0); auto ].
exists (pX a p0);
 exists
  (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec b b0 nZb
     q0 q1); split; [ idtac | split ]; auto.
apply reduce_imp_reduceplus.
apply reducetop with (b := b0) (nZb := nZb) (q := q1); auto.
cut (eqTerm (A:=A) eqA (n:=n) a0 b); [ intros eqb | idtac ].
apply divP_eqT with (1 := cs) (a := a0); auto.
rewrite <-
 pluspf_inv2_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite
 (pX_invl _ _ a0 b p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0)); auto.
rewrite <-
 pluspf_inv2_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite
 (pX_invl _ _ a0 b p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0)); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
            a0 b0 nZb p1 q1); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite <-
 pluspf_inv2_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite
 (pX_invl _ _ a0 b p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0)); auto.
rewrite
 (pX_invr _ _ p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0) a0 b); auto.
apply spminusf_plusTerm_r; auto.
rewrite <-
 (pX_invl _ _ a0 b p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0)); auto.
elim (H q1);
 [ intros p2 E; elim E; intros q2 E0; elim E0; intros H'4 H'5; elim H'5;
    intros H'6 H'7; clear H'5 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
exists p2; exists (pX b q2); split; [ idtac | split ]; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pX a0
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec p2 q2)); auto.
apply eqpP1; auto; (apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto).
rewrite <-
 pluspf_inv2_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite
 (pX_invl _ _ a0 b p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0)); auto.
rewrite pluspf_inv2_eqa; auto.
apply ltP_pX_canonical; auto.
apply canonical_reduceplus with (Q := Q) (p := pX a p0); auto.
elim (order_reduceplus Q (pX a p0) p2);
 [ intros H'5 | intros H'5 | idtac | idtac ]; auto.
apply ltP_trans with (y := pX a p0); auto.
apply (ltp_eqp_comp A A0 eqA) with (p := pX a p0) (q := pX b (pO A n)); auto.
apply ltP_pX_canonical; auto.
apply canonical_reduceplus with (Q := Q) (p := q0); auto.
elim (order_reduceplus Q q0 q2); [ intros H'5 | intros H'5 | idtac | idtac ];
 auto.
apply ltP_trans with (y := q0); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply (ltp_eqp_comp A A0 eqA) with (p := q0) (q := pX b (pO A n)); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply reduce_eqp_com with (1 := cs) (p := p1) (q := q1); auto.
apply canonical_imp_canonical with (a := a0); auto.
rewrite H4; auto.
rewrite <-
 pluspf_inv2_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite
 (pX_invr _ _ p1
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
       (pX a p0) q0) a0 b); auto.
rewrite <- pluspf_inv1_eq with (a := a) (b := b) (p := p0) (q := q0) in H1;
 auto.
cut (canonical A0 eqA ltM p0);
 [ intros C0 | apply canonical_imp_canonical with (a := a); auto ].
cut (canonical A0 eqA ltM q0);
 [ intros C1 | apply canonical_imp_canonical with (a := b); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros nZ1 | apply canonical_nzeroP with (ltM := ltM) (p := p0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros nZ2 | apply canonical_nzeroP with (ltM := ltM) (p := q0); auto ].
inversion_clear H1.
cut (canonical A0 eqA ltM (pX b0 q1));
 [ intros C2 | apply inPolySet_imp_canonical with (L := Q); auto ].
cut (canonical A0 eqA ltM q1);
 [ intros C3 | apply canonical_imp_canonical with (a := b0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b0);
 [ intros nZ3 | apply canonical_nzeroP with (ltM := ltM) (p := q1); auto ].
exists
 (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b0 nZb
    p0 q1); exists (pX b q0); split; [ idtac | split ];
 auto.
apply reduce_imp_reduceplus; auto.
apply reducetop with (b := b0) (nZb := nZb) (q := q1); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
            b0 nZb
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec p0 (pX b q0)) q1).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply spminusf_pluspf; auto.
elim (H q1);
 [ intros p2 E; elim E; intros q2 E0; elim E0; intros H'4 H'5; elim H'5;
    intros H'6 H'7; clear H'5 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
exists (pX a p2); exists q2; split; [ idtac | split ]; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pX a
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec p2 q2)); auto.
apply eqpP1; auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite pluspf_inv1_eqa; auto.
apply ltP_pX_canonical; auto.
apply canonical_reduceplus with (Q := Q) (p := p0); auto.
elim (order_reduceplus Q p0 p2);
 [ intros H'14 | intros H'14 | idtac | idtac ]; auto.
apply ltP_trans with (y := p0); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply (ltp_eqp_comp A A0 eqA) with (p := p0) (q := pX a (pO A n)); auto.
apply (canonical_pX_ltP A A0 eqA); auto.
apply ltP_pX_canonical; auto.
apply canonical_reduceplus with (Q := Q) (p := pX b q0); auto.
elim (order_reduceplus Q (pX b q0) q2);
 [ intros H'14 | intros H'14 | idtac | idtac ]; auto.
apply ltP_trans with (y := pX b q0); auto.
apply (ltp_eqp_comp A A0 eqA) with (p := pX b q0) (q := pX a (pO A n)); auto.
cut (canonical A0 eqA ltM p0);
 [ intros C0 | apply canonical_imp_canonical with (a := a); auto ].
cut (canonical A0 eqA ltM q0);
 [ intros C1 | apply canonical_imp_canonical with (a := b); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros nZ1 | apply canonical_nzeroP with (ltM := ltM) (p := p0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros nZ2 | apply canonical_nzeroP with (ltM := ltM) (p := q0); auto ].
case (zeroP_dec A A0 eqA eqA_dec n (plusTerm (A:=A) plusA (n:=n) a b));
 intros Z0.
elim (H s);
 [ intros p1 E; elim E; intros q1 E0; elim E0; intros H'3 H'5; elim H'5;
    intros H'6 H'7; clear H'5 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
exists (pX a p1); exists (pX b q1); split; [ idtac | split ]; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1 q1); auto.
apply pluspf_inv3a with (1 := cs); auto.
rewrite pluspf_inv3a_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0);
 auto.
inversion H1.
cut (canonical A0 eqA ltM (pX b0 q1));
 [ intros C2 | apply inPolySet_imp_canonical with (L := Q); auto ].
cut (canonical A0 eqA ltM q1);
 [ intros C3 | apply canonical_imp_canonical with (a := b0); auto ].
cut (divP A A0 eqA multA divA n a b0); [ intros div0 | idtac ].
cut (divP A A0 eqA multA divA n b b0); [ intros div1 | idtac ].
exists
 (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b0 nZb
    p0 q1);
 exists
  (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec b b0 nZb
     q0 q1); split; [ idtac | split ]; auto.
apply reduce_imp_reduceplus; auto.
apply reducetop with (b := b0) (nZb := nZb) (q := q1); auto.
apply reduce_imp_reduceplus; auto.
apply reducetop with (b := b0) (nZb := nZb) (q := q1); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
            a0 b0 nZb p1 q1).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite <-
 pluspf_inv3b_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite pX_invr with (1 := H4); auto.
rewrite pX_invl with (1 := H4); auto.
apply spminusf_plusTerm; auto.
apply divP_eqT with (1 := cs) (a := plusTerm (A:=A) plusA (n:=n) a b); auto.
apply plusTerm_eqT2; auto.
rewrite <-
 pluspf_inv3b_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite <- pX_invl with (1 := H4); auto.
apply divP_eqT with (1 := cs) (a := plusTerm (A:=A) plusA (n:=n) a b); auto.
apply plusTerm_eqT1; auto.
rewrite <-
 pluspf_inv3b_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
rewrite <- pX_invl with (1 := H4); auto.
rewrite <-
 pluspf_inv3b_eq with (1 := os) (a := a) (b := b) (p := p0) (q := q0) in H4;
 auto.
elim (H q1);
 [ intros p2 E; elim E; intros q2 E0; elim E0; intros H'3 H'5; elim H'5;
    intros H'6 H'7; clear H'5 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
exists (pX a p2); exists (pX b q2); split; [ idtac | split ]; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pX a0
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec p2 q2)); auto.
apply eqpP1; auto; apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite pX_invl with (1 := H4); auto.
apply pluspf_inv3b with (1 := cs); auto.
rewrite <- pX_invr with (1 := H4); auto.
Qed.

Theorem reduceplus_mults :
 forall (Q : list (poly A0 eqA ltM)) (a : Term A n) (p q : list (Term A n)),
 reduceplus Q p q ->
 canonical A0 eqA ltM p ->
 ~ zeroP (A:=A) A0 eqA (n:=n) a ->
 reduceplus Q (mults (A:=A) multA (n:=n) a p) (mults (A:=A) multA (n:=n) a q).
intros Q a p q H'; elim H'; auto.
intros x y z H'0 H'1 H'2 H'3 H'4.
apply Rstar_n with (y := mults (A:=A) multA (n:=n) a y); auto.
apply reduce_mults with (1 := cs); auto.
apply H'2; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
Qed.

Lemma reduceplus_mults_invr_lem :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q p q ->
 forall r : list (Term A n),
 eqP A eqA n p
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r) ->
 canonical A0 eqA ltM r ->
 reduceplus Q r
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q).
intros Q p q H'; elim H'; auto.
intros x y H'0 r H'1 H'2.
apply Rstar_0; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) x);
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               r)); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n)
            (multTerm (A:=A) multA (n:=n)
               (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (invTerm (A:=A) invA (n:=n) (T1 A1 n))) r);
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply
  (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
   with (y := mults (A:=A) multA (n:=n) (T1 A1 n) r);
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
intros x y z H'0 H'1 H'2 r H'3 H'4.
apply
 Rstar_n
  with
    (y := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) y);
 auto.
apply reduce_mults_invr with (1 := cs); auto.
apply reduce_eqp_com with (1 := cs) (p := x) (q := y); auto.
apply
 eqp_imp_canonical
  with
    (p := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r)
    (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply reduceplus_mults; auto.
apply canonical_reduce with (1 := cs) (3 := H'0); auto.
apply
 eqp_imp_canonical
  with
    (p := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r)
    (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem reduceplus_mults_invr :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) p) q ->
 canonical A0 eqA ltM p ->
 reduceplus Q p
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q).
intros Q p q H' H'0.
apply
 reduceplus_mults_invr_lem
  with
    (p := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) p);
 auto.
Qed.

Theorem reduceplus_mults_invf0 :
 forall a : Term A n,
 ~ zeroP (A:=A) A0 eqA (n:=n) a ->
 eqT a (T1 A1 n) ->
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q p q ->
 canonical A0 eqA ltM p ->
 forall r s : list (Term A n),
 canonical A0 eqA ltM r ->
 eqP A eqA n p (mults (A:=A) multA (n:=n) a r) ->
 eqP A eqA n q (mults (A:=A) multA (n:=n) a s) -> reduceplus Q r s.
intros a H' H'0 Q p q H'1; elim H'1; auto.
intros x y H'2 H'3 r s H'4 H'5 H'6.
apply Rstar_0; auto.
apply mults_eqp_inv with (a := a) (1 := cs); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := y); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := x); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
intros x y z H'2 H'3 H'4 H'5 r s H'6 H'7 H'8.
apply
 Rstar_n
  with
    (y := mults (A:=A) multA (n:=n)
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
               (T1 A1 n) (b:=a) H') y); auto.
apply reduce_mults_invf with (1 := cs); auto.
apply reduce_eqp_com with (1 := cs) (p := x) (q := y); auto.
apply H'4; auto.
apply canonical_reduce with (1 := cs) (3 := H'2); auto.
apply canonical_mults with (1 := cs); auto.
apply canonical_reduce with (1 := cs) (3 := H'2); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n)
            (multTerm (A:=A) multA (n:=n) a
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                  (T1 A1 n) (b:=a) H')) y); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n)
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
               (multTerm (A:=A) multA (n:=n) a (T1 A1 n)) (b:=a) H') y);
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n)
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a) H') y);
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply mults_comp with (1 := cs); auto.
apply divTerm_multTerm_l with (1 := cs); auto.
apply divTerm_on_eqT with (1 := cs); auto.
apply (eqT_sym A n); auto.
Qed.

Theorem reduceplus_mults_inv :
 forall a : Term A n,
 ~ zeroP (A:=A) A0 eqA (n:=n) a ->
 eqT a (T1 A1 n) ->
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 reduceplus Q (mults (A:=A) multA (n:=n) a p) (mults (A:=A) multA (n:=n) a q) ->
 canonical A0 eqA ltM p -> reduceplus Q p q.
intros a H' H'0 Q p q H'1 H'2.
apply
 reduceplus_mults_invf0
  with
    (a := a)
    (p := mults (A:=A) multA (n:=n) a p)
    (q := mults (A:=A) multA (n:=n) a q); auto.
Qed.

Theorem rep_minus_reduce :
 forall (Q : list (poly A0 eqA ltM)) (p q s : list (Term A n)),
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p q) s ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 exists p1 : list (Term A n),
   (exists q1 : list (Term A n),
      reduceplus Q p p1 /\
      reduceplus Q q q1 /\
      eqP A eqA n s
        (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p1 q1)).
intros Q p q s H' H'0 H'1.
elim
 (rep_plus_reduce Q p
    (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q) s);
 [ intros p1 E; elim E; intros q1 E0; elim E0; intros H'9 H'10; elim H'10;
    intros H'11 H'12; clear H'10 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
exists p1;
 exists (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q1);
 split; [ idtac | split ]; auto.
apply reduceplus_mults_invr; auto.
cut (canonical A0 eqA ltM p1); [ intros Cp1 | idtac ].
cut (canonical A0 eqA ltM q1); [ intros Cq1 | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1 q1); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q1)));
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1
            (mults (A:=A) multA (n:=n)
               (multTerm (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))) q1));
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply
  (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
   with
     (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
             ltM_dec p1 (mults (A:=A) multA (n:=n) (T1 A1 n) q1));
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 canonical_reduceplus
  with
    (Q := Q)
    (p := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q);
 auto.
apply canonical_reduceplus with (Q := Q) (p := p); auto.
apply
 reduce_eqp_com
  with
    (1 := cs)
    (p := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p q)
    (q := s); auto.
Qed.

Theorem rep_plus_zero_reduce :
 forall (Q : list (poly A0 eqA ltM)) (s t : list (Term A n)),
 reduceplus Q s t ->
 canonical A0 eqA ltM s ->
 forall p q : list (Term A n),
 eqP A eqA n s
   (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p q) ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 eqP A eqA n t (pO A n) ->
 exists r1 : list (Term A n),
   reduceplus Q p r1 /\
   reduceplus Q q
     (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r1).
intros Q s t H'; elim H'.
intros x y eqxy Op p q H'0 H'1 H'2 H'3; exists p; split; auto.
apply Rstar_0; auto.
cut (canonical A0 eqA ltM y); [ intros Cx | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pO A n)
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               p)); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            y
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               p)); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            x
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               p)); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply
  (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
   with
     (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
             ltM_dec
             (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
                ltM_dec p q)
             (mults (A:=A) multA (n:=n)
                (invTerm (A:=A) invA (n:=n) (T1 A1 n)) p));
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec q p)
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               p)); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            q
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec p
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n)) p)));
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply
  (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
   with
     (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
             ltM_dec q
             (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p p));
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply
  (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
   with
     (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
             ltM_dec q (pO A n)); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply minuspf_refl with (1 := cs); auto.
apply eqp_imp_canonical with (1 := cs) (p := x); auto.
intros x y z H'0 H'1 H'2 H'3 p q H'4 H'5 H'6 H'7.
elim (rep_plus_reduce Q p q y);
 [ intros p1 E; elim E; intros q1 E0; elim E0; intros H'15 H'16; elim H'16;
    intros H'17 H'18; try exact H'17; clear H'16 E0 E
 | idtac
 | idtac
 | idtac ]; auto.
lapply H'2;
 [ intros H'8; elim (H'8 p1 q1);
    [ intros r1 E; elim E; intros H'16 H'19; clear E H'2
    | clear H'2
    | clear H'2
    | clear H'2
    | clear H'2 ]
 | clear H'2 ]; auto.
exists r1; split; auto.
apply reduceplus_trans with (y := p1); auto.
apply reduceplus_trans with (y := q1); auto.
apply canonical_reduceplus with (Q := Q) (p := p); auto.
apply canonical_reduceplus with (Q := Q) (p := q); auto.
apply
 eqp_imp_canonical
  with
    (1 := cs)
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1 q1); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply canonical_pluspf; auto.
apply canonical_reduceplus with (Q := Q) (p := p); auto.
apply canonical_reduceplus with (Q := Q) (p := q); auto.
apply reduce_eqp_com with (p := x) (q := y) (1 := cs); auto.
Qed.

Theorem red_plus_zero_reduce :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 reduceplus Q
   (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p q)
   (pO A n) ->
 exists r1 : list (Term A n),
   reduceplus Q p r1 /\
   reduceplus Q q
     (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r1).
intros Q p q H' H'0 H'1.
apply
 rep_plus_zero_reduce
  with
    (s := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p q)
    (t := pO A n); auto.
Qed.

Theorem red_minus_zero_reduce :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 reduceplus Q
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p q)
   (pO A n) ->
 exists r1 : list (Term A n), reduceplus Q p r1 /\ reduceplus Q q r1.
intros Q p q H' H'0 H'1.
elim
 (red_plus_zero_reduce Q p
    (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) q));
 [ intros r1 E; elim E; intros H'8 H'9; clear E | idtac | idtac | idtac ];
 auto.
exists r1; split; auto.
apply
 reduceplus_eqp_com
  with
    (p := q)
    (q := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               r1)); auto.
apply reduceplus_mults_invr; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n)
            (multTerm (A:=A) multA (n:=n)
               (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (invTerm (A:=A) invA (n:=n) (T1 A1 n))) r1);
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 reduceplus_eqp_com
  with
    (p := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p q)
    (q := pO A n); auto.
Qed.

Theorem reduce_plus_top :
 forall (Q : list (poly A0 eqA ltM)) (r : list (Term A n)),
 canonical A0 eqA ltM r ->
 forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b)
   (p q : list (Term A n)),
 inPolySet A A0 eqA n ltM (pX b q) Q ->
 canonical A0 eqA ltM (pX a p) ->
 divP A A0 eqA multA divA n a b ->
 ex
   (fun s : list (Term A n) =>
    reduceplus Q
      (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
         (pX a p) r) s /\
    reduceplus Q
      (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
         (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
            b nZb p q) r) s).
intros Q r; elim r; auto.
intros H' a b nZb p q H'0 H'1 H'2;
 exists
  (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b nZb
     p q); split; auto.
apply
 reduceplus_eqp_com
  with
    (p := pX a p)
    (q := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
            b nZb p q); auto.
apply reduce_imp_reduceplus; auto.
apply reducetop with (b := b) (nZb := nZb) (q := q); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
change
  (eqP A eqA n
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pO A n)) (pX a p)) in |- *; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
           b nZb p q) (pO A n))
     (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b
        nZb p q)) in |- *; auto.
clear r; intros c r H' H'0 a b nZb p q H'1 H'2 H'3.
cut (canonical A0 eqA ltM p);
 [ intros C0 | apply canonical_imp_canonical with (a := a); auto ].
cut (canonical A0 eqA ltM (pX b q));
 [ intros C1 | apply inPolySet_imp_canonical with (L := Q); auto ].
cut (canonical A0 eqA ltM q);
 [ intros C2 | apply canonical_imp_canonical with (a := b); auto ].
cut (canonical A0 eqA ltM r);
 [ intros C3 | apply canonical_imp_canonical with (a := c); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros nZ1 | apply canonical_nzeroP with (ltM := ltM) (p := p); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) c);
 [ intros nZ3 | apply canonical_nzeroP with (ltM := ltM) (p := r); auto ].
case (ltT_dec A n ltM ltM_dec a c);
 [ intros temp; case temp; clear temp | idtac ]; intros test.
lapply H';
 [ intros H'4; elim (H'4 a b nZb p q);
    [ intros s E; elim E; intros H'13 H'14; clear E H'
    | clear H'
    | clear H'
    | clear H' ]
 | clear H' ]; auto.
exists (pX c s); split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r)) (pX c s)) in |- *.
rewrite <- pluspf_inv2_eq with (1 := os) (a := a) (b := c) (p := p) (q := r);
 auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv2_eq with (1 := os) (a := a) (b := c) (p := p) (q := r);
 auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
           b nZb p q) (pX c r)) (pX c s)) in |- *.
cut
 (canonical A0 eqA ltM
    (pX a
       (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b
          nZb p q))); auto.
generalize H'14;
 case
  (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b nZb
     p q); simpl in |- *; auto.
intros H' H'5.
apply
 reduceplus_eqp_com
  with
    (p := pX c
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (pO A n) r))
    (q := pX c s); auto.
apply reduceplus_skip; auto.
apply eqp_imp_canonical with (1 := cs) (p := pX c r); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX c r); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := pX c r); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
change
  (eqP A eqA n
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pO A n) (pX c r)) (pX c r)) in |- *; auto.
intros t l H' H'5.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX t l) (pX c r)) (pX c s)) in |- *.
rewrite <- pluspf_inv2_eq with (1 := os) (a := t) (b := c) (p := l) (q := r);
 auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv2_eq with (1 := os) (a := t) (b := c) (p := l) (q := r);
 auto.
apply canonical_pluspf; auto.
apply canonical_imp_canonical with (a := a); auto.
apply (ltT_trans A _ _ os) with (y := a); auto.
apply (canonical_pX_order A A0 eqA) with (l := l); auto.
apply (ltT_trans A _ _ os) with (y := a); auto.
apply (canonical_pX_order A A0 eqA) with (l := l); auto.
apply canonical_spminusf_full_t with (1 := cs); auto.
exists
 (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
    (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b
       nZb p q) (pX c r)); split; auto.
apply reduce_imp_reduceplus.
change
  (reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r))
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
           b nZb p q) (pX c r))) in |- *.
rewrite <- pluspf_inv1_eq with (1 := os) (a := a) (b := c) (p := p) (q := r);
 auto.
apply reducetop with (b := b) (nZb := nZb) (q := q); auto.
apply spminusf_pluspf with (1 := cs); auto.
cut (divP A A0 eqA multA divA n c b);
 [ intros divc | apply divP_eqT with (1 := cs) (a := a) ];
 auto.
cut
 (canonical A0 eqA ltM
    (pX c
       (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a b
          nZb p q))); [ intros Ca | apply canonical_pX_eqT with (a := a) ];
 auto.
case (zeroP_dec A A0 eqA eqA_dec n (plusTerm (A:=A) plusA (n:=n) a c));
 intros Z0.
exists
 (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p r);
 split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r))
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p r))
 in |- *.
rewrite <- pluspf_inv3a_eq with (1 := os) (a := a) (b := c) (p := p) (q := r);
 auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
           b nZb p q) (pX c r))
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p r))
 in |- *.
rewrite <- pluspf_inv2_eqa; auto.
apply reduce_imp_reduceplus.
apply reducetop with (b := b) (nZb := nZb) (q := q); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
               ltM_dec a b nZb p q)
            (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
               ltM_dec c b nZb r q)); auto.
apply spminusf_plusTerm_r with (1 := cs); auto.
apply canonical_spminusf with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply spminusf_plusTerm_z; auto.
exists
 (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
    (plusTerm (A:=A) plusA (n:=n) a c) b nZb
    (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p r)
    q); split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r))
     (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
        (plusTerm (A:=A) plusA (n:=n) a c) b nZb
        (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
           p r) q)) in |- *.
rewrite <- pluspf_inv3b_eq with (1 := os) (a := a) (b := c) (p := p) (q := r);
 auto.
apply reduce_imp_reduceplus.
apply reducetop with (b := b) (nZb := nZb) (q := q); auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
           b nZb p q) (pX c r))
     (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
        (plusTerm (A:=A) plusA (n:=n) a c) b nZb
        (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
           p r) q)) in |- *.
rewrite <-
 pluspf_inv2_eqa
                 with
                 (1 := os)
                (a := c)
                (p :=
                  spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
                    ltM_dec a b nZb p q)
                (q := r); auto.
apply reduce_imp_reduceplus.
apply reducetop with (b := b) (nZb := nZb) (q := q); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
               ltM_dec a b nZb p q)
            (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
               ltM_dec c b nZb r q)); auto.
apply spminusf_plusTerm_r with (1 := cs); auto.
apply canonical_spminusf with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply spminusf_plusTerm with (1 := cs); auto.
apply canonical_spminusf_full_t with (1 := cs); auto.
Qed.

Theorem one_plus_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p1 p2 : list (Term A n)),
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q p1 p2 ->
 forall r : list (Term A n),
 canonical A0 eqA ltM p1 ->
 canonical A0 eqA ltM r ->
 exists s : list (Term A n),
   reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p1
        r) s /\
   reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec p2
        r) s.
intros Q p1 p2 H'; elim H'; auto.
intros a b nZb p q r H'0 H'1 H'2 r0 H'3 H'4.
lapply (reduce_plus_top Q r0);
 [ intros H'7; elim (H'7 a b nZb p q);
    [ intros s E; elim E; intros H'16 H'17; clear E | idtac | idtac | idtac ]
 | idtac ]; auto.
exists s; split; auto.
cut (canonical A0 eqA ltM (pX b q));
 [ intros C0 | apply inPolySet_imp_canonical with (L := Q); auto ].
apply
 reduceplus_eqp_com
  with
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM
               ltM_dec a b nZb p q) r0)
    (q := s); auto.
apply canonical_pluspf with (1 := os); auto.
apply canonical_spminusf_full with (1 := cs); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply canonical_spminusf_full with (1 := cs); auto.
apply
 eqp_imp_canonical
  with
    (1 := cs)
    (p := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec a
            b nZb p q); auto.
apply canonical_spminusf_full with (1 := cs); auto.
intros a b p q H'0 H'1 H'2 r H'3.
cut (canonical A0 eqA ltM p);
 [ intros C0 | apply canonical_imp_canonical with (a := a); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p); auto ].
cut (canonical A0 eqA ltM (pX a q)); [ intros C1 | idtac ].
cut (canonical A0 eqA ltM q);
 [ intros C2 | apply canonical_imp_canonical with (a := a); auto ].
elim r; auto.
intros H'4; exists (pX a q); split; auto.
apply reduceplus_eqp_com with (p := pX a p) (q := pX a q); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
change
  (eqP A eqA n
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pO A n)) (pX a p)) in |- *; auto.
apply reduceplus_eqp_com with (p := pX a q) (q := pX a q); auto.
apply (eqp_trans _ _ _ _ _ _ _ _ _ cs n) with (y := pX b q); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
change
  (eqP A eqA n
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX b q) (pO A n)) (pX b q)) in |- *; auto.
clear r; intros c r H'4 H'5.
cut (canonical A0 eqA ltM r);
 [ intros C3 | apply canonical_imp_canonical with (a := c); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) c);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := r); auto ].
case (ltT_dec A n ltM ltM_dec a c);
 [ intros temp; case temp; clear temp | idtac ]; intros test.
elim H'4;
 [ intros s E; elim E; intros H'7 H'8; try exact H'7; clear E H'4
 | clear H'4 ]; auto.
exists (pX c s); split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r)) (pX c s)) in |- *.
rewrite <- pluspf_inv2_eqa with (1 := os); auto.
cut (canonical A0 eqA ltM (pX b q));
 [ intros C4 | apply canonical_pX_eqT with (a := a); auto ].
apply reduceplus_skip; auto.
rewrite pluspf_inv2_eqa with (1 := os); auto.
apply (eqTerm_imp_eqT A eqA); auto.
apply nzeroP_comp_eqTerm with (1 := cs) (a := a); auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX b q) (pX c r)) (pX c s)) in |- *.
rewrite <- pluspf_inv2_eqa with (1 := os); auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv2_eqa with (1 := os); auto.
apply canonical_pluspf with (1 := os); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX a q); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX c (pX a q)); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX c (pX a q)); auto.
elim (H'1 (pX c r));
 [ intros s E; elim E; intros H'9 H'10; clear E | idtac | idtac ];
 auto.
cut (canonical A0 eqA ltM (pX b q));
 [ intros C4 | apply canonical_pX_eqT with (a := a); auto ].
exists (pX a s); split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r)) (pX a s)) in |- *.
rewrite <- pluspf_inv1_eq; auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv1_eq; auto.
apply
 reduceplus_eqp_com
  with
    (p := pX a
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec q (pX c r)))
    (q := pX a s); auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv1_eq; auto.
rewrite pluspf_inv1_eq; auto.
rewrite pluspf_inv1_eq; auto.
apply (eqTerm_imp_eqT A eqA); auto.
apply nzeroP_comp_eqTerm with (1 := cs) (a := a); auto.
case (zeroP_dec A A0 eqA eqA_dec n (plusTerm (A:=A) plusA (n:=n) a c));
 intros Z2.
elim (H'1 r);
 [ intros s E; elim E; intros H'9 H'10; clear E | idtac | idtac ];
 auto.
exists s; split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r)) s) in |- *.
rewrite <- pluspf_inv3a_eq; auto.
apply
 reduceplus_eqp_com
  with
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pX a q) (pX c r))
    (q := s); auto.
rewrite <- pluspf_inv3a_eq; auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX a q); auto.
elim (H'1 r);
 [ intros s E; elim E; intros H'9 H'10; clear E | idtac | idtac ];
 auto.
exists (pX (plusTerm (A:=A) plusA (n:=n) a c) s); split; auto.
change
  (reduceplus Q
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a p) (pX c r)) (pX (plusTerm (A:=A) plusA (n:=n) a c) s))
 in |- *.
rewrite <- pluspf_inv3b_eq; auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv3b_eq; auto.
apply
 reduceplus_eqp_com
  with
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pX a q) (pX c r))
    (q := pX (plusTerm (A:=A) plusA (n:=n) a c) s);
 auto.
rewrite <- pluspf_inv3b_eq; auto.
apply reduceplus_skip; auto.
rewrite pluspf_inv3b_eq; auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply eqp_imp_canonical with (1 := cs) (p := pX a q); auto.
apply
 canonical_reduce
  with
    (eqA_dec := eqA_dec)
    (ltM_dec := ltM_dec)
    (Q := Q)
    (p := pX a p)
    (1 := cs); auto.
Qed.

Theorem one_minus_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (p1 p2 : list (Term A n)),
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q p1 p2 ->
 forall r : list (Term A n),
 canonical A0 eqA ltM p1 ->
 canonical A0 eqA ltM r ->
 exists s : list (Term A n),
   reduceplus Q
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p1 r) s /\
   reduceplus Q
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p2 r) s.
intros Q p1 p2 H' r H'0 H'1.
lapply (one_plus_reduceplus Q p1 p2);
 [ intros H'5;
    elim
     (H'5
        (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) r));
    [ intros s E; elim E; intros H'9 H'10; clear E | idtac | idtac ]
 | idtac ]; auto.
exists s; split; auto.
apply
 reduceplus_eqp_com
  with
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p1
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               r))
    (q := s); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
cut (canonical A0 eqA ltM p2); [ intros C0 | idtac ].
apply
 reduceplus_eqp_com
  with
    (p := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p2
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               r))
    (q := s); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply canonical_reduce with (1 := cs) (3 := H'); auto.
Qed.
End Preduceplus.


(* *********************************************************************)
(*                                                                     *)
(*     Basic lemmas & tactics (based on Viktor Vafeiadis' Vbase.v)     *)
(*                                                                     *)
(* *********************************************************************)

(** This file collects a number of basic lemmas and tactics for better
    proof automation, structuring large proofs, or rewriting.  Most of
    the rewriting support is ported from ssreflect. *)

(** Symbols starting with [vlib__] are internal. *)

From mathcomp Require Import ssreflect ssrbool ssrnat eqtype bigop.

Open Scope bool_scope.
Open Scope list_scope.

Set Implicit Arguments.
Unset Strict Implicit.

(* ************************************************************************** *)
(** * Very basic automation *)
(* ************************************************************************** *)

(** Set up for basic simplification *)

Create HintDb vlib discriminated.

(** Adaptation of the ss-reflect "[done]" tactic. *)

Ltac vlib__basic_done :=
  solve [trivial with vlib | apply sym_equal; trivial | discriminate | contradiction].

Ltac done := trivial with vlib; hnf; intros;
  solve [try vlib__basic_done; split;
         try vlib__basic_done; split;
         try vlib__basic_done; split;
         try vlib__basic_done; split;
         try vlib__basic_done; split; vlib__basic_done
    | match goal with H : ~ _ |- _ => solve [case H; trivial] end].

(** A variant of the ssr "done" tactic that performs "eassumption". *)

Ltac edone := try eassumption; trivial; hnf; intros;
  solve [try eassumption; try vlib__basic_done; split;
         try eassumption; try vlib__basic_done; split;
         try eassumption; try vlib__basic_done; split;
         try eassumption; try vlib__basic_done; split;
         try eassumption; try vlib__basic_done; split;
         try eassumption; vlib__basic_done
    | match goal with H : ~ _ |- _ => solve [case H; trivial] end].

Tactic Notation "by"  tactic(tac) := (tac; done).
Tactic Notation "eby" tactic(tac) := (tac; edone).

(* ************************************************************************** *)
(** * Equality types *)
(* ************************************************************************** *)

Lemma vlib__internal_eqP :
  forall (T: eqType) (x y : T), reflect (x = y) (x == y).
Proof. by intros; apply/eqP. Qed.

Lemma neqP : forall (T: eqType) (x y: T), reflect (x <> y) (x != y).
Proof. intros; case eqP; constructor; auto. Qed.

Lemma beq_refl : forall (T : eqType) (x : T), x == x.
Proof. by intros; case eqP. Qed.

Lemma beq_sym : forall (T : eqType) (x y : T), (x == y) = (y == x).
Proof. intros; do 2 case eqP; congruence. Qed.

Hint Resolve beq_refl : vlib.
Hint Rewrite beq_refl : vlib_trivial.

Notation eqxx := beq_refl.

(* ************************************************************************** *)
(** * Basic simplification tactics *)
(* ************************************************************************** *)

Lemma vlib__negb_rewrite : forall b, negb b -> b = false.
Proof. by intros []. Qed.

Lemma vlib__andb_split : forall b1 b2, b1 && b2 -> b1 /\ b2.
Proof. by intros [] []. Qed.

Lemma vlib__nandb_split : forall b1 b2, b1 && b2 = false -> b1 = false \/ b2 = false.
Proof. intros [] []; auto. Qed.

Lemma vlib__orb_split : forall b1 b2, b1 || b2 -> b1 \/ b2.
Proof. intros [] []; auto. Qed.

Lemma vlib__norb_split : forall b1 b2, b1 || b2 = false -> b1 = false /\ b2 = false.
Proof. intros [] []; auto. Qed.

Lemma vlib__eqb_split : forall b1 b2 : bool, (b1 -> b2) -> (b2 -> b1) -> b1 = b2.
Proof. intros [] [] H H'; unfold is_true in *; auto using sym_eq. Qed.

Lemma vlib__beq_rewrite : forall (T : eqType) (x1 x2 : T), x1 == x2 -> x1 = x2.
Proof. by intros until 0; case eqP. Qed.

Lemma vlib__leq_split : forall x1 x2 x3, x1 <= x2 -> x2 <= x3 -> x1 <= x2 <= x3.
Proof. by intros; apply/andP; split. Qed.

Lemma vlib__ltn_split1 : forall x1 x2 x3, x1 <= x2 -> x2 < x3 -> x1 <= x2 < x3.
Proof. by intros; apply/andP; split. Qed.

Lemma vlib__ltn_split2 : forall x1 x2 x3, x1 < x2 -> x2 <= x3 -> x1 < x2 <= x3.
Proof. by intros; apply/andP; split. Qed.

(** Set up for basic simplification: database of reflection lemmas *)

Create HintDb vlib_refl discriminated.

Hint Resolve andP orP nandP norP negP vlib__internal_eqP neqP : vlib_refl.

(* Add x <= y <= z splitting to the core hint database. *)
Hint Immediate vlib__leq_split vlib__ltn_split1 vlib__ltn_split2.

Ltac vlib__complaining_inj f H :=
  let X := fresh in
  (match goal with | [|- ?P ] => set (X := P) end);
  injection H;
  (*  (lazymatch goal with | [ |- f _ = f _ -> _] => fail | _ => idtac end);
      (* Previous statement no longer necessary in 8.4 *) *)
  clear H; intros; subst X;
  try subst.

Ltac vlib__clarify1 :=
  try subst;
  repeat match goal with
  | [H: is_true (andb _ _) |- _] =>
      let H' := fresh H in case (vlib__andb_split H); clear H; intros H' H
  | [H: is_true (negb ?x) |- _] => rewrite (vlib__negb_rewrite H) in *
  | [H: is_true ?x        |- _] => rewrite H in *
  | [H: ?x = true         |- _] => rewrite H in *
  | [H: ?x = false        |- _] => rewrite H in *
  | [H: is_true (_ == _)  |- _] => generalize (vlib__beq_rewrite H); clear H; intro H
  | [H: ?f _             = ?f _             |- _] => vlib__complaining_inj f H
  | [H: ?f _ _           = ?f _ _           |- _] => vlib__complaining_inj f H
  | [H: ?f _ _ _         = ?f _ _ _         |- _] => vlib__complaining_inj f H
  | [H: ?f _ _ _ _       = ?f _ _ _ _       |- _] => vlib__complaining_inj f H
  | [H: ?f _ _ _ _ _     = ?f _ _ _ _ _     |- _] => vlib__complaining_inj f H
  | [H: ?f _ _ _ _ _ _   = ?f _ _ _ _ _ _   |- _] => vlib__complaining_inj f H
  | [H: ?f _ _ _ _ _ _ _ = ?f _ _ _ _ _ _ _ |- _] => vlib__complaining_inj f H
  end; try done.

(** Perform injections & discriminations on all hypotheses *)

Ltac clarify :=
  vlib__clarify1;
  repeat match goal with
    | H1: ?x = Some _, H2: ?x = None   |- _ => rewrite H2 in H1; discriminate
    | H1: ?x = Some _, H2: ?x = Some _ |- _ => rewrite H2 in H1; vlib__clarify1
  end; (* autorewrite with vlib_trivial; *) try done.

Ltac inv x := inversion x; clarify.
Ltac simpls  := simpl in *; try done.
Ltac ins := simpl in *; try done; intros.

Tactic Notation "case_eq" constr(x) := case_eq (x).

Tactic Notation "case_eq" constr(x) "as" simple_intropattern(H) :=
  destruct x as [] eqn:H; try done.

Ltac vlib__clarsimp1 :=
  clarify; (autorewrite with vlib_trivial vlib in * );
  (autorewrite with vlib_trivial in * ); try done;
  clarify; auto 1 with vlib.

Ltac clarsimp := intros; simpl in *; vlib__clarsimp1.

Ltac autos   := clarsimp; auto with vlib.

(* ************************************************************************** *)
(** Destruct but give useful names *)
(* ************************************************************************** *)

(** Destruct, but no case split *)
Ltac desc :=
  repeat match goal with
    | H: is_true (_ == _) |- _ => generalize (vlib__beq_rewrite H); clear H; intro H
    | H : exists x, ?p |- _ =>
      let x' := fresh x in destruct H as [x' H]
    | H : ?p /\ ?q |- _ =>
      let x' := H in
      let y' := fresh H in
        destruct H as [x' y']
    | H : is_true (_ && _) |- _ =>
          let H' := fresh H in case (vlib__andb_split H); clear H; intros H H'
    | H : (_ || _) = false |- _ =>
          let H' := fresh H in case (vlib__norb_split H); clear H; intros H H'
    | H : ?x = ?x   |- _ => clear H
  end.

Ltac des :=
  repeat match goal with
    | H: is_true (_ == _) |- _ => generalize (vlib__beq_rewrite H); clear H; intro H
    | H : exists x, ?p |- _ =>
      let x' := fresh x in destruct H as [x' H]
    | H : exists2 x, ?p & ?q |- _ =>
      let x' := fresh x in destruct H as [x' H1 H2]
    | H : ?p /\ ?q |- _ =>
      let x' := H in
      let y' := fresh H in
        destruct H as [x' y']
    | H : is_true (_ && _) |- _ =>
        let H' := fresh H in case (vlib__andb_split H); clear H; intros H H'
    | H : (_ || _) = false |- _ =>
        let H' := fresh H in case (vlib__norb_split H); clear H; intros H H'
    | H : ?x = ?x |- _ => clear H
    | H : ?p <-> ?q |- _ =>
      let x' := H in
      let y' := fresh H in
        destruct H as [x' y']
    | H : ?p \/ ?q |- _ =>
      let x' := H in
      let y' := H in
      destruct H as [x' | y']
    | H : is_true (_ || _) |- _ => case (vlib__orb_split H); clear H; intro H
    | H : (_ && _) = false |- _ => case (vlib__nandb_split H); clear H; intro H
  end.

Ltac des_if_asm :=
  clarify;
  repeat
    match goal with
      | H: context[ match ?x with _ => _ end ] |- _ =>
        match (type of x) with
          | { _ } + { _ } => destruct x; clarify
          | bool =>
            let Heq := fresh "Heq" in
            let P := fresh in
            evar(P: Prop);
            assert (Heq: reflect P x) by (subst P; trivial with vlib_refl);
            subst P; destruct Heq as [Heq|Heq]
          | _ => let Heq := fresh "Heq" in destruct x as [] eqn:Heq; clarify
        end
    end.

Ltac des_if_goal :=
  clarify;
  repeat
    match goal with
      | |- context[match ?x with _ => _ end] =>
        match (type of x) with
          | { _ } + { _ } => destruct x; clarify
          | bool =>
            let Heq := fresh "Heq" in
            let P := fresh in
            evar(P: Prop);
            assert (Heq: reflect P x) by (subst P; trivial with vlib_refl);
            subst P; destruct Heq as [Heq|Heq]
          | _ => let Heq := fresh "Heq" in destruct x as [] eqn:Heq; clarify
        end
    end.

Ltac des_if :=
  clarify;
  repeat
    match goal with
      | |- context[match ?x with _ => _ end] =>
        match (type of x) with
          | { _ } + { _ } => destruct x; clarify
          | bool =>
            let Heq := fresh "Heq" in
            let P := fresh in
            evar(P: Prop);
            assert (Heq: reflect P x) by (subst P; trivial with vlib_refl);
            subst P; destruct Heq as [Heq|Heq]
          | _ => let Heq := fresh "Heq" in destruct x as [] eqn:Heq; clarify
        end
      | H: context[ match ?x with _ => _ end ] |- _ =>
        match (type of x) with
          | { _ } + { _ } => destruct x; clarify
          | bool =>
            let Heq := fresh "Heq" in
            let P := fresh in
            evar(P: Prop);
            assert (Heq: reflect P x) by (subst P; trivial with vlib_refl);
            subst P; destruct Heq as [Heq|Heq]
          | _ => let Heq := fresh "Heq" in destruct x as [] eqn:Heq; clarify
        end
    end.

Ltac des_eqrefl :=
  match goal with
    | H: context[match ?X with |true => _ | false => _ end Logic.eq_refl] |- _ =>
    let EQ := fresh "EQ" in
    let id' := fresh "x" in
    revert H;
    generalize (Logic.eq_refl X);
    try (generalize X at 1 3); try (generalize X at 2 3);
    intros id' EQ; destruct id'; intros H
    | |- context[match ?X with |true => _ | false => _ end Logic.eq_refl] =>
    let EQ := fresh "EQ" in
    let id' := fresh "x" in
    generalize (Logic.eq_refl X);
    try (generalize X at 1 3); try (generalize X at 2 3);
    intros id' EQ; destruct id'
  end.

Ltac desf_asm := clarify; des; des_if_asm.

Ltac desf := clarify; des; des_if.

Ltac clarassoc := clarsimp; autorewrite with vlib_trivial vlib vlibA in *; try done.

Ltac vlib__hacksimp1 :=
   clarsimp;
   match goal with
     | H: _ |- _ => solve [rewrite H; clear H; clarsimp
                         |rewrite <- H; clear H; clarsimp]
     | _ => solve [f_equal; clarsimp]
   end.

Ltac hacksimp :=
   clarsimp;
   try match goal with
   | H: _ |- _ => solve [rewrite H; clear H; clarsimp
                              |rewrite <- H; clear H; clarsimp]
   | |- context[match ?p with _ => _ end] => solve [destruct p; vlib__hacksimp1]
   | _ => solve [f_equal; clarsimp]
   end.

(* ************************************************************************** *)
(** ** Delineating cases in proofs *)
(* ************************************************************************** *)

(** Named case tactics (taken from Libtactics) *)

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move x at top
  | assert_eq x name
  | fail 1 "because we are working on a different case." ].

Ltac Case name := Case_aux case name.
Ltac SCase name := Case_aux subcase name.
Ltac SSCase name := Case_aux subsubcase name.
Ltac SSSCase name := Case_aux subsubsubcase name.
Ltac SSSSCase name := Case_aux subsubsubsubcase name.

(** Lightweight case tactics (without names) *)

Tactic Notation "--" tactic(c) :=
  first [
    assert (WithinCaseM := True); move WithinCaseM at top
  | fail 1 "because we are working on a different case." ]; c.

Tactic Notation "++" tactic(c) :=
  first [
    assert (WithinCaseP := True); move WithinCaseP at top
  | fail 1 "because we are working on a different case." ]; c.

(* ************************************************************************** *)
(** ** Exploiting a hypothesis *)
(* ************************************************************************** *)

(** Exploit an assumption (adapted from CompCert). *)

Ltac exploit x :=
    refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _ _) _)
 || refine ((fun x y => y x) (x _ _ _) _)
 || refine ((fun x y => y x) (x _ _) _)
 || refine ((fun x y => y x) (x _) _).

(* Feed tactic -- exploit with multiple arguments.
   (taken from http://comments.gmane.org/gmane.science.mathematics.logic.coq.club/7013) *)
Ltac feed H :=
  match type of H with
  | ?foo -> _ =>
    let FOO := fresh in
    assert foo as FOO; [|specialize (H FOO); clear FOO]
  end.

Ltac feed_n n H := match constr:n with
  | O => idtac
  | (S ?m) => feed H ; [| feed_n m H]
                   end.

(* ************************************************************************** *)
(** * New tactics for ssreflect *)
(* ************************************************************************** *)

Ltac simpl_sum_const :=
  rewrite ?big_const_nat ?big_const_ord ?big_const_seq iter_addn ?muln1 ?mul1n ?mul0n
          ?muln0 ?addn0 ?add0n.


(* Theorems about low level protocol *)

Require Import Program Arith CpdtTactics.

Require Import Refinement Temporal Low_def High_proof Quorum.

Theorem Low_Level_Agreement : forall params, isValidP params -> Always (compose agree ref_map) (initGS params).
Proof.
  unfold Always.
  intros.
  unfold compose.
  eapply (HAgreement (ref_mapp params)).
  eapply Refinement'.
  unfold isValid.
  auto.
Qed.

(* Pretty Proof *)

(* Agreement: For any process i and j, if they both decide, they decide the same value *)
Theorem Readable_Low_Level_Agreement : forall params gs i j b b0, isValid params gs ->
  extract_decision i gs = Some b -> extract_decision j gs = Some b0
  -> b = b0.
Proof.
  intros.
  (* If a process i decides, it must have decided at some step, same for j *)
  destruct (Lem_VD_cD params gs i b  H H0) as [si].
  destruct (Lem_VD_cD params gs j b0 H H1) as [sj].
  (* The steps happened in some round, say ri and rj *)
  remember (round_no (step si)) as ri.
  remember (round_no (step sj)) as rj.
  (* If i decides, there's a quorum in the votes i received *)
  decompose record H2.
  pose proof (Lem_cD_Q si i b H5 H8).
  destruct H7 as [hi].
  destruct H7.
  destruct H9 as [qi].
  (* ...same for j *)
  decompose record H3.
  pose proof (Lem_cD_Q sj j b0 H11 H14).
  destruct H13 as [hj].
  destruct H13.
  destruct H15 as [qj].
  (* Case on different relationships of ri and rj *)
  remember (lt_eq_lt_dec ri rj) as cmp.
  decompose sum cmp.
  - (* ...in different rounds, ri < rj *)
    rename a0 into n.
    (* If i decides b, then all processes will have estimate b in the future rounds *)
    pose proof (Lem_cD_R si i b H5 H8).
    pose proof (Lem_cD_R sj j b0 H11 H14).
    rewrite Heqri in n.
    rewrite Heqrj in n.
    rewrite <- H16 in n.
    rewrite <- H17 in n.
    assert (si <<= sj).
    eapply (Lem_Rlt_S (initGS params) si sj).
    inversion H4.
    auto.
    inversion H10.
    auto.
    auto.
    pose proof (Lem_VcD_E params si i b H4 H5 H8 sj H18 n).
    (* So everyone holds b as the estimate in round rj,
       and that will make any decision in that round b *)
    pose proof (Lem_VcDE_DEeq params sj j b0 b H10 H11 H14 H19).
    auto.
  - (* ...in the same round *)
    rename b1 into e.
    (* Processes i, j are using the same quorum system, say quorum sq *)
    pose proof (Lem_V_Qeq params (step si) (Lem_VS'_V params si H4)).
    rewrite <- H16 in H9.
    pose proof (Lem_V_Qeq params (step sj) (Lem_VS'_V params sj H10)).
    rewrite <- H17 in H15.
    pose proof (Lem_S_neq (step si) gs H6).
    rewrite H18 in H9.
    pose proof (Lem_S_neq (step sj) gs H12).
    rewrite H19 in H15.
    remember (coq_sq (coq_cq params)) as sq.
    (* So there's an intersection of the 2 quorums, say node k *)
    pose proof (Lem_V_Qeq params gs H).
    pose proof (Lem_V_Q params gs H).
    rewrite <- H20 in H21.
    destruct H21.
    destruct H22.
    destruct H9.
    destruct H15.
    specialize (H22 qi qj H9 H15).
    destruct H22 as [k].
    simpl in H22.
    (* i and j's decisions are the same as the message sent by k *)
    decompose record H22.
    rewrite <- Heqsq in H28.
    pose proof (Lem_tsok_M (n gs) b hi (sq qi) k H24 H26 H28).
    destruct H27 as [mki].
    rewrite <- Heqsq in H29.
    pose proof (Lem_tsok_M (n gs) b0 hj (sq qj) k H25 H26 H29).
    destruct H30 as [mkj].
    (* an honest k will send the same votes to different nodes *)
    destruct H27.
    pose proof (Lem_VS_Heq params (step si) gs i hi k mki (Lem_VS'_V params si H4) H6 H7 H27).
    rewrite <- Heqri in H32.
    destruct H30.
    pose proof (Lem_VS_Heq params (step sj) gs j hj k mkj (Lem_VS'_V params sj H10) H12 H13 H30).
    rewrite <- Heqrj in H34.
    rewrite <- e in H34.
    pose proof (Lem_VH_Heq params gs ri k i j mki mkj H H32 H34).
    (* so their decisions are equal *)
    congruence.
  - (* The symmetric case *)
    rename b1 into n.
    pose proof (Lem_cD_R si i b H5 H8).
    pose proof (Lem_cD_R sj j b0 H11 H14).
    rewrite Heqri in n.
    rewrite Heqrj in n.
    rewrite <- H16 in n.
    rewrite <- H17 in n.
    assert (sj <<= si).
    eapply (Lem_Rlt_S (initGS params) sj si).
    inversion H10.
    auto.
    inversion H4.
    auto.
    auto.
    pose proof (Lem_VcD_E params sj j b0 H10 H11 H14 si H18 n).
    pose proof (Lem_VcDE_DEeq params si i b b0 H4 H5 H8 H19).
    auto.
Qed.