(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)
Require Export Pmults.
Section Pminus.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hMults".
Inductive minusP :
list (Term A n) -> list (Term A n) -> list (Term A n) -> Prop :=
| mnillu1 :
forall l1 : list (Term A n),
minusP (pO A n) l1
(mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) l1)
| mnillu2 : forall l1 : list (Term A n), minusP l1 (pO A n) l1
| mmainu1 :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
ltT ltM a2 a1 ->
minusP l1 (pX a2 l2) l3 -> minusP (pX a1 l1) (pX a2 l2) (pX a1 l3)
| mmainu2a :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
minusP l1 l2 l3 ->
eqT a1 a2 ->
zeroP (A:=A) A0 eqA (n:=n) (minusTerm (A:=A) minusA (n:=n) a1 a2) ->
minusP (pX a1 l1) (pX a2 l2) l3
| mmainu2b :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
minusP l1 l2 l3 ->
eqT a1 a2 ->
~ zeroP (A:=A) A0 eqA (n:=n) (minusTerm (A:=A) minusA (n:=n) a1 a2) ->
minusP (pX a1 l1) (pX a2 l2)
(pX (minusTerm (A:=A) minusA (n:=n) a1 a2) l3)
| mmainu3 :
forall (a1 a2 : Term A n) (l1 l2 l3 : list (Term A n)),
ltT ltM a1 a2 ->
minusP (pX a1 l1) l2 l3 ->
minusP (pX a1 l1) (pX a2 l2) (pX (invTerm (A:=A) invA (n:=n) a2) l3).
Hint Resolve mnillu1 mnillu2 mmainu1 mmainu2a mmainu2b mmainu3.
Definition minuspp :
forall l : list (Term A n) * list (Term A n),
{a : list (Term A n) | minusP (fst l) (snd l) a}.
intros l; pattern l in |- *.
apply
well_founded_induction
with (A := (list (Term A n) * list (Term A n))%type) (R := lessP A n);
auto.
apply wf_lessP; auto.
intros x; case x; intros l1 l2; simpl in |- *.
case l1.
intros H';
exists (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n)) l2);
auto.
intros a1 m1; case l2.
intros H'; exists (pX a1 m1); auto.
intros a2 m2 H'; case (ltT_dec A n ltM ltM_dec a1 a2);
[ intros P; case P; clear P | idtac ]; intros H1.
lapply (H' (pX a1 m1, m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
exists (pX (invTerm (A:=A) invA (n:=n) a2) Orec); auto.
change
(minusP (pX a1 m1) (pX a2 m2) (pX (invTerm (A:=A) invA (n:=n) a2) Orec))
in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
lapply (H' (m1, pX a2 m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
exists (pX a1 Orec); auto.
change (minusP (pX a1 m1) (pX a2 m2) (pX a1 Orec)) in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
lapply (H' (m1, m2)); simpl in |- *;
[ intros Rec; case Rec; clear Rec; intros Orec Prec | idtac ].
apply LetP with (A := Term A n) (h := minusTerm (A:=A) minusA (n:=n) a1 a2).
intros u H'0; case (zeroP_dec A A0 eqA eqA_dec n u); intros Z0.
exists Orec; auto.
rewrite H'0 in Z0; auto.
change (minusP (pX a1 m1) (pX a2 m2) Orec) in |- *; auto.
exists (pX u Orec); auto.
rewrite H'0 in Z0; auto.
rewrite H'0; auto.
change
(minusP (pX a1 m1) (pX a2 m2)
(pX (minusTerm (A:=A) minusA (n:=n) a1 a2) Orec))
in |- *; auto.
red in |- *; red in |- *; simpl in |- *; rewrite <- plus_n_Sm; auto.
Defined.
Definition minuspf (l1 l2 : list (Term A n)) :=
projsig1 (list (Term A n)) _ (minuspp (l1, l2)).

(* Specifications: *)
Theorem zerop_is_eqTerm :
forall a b : Term A n,
eqT a b ->
zeroP (A:=A) A0 eqA (n:=n) (minusTerm (A:=A) minusA (n:=n) a b) ->
eqTerm (A:=A) eqA (n:=n) a b.