(* 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.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal4.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.
Derive Show for lst.

              Derive Arbitrary for lst.

              Instance Dec_Eq_lst : Dec_Eq lst.

              Proof. dec_eq. Qed.

Lemma conj12eqsynthconj2 : forall  (lv0 : lst), (@eq lst (append lv0 lv0) (append (append Nil lv0) lv0)).
Admitted.
QuickChick conj12eqsynthconj2.


Require Import isla.isla.
Require Import isla.riscv64.riscv64.
Require Export isla.instructions.binary_search_riscv64.a94.

Lemma a94_spec `{!islaG Σ} `{!threadG} pc:
  instr pc (Some a94) -∗
  instr_body pc (ld_spec pc "x1" "x2" (56)).
Proof.
  iStartProof.
  repeat liAStep; liShow.
  Unshelve. all: prepare_sidecond.
  all: bv_solve.
Qed.

Definition a94_spec_inst `{!islaG Σ} `{!threadG} pc :=
  entails_to_simplify_hyp 0 (a94_spec pc).
Global Existing Instance a94_spec_inst.


(* 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.


Require Import ssreflect ssrbool eqtype ssrnat.
Axiom daemon : False. Ltac myadmit := case: daemon.

Lemma test x : (x == x) = (x + x.+1 == 2 * x + 1).
case: (X in _ = X) / eqP => _.
match goal with |- (x == x) = true => myadmit end.
match goal with |- (x == x) = false => myadmit end.
Qed.

Lemma test1 x : (x == x) = (x + x.+1 == 2 * x + 1).
elim: (x in RHS).
match goal with |- (x == x) = _ => myadmit end.
match goal with |- forall n, (x == x) = _ -> (x == x) = _ => myadmit end.
Qed.


From SyDPaCC.Tree Require Import
     Skeletons Closure BTree.
From SyDPaCC.Bsml Require Import Model.Core Model.Pid Skeletons.StdLib.
From SyDPaCC.Core Require Import Bmf Parallelization.
Require Import Lia NArith.

Open Scope N_scope.

Module Make (Import Bsml : SyDPaCC.Bsml.Model.Core.BSML).

  Module Pid := Pid.Make Bsml.Bsp.
  Module StdLib := StdLib.Make Bsml Pid.
  Module Import Skel := Tree.Skeletons.Make Bsml.

  (* Set functions for the application of map *)
  Definition kL_one {A} (x:A) := 1.
  Definition kN_one {B} (x:B) := 1 .

  Open Scope sydpacc_scope.

  Definition spec_mapone {A B} : BTree.t A B -> BTree.t N N :=
    BTree.map kL_one kN_one.

  Typeclasses eauto := (bfs).

  Definition mapone {A B} : PLTree A B -> PLTree N N:=
    Eval sydpacc in
    parallel(spec_mapone).

  Close Scope sydpacc_scope.

End Make.

Close Scope N_scope.