Require Import Metalib.Metatheory.
Require Import Metalib.LibTactics.
Require Import Coq.Program.Equality.
Require Import Coq.Program.Tactics.
Require Import Strings.String.
Require Import Psatz.

Require Import Language.
Require Import Tactical.
Require Import Subtyping.Subtyping.
Require Import Subtyping.Splitable.
Require Import Subtyping.Toplike.

Require Import Value.
Require Import Disjoint.
Require Import PrincipalTyping.
Require Import Consistent.
Require Import Typing.

(** * Definition *)

Inductive casting : term -> type -> term -> Prop :=
| Ct_Lit : forall n A,
    sub A Int ->
    casting (Ann (Lit n) A) Int (Ann (Lit n) Int)
| Ct_Top : forall A v,
    lc v ->
    toplike A ->
    ordinary A ->
    casting v A (Ann (Lit 1) A)
| Ct_Lam : forall A B C D E e,
    lc (Lam A e B) ->
    not (toplike D) ->
    sub E (Arr C D) ->
    ordinary D ->
    casting (Ann (Lam A e B) E)
            (Arr C D)
            (Ann (Lam A e D) (Arr C D))
| Ct_Mrg_L : forall v1 v2 v A,
    casting v1 A v ->
    ordinary A ->
    casting (Mrg v1 v2) A v
| Ct_Mrg_R : forall v1 v2 v A,
    casting v2 A v ->
    ordinary A ->
    casting (Mrg v1 v2) A v
| Ct_And : forall v1 v2 v A A1 A2,
    splitable A A1 A2 ->
    casting v A1 v1 ->
    casting v A2 v2 ->
    casting v A (Mrg v1 v2).

Hint Constructors casting : core.

Notation "e ⇝ [ A ] e'" := (casting e A e') (at level 68).

(** * Determinism *)

(** Under toplike and ordinary type A, value v is always casted to a constant *)

Lemma casting_ordinary_toplike :
  forall v v' A,
    ordinary A ->
    toplike A ->
    casting v A v' ->
    v' = (Ann (Lit 1) A).
Proof.
  introv Ord Tl Ct.
  induction Ct; eauto.
Qed.

(** Value v can only be casted by its super type *)

Lemma casting_super :
  forall A B v v',
    value v ->
    typing nil v B ->
    casting v A v' ->
    sub B A.
Proof.
  introv Val Typ Ct. gen B.
  induction Ct; eauto; intros.
  - Case "Lit".
    repeat (dependent destruction Typ).
    assumption.
  - Case "Lam".
    dependent destruction Typ.
    assumption.
  - Case "Merge L".
    dependent destruction Val.
    dependent destruction Typ;
      eapply sub_and_l; eauto.
  - Case "Merge R".
    dependent destruction Val.
    dependent destruction Typ;
      eapply sub_and_r; eauto.
Qed.

(** We first prove the general version of determinism (generlized on consistent) *)

Lemma casting_determinism_gen :
  forall v1 v2 v1' v2' A B C,
    value v1 -> value v2 ->
    typing nil v1 A -> typing nil v2 B ->
    consistent v1 v2 ->
    casting v1 C v1' ->
    casting v2 C v2' ->
    v1' = v2'.
Proof.
  introv Val1 Val2 Typ1 Typ2 Con Ct1 Ct2.
  gen A B v1 v2 v1' v2'.
  ind_type_size (size_type C).
  destruct (splitable_or_ordinary C).
  - Case "Ord".
    gen A B. induction Con; eauto; intros.
    + SCase "Arr".
      dependent destruction Val1. dependent destruction Val2.
      dependent destruction Ct1; dependent destruction Ct2; eauto.
    + SCase "Anno".
      dependent destruction Val1. dependent destruction Val2.
      destruct H; dependent destruction Ct1; dependent destruction Ct2; eauto.
    + SCase "Disjoint".
      pose proof (typing_to_ptype _ _ (value_is_uvalue _ Val1) Typ1).
      pose proof (typing_to_ptype _ _ (value_is_uvalue _ Val2) Typ2).
      repeat (subst_ptype).
      pose proof (disjoint_complete _ _ H2).
      pose proof (casting_super _ _ _ _ Val1 Typ1 Ct1).
      pose proof (casting_super _ _ _ _ Val2 Typ2 Ct2).
      assert (Tl: toplike C) by eauto.
      pose proof (casting_ordinary_toplike _ _ _ H Tl Ct1).
      pose proof (casting_ordinary_toplike _ _ _ H Tl Ct2).
      now subst.
    + SCase "Merge L".
      dependent destruction Ct1; eauto.
      * symmetry. eapply casting_ordinary_toplike; eauto.
      * dependent destruction Typ1; eauto.
      * dependent destruction Typ1; eauto.
    + SCase "Merge R".
      dependent destruction Ct2; eauto.
      * eapply casting_ordinary_toplike; eauto.
      * dependent destruction Typ2; eauto.
      * dependent destruction Typ2; eauto.
  - Case "Spl".
    destruct H as [C1 H]. destruct H as [C2 H].
    dependent destruction Ct1; dependent destruction Ct2; eauto.
    repeat (subst_splitable).
    pose proof (splitable_decrease_size _ _ _ H1) as SplSize. destruct SplSize.
    assert (size_type C1 < i) by lia. assert (size_type C2 < i) by lia.
    f_equal; eauto 3.
Qed.

(** Then prove its determinism by directly applying [casting_determinism_gen] *)

Lemma casting_determinism :
  forall v v1 v2 A B,
    value v ->
    typing nil v A ->
    casting v B v1 ->
    casting v B v2 ->
    v1 = v2.
Proof.
  introv Val Typ Ct1 Ct2.
  eapply casting_determinism_gen; eauto.
Qed.

(** * Casting & Value *)

(** Value property is preserved by casting *)

Lemma casting_lc :
  forall v v' A,
    lc v ->
    casting v A v' ->
    lc v'.
Proof.
  introv Lc Ct.
  dependent induction Ct; eauto.
  - econstructor; eauto.
  - econstructor; eauto.
Qed.

Lemma casting_value :
  forall v v' A,
    value v ->
    casting v A v' ->
    value v'.
Proof.
  introv Val Ct.
  induction Ct; eauto.
Qed.

Hint Resolve casting_value : core.

(** * Transitivity *)

Lemma casting_transitivity :
  forall v v1 v2 A B,
    value v ->
    casting v A v1 ->
    casting v1 B v2 ->
    casting v B v2.
Proof.
  introv Val Ct1 Ct2. gen B v2.
  induction Ct1; intros; try solve [dependent induction Ct2; eauto].
  - dependent induction Ct2; eauto.
    eapply Ct_Lam; eauto. eapply sub_transitivity; eauto.
  - dependent destruction Val.
    dependent induction Ct2; eauto.
  - dependent destruction Val.
    dependent induction Ct2; eauto.
Qed.

(** * Progress *)

Lemma casting_progress :
  forall v A B,
    value v ->
    typing nil v A ->
    sub A B ->
    exists v', casting v B v'.
Proof.
  introv Val Typ Sub. gen v.
  induction Sub; intros.
  - Case "Sub-Int".
    dependent destruction Typ; eauto.
    dependent destruction Val. dependent destruction H.
    dependent destruction Typ; eauto.
    dependent destruction Typ; eauto.
  - Case "Sub-Top".
    dependent destruction Typ; eauto.
  - Case "Sub-Arr".
    dependent destruction Typ; eauto.
    destruct (toplike_decidable D).
    + SCase "Toplike".
      eexists; eauto.
    + SCase "Not Toplike".
      dependent destruction Val. dependent destruction H0; eauto.
      dependent destruction Typ. dependent destruction H1.
      assert (toplike B) by (eapply sub_inv_int_arrow; eauto).
      assert (toplike D) by (eapply sub_toplike; eauto).
      contradiction.
  - Case "Sub-And".
    pose proof (IHSub1 _ Val Typ). pose proof (IHSub2 _ Val Typ).
    destruct_conjs; eauto.
  - Case "Sub-And-L".
    dependent destruction Typ; eauto.
    + dependent destruction Val.
      pose proof (IHSub _ Val1 Typ1). destruct_conjs; eauto.
    + dependent destruction Val.
      pose proof (IHSub _ Val1 Typ1). destruct_conjs; eauto.
  - Case "Sub-And-R".
    dependent destruction Typ; eauto.
    + dependent destruction Val.
      pose proof (IHSub _ Val2 Typ2). destruct_conjs; eauto.
    + dependent destruction Val.
      pose proof (IHSub _ Val2 Typ2). destruct_conjs; eauto.
Qed.

(** * Casting & Consistent *)

(** ** Specification *)

Definition consistent_spec v1 v2 :=
  forall A v1' v2',
    ordinary A ->
    casting v1 A v1' ->
    casting v2 A v2' ->
    v1' = v2'.

(** ** Soundness *)

Lemma consistent_sound :
  forall v1 v2 A B,
    value v1 -> value v2 ->
    typing nil v1 A ->
    typing nil v2 B ->
    consistent v1 v2 ->
    consistent_spec v1 v2.
Proof.
  introv Val1 Val2 Typ1 Typ2 Con.
  unfold consistent_spec. intros C v1' v2' Ord Ct1 Ct2.
  now pose proof (casting_determinism_gen _ _ _ _ _ _ _ Val1 Val2 Typ1 Typ2 Con Ct1 Ct2).
Qed.

(** ** Completeness *)

(** We need two "inversion lemmas" on specification *)

Lemma consistent_spec_inv_merge_l :
  forall v v1 v2,
    consistent_spec (Mrg v1 v2) v ->
    consistent_spec v1 v /\ consistent_spec v2 v.
Proof.
  introv Cons. split; unfold consistent_spec in *; intros; eauto.
Qed.

Lemma consistent_spec_inv_merge_r :
  forall v v1 v2,
    consistent_spec v (Mrg v1 v2) ->
    consistent_spec v v1 /\ consistent_spec v v2.
Proof.
  introv Cons. split; unfold consistent_spec in *; intros; eauto.
Qed.

Ltac ind_term_size s :=
  assert (SizeInd: exists i, s < i) by eauto;
  destruct SizeInd as [i SizeInd];
  repeat match goal with | [ h : term |- _ ] => (gen h) end;
  induction i as [|i IH]; [
      intros; match goal with | [ H : _ < 0 |- _ ] => (dependent destruction H; eauto) end
    | intros ].

Lemma consistent_complete :
  forall v1 v2 A B,
    value v1 -> value v2 ->
    typing nil v1 A ->
    typing nil v2 B ->
    consistent_spec v1 v2 ->
    consistent v1 v2.
Proof.
  introv Val1 Val2 Typ1 Typ2 Cons. gen A B.
  ind_term_size (size_term v1 + size_term v2).
  dependent destruction Val1; dependent destruction Val2; simpl in SizeInd.
  - Case "Anno~Anno".
    dependent destruction Typ1. dependent destruction Typ2.
    destruct (toplike_decidable A); destruct (toplike_decidable A0).
    + eapply Con_Dj; eauto; eapply disjoint_toplike; eauto.
    + eapply Con_Dj; eauto; eapply disjoint_toplike; eauto.
    + eapply consistent_symmetry; eauto. eapply Con_Dj; eauto; eapply disjoint_toplike; eauto.
    + destruct H; destruct H1.
      * SCase "Lit Lit".
        dependent destruction Typ1. dependent destruction Typ2.
        (* derive equality from Cons *)
        unfold consistent_spec in Cons.
        repeat match goal with
               | [H: sub Int ?A |- _] => (dependent destruction H; eauto)
               end.
        assert (Ct1: casting (Ann (Lit n) Int) Int (Ann (Lit n) Int)) by eauto.
        assert (Ct2: casting (Ann (Lit n0) Int) Int (Ann (Lit n0) Int)) by eauto.
        pose proof (Cons _ _ _ H0 Ct1 Ct2) as Eq.
        dependent destruction Eq. eauto.
      * SCase "Lit Lam".
        dependent destruction Typ1. dependent destruction Typ2.
        repeat match goal with
               | [H: sub Int ?A |- _] => (dependent destruction H; eauto)
               | [H: sub (Arr _ _) _ |- _] => (dependent destruction H; eauto)
               end.
      * SCase "Lam Lit".
        dependent destruction Typ1. dependent destruction Typ2.
        repeat match goal with
               | [H: sub Int ?A |- _] => (dependent destruction H; eauto)
               | [H: sub (Arr _ _) _ |- _] => (dependent destruction H; eauto)
               end.
      * SCase "Lam Lam".
        inversion Typ1; subst. inversion Typ2; subst.
        repeat match goal with
               | [H: sub (Arr _ _) _ |- _] => (dependent destruction H; eauto)
               end.
        destruct (disjoint_spec_decidable D0 D); eauto.
        unfold consistent_spec in Cons.
        destruct_conjs.
        match goal with
        | [H1: sub ?D1 ?DD, H2: sub ?D2 ?DD
           |- consistent (Ann (Lam ?A1 ?e1 ?B1) (Arr ?C1 ?D1)) (Ann (Lam ?A2 ?e2 ?B2) (Arr ?C2 ?D2))] =>
            (pose proof (casting_progress (Ann (Lam A1 e1 B1) (Arr C1 D1)) (Arr C1 D1) (Arr (And C1 C2) DD)) as Ct1;
             pose proof (casting_progress (Ann (Lam A2 e2 B2) (Arr C2 D2)) (Arr C2 D2) (Arr (And C1 C2) DD)) as Ct2;
             assert (Ord: ordinary (Arr (And C1 C2) DD)) by eauto)
        end.
        destruct Ct1 as [x1 Ct1]; eauto. destruct Ct2 as [x2 Ct2]; eauto.
        pose proof (Cons _ _ _ Ord Ct1 Ct2). subst.
        dependent destruction Ct1; dependent destruction Ct2; eauto.
  - eapply consistent_spec_inv_merge_r in Cons. destruct_conjs.
    dependent destruction Typ2;
      eapply Con_Mrg_R; eapply IH; eauto; simpl in *; lia.
  - eapply consistent_spec_inv_merge_l in Cons. destruct_conjs.
    dependent destruction Typ1;
      eapply Con_Mrg_L; eapply IH; eauto; simpl in *; lia.
  - eapply consistent_spec_inv_merge_l in Cons. destruct_conjs.
    dependent destruction Typ1;
      eapply Con_Mrg_L; eapply IH; eauto; simpl in *; lia.
Qed.

(** ** Preservation *)

Lemma casting_consistent :
  forall v v1 v2 A A1 A2 B C,
    value v ->
    typing nil v A ->
    typing nil v1 A1 ->
    typing nil v2 A2 ->
    casting v B v1 ->
    casting v C v2 ->
    consistent v1 v2.
Proof.
  introv Val Typ Typ1 Typ2 Ct1 Ct2.
  eapply consistent_complete; eauto.
  unfold consistent_spec. intros E v1' v2' Ord Ct1' Ct2'.
  pose proof (casting_transitivity v v1 v1' B E Val Ct1 Ct1').
  pose proof (casting_transitivity v v2 v2' C E Val Ct2 Ct2').
  eapply casting_determinism_gen; eauto.
Qed.

(** * Preservation *)

Lemma casting_preservation :
  forall v v' A B,
    value v ->
    typing nil v B ->
    casting v A v' ->
    exists C, typing nil v' C /\ isosub C A.
Proof.
  introv Val Typ Ct. gen B.
  induction Ct; intros; try solve [eexists; eauto].
  - Case "Lam".
    exists (Arr C D). split; eauto 3.
    repeat (dependent destruction Typ).
    dependent destruction Val.
    assert (Sub1: sub (Arr A B) (Arr C D)) by (eapply sub_transitivity; eauto).
    dependent destruction Sub1; eauto 3.
    assert (Sub2: sub (Arr A D) (Arr C D)) by eauto.
    eapply Ty_Ann; eauto. eapply Ty_Lam; eauto. eapply sub_transitivity; eauto.
  - Case "Merge L".
    dependent destruction Val. dependent destruction Typ; eauto.
  - Case "Merge R".
    dependent destruction Val. dependent destruction Typ; eauto.
  - pose proof (IHCt1 Val B Typ) as IH1. destruct IH1 as [x1 IH1].
    pose proof (IHCt2 Val B Typ) as IH2. destruct IH2 as [x2 IH2].
    destruct_conjs.
    exists (And x1 x2). split; eauto. eapply Ty_Mrg_Uv; eauto.
    eapply casting_consistent; eauto.
Qed.


Set Universe Polymorphism.

Module Type S.
Parameter Inline T@{i} : Type@{i+1}.
End S.

Module F (X : S).
Definition X@{j i} : Type@{j} := X.T@{i}.
End F.

Module M.
Definition T@{i} := Type@{i}.
End M.

Module N := F(M).

Require Import Hurkens.

Fail Definition eqU@{i j} : @eq Type@{j} N.X@{i Set} Type@{i} := eq_refl.


Require Import VST.floyd.proofauto.
Require Import qsort3.
Require Import spec_qsort3.
Require Import float_lemmas.
Require Import Permutation.
Require Import qsort3_aux.

Set Nested Proofs Allowed.

Definition quicksort_while_body_part2 :=
match quicksort_while_body
  with Ssequence _ (Ssequence _ (Ssequence _ a)) =>
     a
| _ => Sskip
end.

Definition quicksort_do_loop :=
match quicksort_while_body_part2
  with Ssequence _ (Ssequence _ (Ssequence a _)) =>
     a
| _ => Sskip
end.

Lemma forward_quicksort_do_loop :
forall (Espec : OracleKind) (base : val) (al : list val)
  (lo mid hi : Z) (bl : list val),
Forall def_float al ->
let N := Zlength al in
0 < N <= Z.min Int.max_signed (Ptrofs.max_signed / 8) ->
isptr base ->
0 <= lo <= mid ->
mid < hi < N ->
f_cmp Cge (Znth mid bl) (Znth lo bl) ->
f_cmp Cle (Znth mid bl) (Znth hi bl) ->
Permutation al bl ->
sorted (f_cmp Cle) (sublist 0 lo bl) ->
sorted (f_cmp Cle) (sublist (hi + 1) N bl) ->
(0 < lo ->
 Forall (f_cmp Cle (Znth (lo - 1) bl)) (sublist lo N bl)) ->
(hi + 1 < N ->
 Forall (f_cmp Cge (Znth (hi + 1) bl))
   (sublist 0 (hi + 1) bl)) ->

semax (func_tycontext f_quicksort Vprog Gprog [])
  (PROP ()
   LOCAL (temp _right_ptr (dnth base (hi - 1));
   temp _left_ptr (dnth base (lo + 1));
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base))
  quicksort_do_loop
 (normal_ret_assert
   (EX left:Z, EX mid:Z, EX right:Z, EX bl: list val,
    PROP (lo < left <= hi; lo <= right < hi; lo <= mid < hi;
       (left=right+1 \/ left=right+2)%Z;
       Forall (f_cmp Cge (Znth mid bl)) (sublist lo left bl);
       Forall (f_cmp Cle (Znth mid bl)) (sublist (right+1) (hi+1) bl);
       Permutation al bl;
       sorted (f_cmp Cle) (sublist 0 lo bl);
       sorted (f_cmp Cle) (sublist (hi + 1) N bl);
       0 < lo -> Forall (f_cmp Cle (Znth (lo - 1) bl)) (sublist lo N bl);
       hi + 1 < N -> Forall (f_cmp Cge (Znth (hi + 1) bl))  (sublist 0 (hi + 1) bl))
    LOCAL (temp _right_ptr (dnth base right);
       temp _left_ptr (dnth base left);
       temp _mid (dnth base mid); temp _lo (dnth base lo);
       temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base))).
Proof.
intros.
set (s := quicksort_do_loop); hnf in s; subst s.
abbreviate_semax.
clearbody Delta_specs.
set (M := Z.min _ _) in H0; compute in M; subst M.
assert (Hlen := Permutation_Zlength H6).
forward_loop  (EX left:Z, EX mid:Z, EX right:Z, EX bl: list val,
   PROP (
   lo < left <= right+1; right < hi; lo <= mid < hi;
   Forall (f_cmp Cge (Znth mid bl)) (sublist lo left bl);
   Forall (f_cmp Cle (Znth mid bl)) (sublist (right+1) (hi+1) bl);
   Permutation al bl;
   sorted (f_cmp Cle) (sublist 0 lo bl);
   sorted (f_cmp Cle) (sublist (hi + 1) N bl);
   0 < lo -> Forall (f_cmp Cle (Znth (lo - 1) bl)) (sublist lo N bl);
   hi + 1 < N -> Forall (f_cmp Cge (Znth (hi + 1) bl))  (sublist 0 (hi + 1) bl))
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base)).
{ Exists (lo+1) mid (hi-1) bl.
  entailer!.
  rewrite !sublist_one by rep_lia.
  rewrite Z.sub_add.
  repeat constructor; auto.
}
destruct H2 as [H2 _].
destruct H3 as [_ H3].
clear dependent bl.
clear mid.
Intros left mid right bl.
assert (H2': 0 <= lo <= mid) by lia.
assert (H3': mid < hi < N) by lia.
clear H2 H3 H6; rename H2' into H2; rename H3'  into H3.
rename H7 into H6; rename H8 into H7; rename H9 into H8;
rename H10 into H9; rename H11 into H10; rename H12 into H11;
rename H13 into H12.
assert (Hdef_bl: Forall def_float bl) by (apply Forall_perm with al; auto).
assert (Hlen := Permutation_Zlength H8).
pose_dnth_base mid.
forward_loop (EX left:Z,
   PROP (lo < left <= right+1; right < hi;
       Forall (f_cmp Cge (Znth mid bl)) (sublist lo left bl))
   LOCAL (temp _left_ptr (dnth base left);
       temp _right_ptr (dnth base right);
       temp _mid (dnth base mid); temp _lo (dnth base lo);
       temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base))
 break:
  (EX left:Z,
   PROP (lo < left <= right+1; right < hi;
       f_cmp Cge (Znth left bl) (Znth mid bl);
       Forall (f_cmp Cge (Znth mid bl)) (sublist lo left bl))
   LOCAL (temp _left_ptr (dnth base left);
       temp _right_ptr (dnth base right);
       temp _mid (dnth base mid); temp _lo (dnth base lo);
       temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base)).
-
Exists left; entailer!.
-
clear dependent left.
Intros left.
pose_dnth_base left.
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward_if.
apply typed_true_cmp in H15.
forward.
rewrite dbase_add by (auto; rep_lia).
Exists (left+1).
entailer!.
clear H25 H24 H23 H22 H21 H20 H19 H18 H17 H16.
split.
split; try lia.
assert (f_cmp Cle (Znth mid bl) (Znth (right+1) bl)).
rewrite (sublist_split _ (right+2)) in H7 by lia.
rewrite Forall_app in H7. destruct  H7 as [H7 _].
rewrite sublist_one in H7 by lia. inv H7. auto.
assert (left<>right+1);[|lia].
intro; subst left.
clear - H15 H16.
apply f_cmp_swap in H15.
eapply float_cmp_gt_le_false; eauto.
rewrite (sublist_split _ left) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_one by lia.
repeat constructor; auto.
apply f_cmp_swap in H15.
rewrite f_cmp_ge_gt_eq; auto.
forward.
Exists left.
entailer!.
apply typed_false_cmp in H15; [ | apply Forall_Znth; auto; lia ..].
auto.
-
clear dependent left.
Intros left.
apply f_cmp_swap in H6; simpl in H6.
forward_loop (EX right:Z,
   PROP (
   lo < left <= right+1; right < hi;
   f_cmp Cle (Znth mid bl) (Znth left bl);
   Forall (f_cmp Cle (Znth mid bl)) (sublist (right+1) (hi+1) bl))
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base))
 break:
  (EX right:Z,
   PROP (
   lo < left <= right+1; lo <= right < hi;
   f_cmp Cle (Znth mid bl) (Znth left bl);
   f_cmp Cge (Znth mid bl) (Znth right bl);
   Forall (f_cmp Cle (Znth mid bl)) (sublist (right+1) (hi+1) bl))
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base)).
+
Exists right; entailer!.
+
clear dependent right.
Intros right.
pose_dnth_base right.
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward_if.
apply typed_true_cmp in H16.
forward.
rewrite dbase_sub by (auto; rep_lia).
Exists (right-1).
entailer!.
clear H26 H25 H24 H23 H22 H21 H20 H19 H18 H17.
split.
split; try lia.
rewrite Z.sub_add.
destruct (zeq left (right+1)); try lia.
subst left. elimtype False.
rewrite (sublist_split lo right) in H14 by lia.
rewrite Forall_app in H14. destruct  H14 as [_ H14].
rewrite sublist_one in H14 by lia. inv H14.
eapply f_cmp_lt_ge_false; eauto.
rewrite Z.sub_add.
rewrite (sublist_split _ (right+1)) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_one by lia.
repeat constructor; auto.
rewrite f_cmp_le_lt_eq; auto.
forward.
Exists right.
entailer!.
apply typed_false_cmp in H16; [ | apply Forall_Znth; auto; lia ..].
auto.
+
destruct H2 as [H2 H2'].
destruct H3 as [H3' H3].
clear dependent right.
Intros right.
pose_dnth_base left.
pose_dnth_base right.
forward_if (EX left:Z, EX mid:Z, EX right:Z, EX bl: list val,
   PROP (
   lo < left <= right+1; lo-1 <= right < hi; lo <= mid < hi;
   Forall (f_cmp Cge (Znth mid bl)) (sublist lo (Z.min left hi) bl);
   Forall (f_cmp Cle (Znth mid bl)) (sublist (Z.max lo (right+1)) (hi+1) bl);
   Permutation al bl;
   sorted (f_cmp Cle) (sublist 0 lo bl);
   sorted (f_cmp Cle) (sublist (hi + 1) N bl);
   0 < lo -> Forall (f_cmp Cle (Znth (lo - 1) bl)) (sublist lo N bl);
   hi + 1 < N -> Forall (f_cmp Cge (Znth (hi + 1) bl))  (sublist 0 (hi + 1) bl))
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl base)).
*
apply test_order_dnth; auto; rep_lia.
*
eapply typed_true_pp in H18; eauto; simpl in H18.
assert (lo < left < right) by lia; clear H18 H4.
pose (bl' := swap_in_list right left bl).
apply semax_seq' with
 (PROP ()
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl' base)).
abbreviate_semax.
match goal with |- semax _ ?Pre _ ?Post =>
forward_loop Pre continue:Post.(RA_normal) end;
  [solve [auto] | | forward; apply ENTAIL_refl ].
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward.
apply tc_val_tdouble_Znth; auto; lia.
forward.
forward.
rewrite !def_float_f2f by (apply Forall_Znth; auto; lia).
entailer!.
subst MORE_COMMANDS; unfold abbreviate.
simpl reptype in *.
forward_if (EX mid:Z,
  PROP (lo <= mid < hi;
      f_cmp Cle (Znth left bl') (Znth mid bl');
      Forall (f_cmp Cge (Znth mid bl')) (sublist lo left bl');
      f_cmp Cle (Znth mid bl') (Znth right bl');
      Forall (f_cmp Cle (Znth mid bl'))
                  (sublist (right + 1) (hi + 1) bl'))
   LOCAL (temp _left_ptr (dnth base left);
   temp _right_ptr (dnth base right);
   temp _mid (dnth base mid); temp _lo (dnth base lo);
   temp _hi (dnth base hi))
   SEP (data_at Ews (tarray tdouble N) bl' base)).
--
apply test_eq_dnth; try rep_lia; auto.
--
forward.
replace base with (dnth base 0) at 1
 by (make_Vptr base; unfold dnth; simpl; normalize).
rewrite dbase_add by (auto; rep_lia).
eapply typed_true_pp in H4; eauto; simpl in H4.
rewrite Z.add_0_l.
Exists right.
entailer!.
clear H25 H24 H23 H22 H21 H20 H18.
subst bl'.
rewrite Znth_swap_in_list2 by lia.
rewrite Znth_swap_in_list1 by lia.
split; [ | split3].
apply f_cmp_swap in H7; auto.
rewrite sublist_swap_in_list by lia; auto.
rewrite f_cmp_le_lt_eq. right.
apply float_cmp_eq_refl. apply Forall_Znth; auto; lia.
rewrite sublist_swap_in_list by lia; auto.
--
eapply typed_false_pp in H4; eauto; simpl in H4.
forward_if.
++
apply test_eq_dnth; try rep_lia; auto.
++
eapply typed_true_pp in H18; eauto; simpl in H18.
forward.
replace base with (dnth base 0) at 1
 by (make_Vptr base; unfold dnth; simpl; normalize).
rewrite dbase_add by (auto; rep_lia).
rewrite Z.add_0_l.
Exists left.
entailer!.
clear H26 H25 H24 H23 H22 H21 H20.
subst bl'.
rewrite Znth_swap_in_list2 by lia.
rewrite Znth_swap_in_list1 by lia.
split; [ | split3].
apply f_cmp_swap in H7; auto.
rewrite sublist_swap_in_list by lia; auto.
auto.
rewrite sublist_swap_in_list by lia; auto.
++
forward.
eapply typed_false_pp in H18; eauto; simpl in H18.
Exists mid.
entailer!.
clear H27 H26 H25 H24 H23 H22 H21 H20.
subst bl'.
rewrite Znth_swap_in_list2 by lia.
rewrite Znth_swap_in_list1 by lia.
rewrite Znth_swap_in_list_other by lia.
split; [ | split3].
apply f_cmp_swap in H7; auto.
rewrite sublist_swap_in_list by lia; auto.
auto.
rewrite sublist_swap_in_list by lia; auto.
--
clear dependent mid.
Intros mid.
forward.
forward.
rewrite dbase_sub by (auto; rep_lia).
rewrite dbase_add by (auto; rep_lia).
Exists (left+1) mid (right-1) bl'.
entailer!.
clear H25 H24 H23 H22 H21 H20 H18 H15.
assert (Permutation bl bl')
  by (apply Permutation_swap2; lia).
pose proof (Permutation_Zlength H15).
split3.
destruct (zlt left hi).
rewrite Z.min_l by lia.
rewrite (sublist_split _ left) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_len_1 by lia.
repeat constructor.
apply f_cmp_swap in H6; auto.
rewrite Z.min_r by lia.
assert (left=hi) by lia.
subst left.
auto.
rewrite Z.sub_add.
destruct (zlt right lo).
rewrite Z.max_l by lia.
assert (right=lo-1) by lia.
subst right.
rewrite Z.sub_add in H14.
auto.
rewrite Z.max_r by lia.
rewrite (sublist_split _ (right+1)) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_len_1 by lia.
repeat constructor.
auto.
split.
apply Permutation_trans with bl; auto.
split; [ | split3].
subst bl'. rewrite sublist_swap_in_list by lia. auto.
subst bl'. rewrite sublist_swap_in_list by lia. auto.
subst bl'.
intros.
rewrite Znth_swap_in_list_other by lia.
eapply Forall_perm; try apply H11; auto.
rewrite sublist_swap_in_list'; try lia; auto.
apply Permutation_swap2; list_solve.
subst bl'.
intros.
rewrite Znth_swap_in_list_other by lia.
eapply Forall_perm; try apply H12; auto.
rewrite sublist_swap_in_list'; try lia; auto.
apply Permutation_swap2; list_solve.
*
eapply typed_false_pp in H18; eauto; simpl in H18.
forward_if.
++
apply test_eq_dnth; try rep_lia; auto.
++
eapply typed_true_pp in H19; eauto; simpl in H19.
subst right.
forward.
forward.
forward.
rewrite dbase_add by (auto; rep_lia).
rewrite dbase_sub by (auto; rep_lia).
Exists (left+1) mid (left-1) bl.
entailer!.
rewrite Z.sub_add.
clear H26 H25 H24 H23 H22 H21 H20 H19 H18 H17.
split.
rewrite (sublist_split _ left) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_len_1 by lia; repeat constructor; auto.
rewrite (sublist_split _ (left+1)) by lia.
rewrite Forall_app; split; auto.
rewrite sublist_len_1 by lia; repeat constructor; auto.
++
eapply typed_false_pp in H19; eauto; simpl in H19.
forward.
Exists left mid right bl.
entailer!.
clear H27 H26 H25 H24 H23 H22 H21 H20.
assert (left = right+1) by lia.
subst left.
clear H19 H18 H4.
rewrite Z.min_l by lia.
rewrite Z.max_r by lia.
split; auto.
*
clear dependent left.
clear dependent right.
clear dependent bl.
clear dependent mid.
Intros left mid right bl.
pose_dnth_base left.
pose_dnth_base right.
forward_if.
apply test_order_dnth; try rep_lia; auto.
eapply typed_true_pp in H16; eauto; simpl in H16.
forward.
Exists left mid right bl.
entailer!.
autorewrite with sublist in H7,H8.
auto.
forward.
eapply typed_false_pp in H16; eauto; simpl in H16.
Exists left mid right bl.
entailer!.
autorewrite with sublist in H7,H8.
auto.
Qed.


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

Require Export Pspoly.
Require Export Pmult.
Section crit.
Load "hCoefStructure".
Load "hOrderStructure".
Load "hSpoly".
Load "hMult".

Definition Rminus :
  forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
  list (Term A n) -> list (Term A n) -> list (Term A n) -> list (Term A n).
intros a nZa p q r; elim r; clear r.
exact p.
intros b r Rec;
 exact
  (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec Rec
     (mults (A:=A) multA (n:=n)
        (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) b (b:=a) nZa) q)).
Defined.

Theorem minuspf_in :
 forall (p q : list (Term A n)) (a b : Term A n),
 In a p ->
 ltT ltM b a ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM (pX b q) ->
 In a
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p (pX b q)).
intros p; elim p; simpl in |- *; auto.
intros q a b H'; elim H'; auto.
intros a l H' q a0 b H'0 H'1 H'2 H'3.
elim H'0; [ intros H'4; rewrite H'4; clear H'0 | intros H'4; clear H'0 ].
change
  (In a0
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
        (pX a0 l) (pX b q))) in |- *.
rewrite <- minuspf_inv1_eq; simpl in |- *; auto.
case (ltT_dec A n ltM ltM_dec a b); intros test;
 [ case test; clear test; intros test | idtac ].
absurd (ltT ltM b a0); auto.
apply ltT_not_ltT; auto.
generalize H'4 H'2; elim l; simpl in |- *; auto.
intros H'0; elim H'0; auto.
intros a1 l0 H'0 H'5; elim H'5;
 [ intros H'6; rewrite <- H'6; clear H'5 | intros H'6; clear H'5 ];
 auto.
intros H'5; apply (ltT_trans A n ltM os) with (y := a); auto.
apply (canonical_pX_order A A0 eqA) with (l := l0); auto.
intros H'5; apply H'0; auto.
change (canonical A0 eqA ltM (pX a l0)) in |- *.
apply canonical_skip_fst with (b := a1); auto.
change
  (In a0
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
        (pX a l) (pX b q))) in |- *.
rewrite <- minuspf_inv1_eq; simpl in |- *; auto.
right; auto.
apply H'; auto.
apply canonical_imp_canonical with (a := a); auto.
absurd (ltT ltM b a0); auto.
apply ltT_not_ltT; auto.
apply eqT_compat_ltTr with (b := a); auto.
generalize H'4 H'2; elim l; simpl in |- *; auto.
intros H'0; elim H'0; auto.
intros a1 l0 H'0 H'5; elim H'5;
 [ intros H'6; rewrite <- H'6; clear H'5 | intros H'6; clear H'5 ];
 auto.
intros H'5; apply (canonical_pX_order A A0 eqA) with (l := l0); auto.
intros H'5; apply H'0; auto.
change (canonical A0 eqA ltM (pX a l0)) in |- *.
apply canonical_skip_fst with (b := a1); auto.
Qed.

Theorem minus_is_reduce :
 forall (Q : list (poly A0 eqA ltM)) (a : Term A n)
   (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a) (q : list (Term A n)),
 inPolySet A A0 eqA n ltM (pX a q) Q ->
 forall u : Term A n,
 divP A A0 eqA multA divA n u a ->
 forall p : list (Term A n),
 canonical A0 eqA ltM p ->
 In u p ->
 reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q p
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p
      (mults (A:=A) multA (n:=n)
         (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) u (b:=a) nZa)
         (pX a q))).
intros Q a nZa q inP0 u divP0 p; elim p.
intros H' H'0; elim H'0; auto.
intros a0 l H' H'0 H'1; elim H'1;
 [ intros H'2; rewrite H'2; clear H'1 | intros H'2; clear H'1 ];
 auto.
change
  (reduce A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
     (pX u l)
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
        (pX u l)
        (mults (A:=A) multA (n:=n)
           (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) u (b:=a) nZa)
           (pX a q)))) in |- *.
apply reducetop with (b := a) (nZb := nZa) (q := q); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := spminusf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec u
            a nZa (pX u l) (pX a q)); auto.
apply spminusf_extend with (1 := cs); auto.
rewrite <- H'2; auto.
apply inPolySet_imp_canonical with (L := Q); auto.
apply
 reduce_eqp_com
  with
    (1 := cs)
    (p := pX a0 l)
    (q := pX a0
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec l
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) u (b:=a)
                     nZa) (pX a q)))); auto.
apply reduceskip; auto.
apply H'; auto.
apply canonical_imp_canonical with (a := a0); auto.
change
  (eqP A eqA n
     (pX a0
        (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec l
           (mults (A:=A) multA (n:=n)
              (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) u (b:=a) nZa)
              (pX a q))))
     (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
        (pX a0 l)
        (mults (A:=A) multA (n:=n)
           (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) u (b:=a) nZa)
           (pX a q)))) in |- *.
simpl in |- *; apply minuspf_inv1 with (1 := cs); auto.
apply eqT_compat_ltTl with (b := u); auto.
inversion divP0; auto.
apply (eqTerm_imp_eqT A eqA n); auto.
generalize H'2 H'0; elim l; simpl in |- *; auto.
intros H'1; elim H'1; auto.
intros a2 l0 H'1 H'3; elim H'3;
 [ intros H'4; rewrite <- H'4; clear H'3 | intros H'4; clear H'3 ];
 auto.
intros H'5.
apply (canonical_pX_order A A0 eqA) with (l := l0); auto.
intros H'5; apply H'1; auto.
change (canonical A0 eqA ltM (pX a0 l0)) in |- *.
apply canonical_skip_fst with (b := a2); auto.
Qed.

Definition divPp : Term A n -> list (Term A n) -> Prop.
intros a p; elim p; clear p.
exact True.
intros b p Rec; exact (divP A A0 eqA multA divA n b a /\ Rec).
Defined.
Hint Resolve divP_inv3.
Hint Resolve divP_inv3.

Definition divpf :
  forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
  list (Term A n) -> list (Term A n).
intros a nZa p; elim p; clear p.
exact (pO A n).
intros b p Rec;
 exact
  (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
     (pX (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) b (b:=a) nZa)
        (pO A n)) Rec).
Defined.

Theorem divpf_canonical :
 forall (a : Term A n) (p : list (Term A n))
   (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
 canonical A0 eqA ltM p -> canonical A0 eqA ltM (divpf a nZa p).
intros a p; elim p; simpl in |- *; auto.
intros a0 l H' H'0 H'1.
apply canonical_pluspf; auto.
apply canonicalp1; auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a0); auto.
apply (canonical_nzeroP A A0 eqA n ltM) with (p := l); auto.
apply H'; auto.
apply canonical_imp_canonical with (a := a0); auto.
Qed.
Hint Resolve divpf_canonical.

Theorem divPp_divpf :
 forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a)
   (p : list (Term A n)),
 canonical A0 eqA ltM p ->
 divPp a p -> eqP A eqA n p (mults (A:=A) multA (n:=n) a (divpf a nZa p)).
intros a nZa p; elim p; simpl in |- *; auto.
intros a0 l H' H'0 H'1; elim H'1; intros H'2 H'3; clear H'1.
cut (canonical A0 eqA ltM l);
 [ intros Op0 | apply canonical_imp_canonical with (a := a0) ];
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) a
               (pX
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a0 (b:=a)
                     nZa) (pO A n)))
            (mults (A:=A) multA (n:=n) a (divpf a nZa l))).
2: apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) a
               (pX
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a0 (b:=a)
                     nZa) (pO A n))) l).
simpl in |- *.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pX
               (multTerm (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a0 (b:=a)
                     nZa) a) (pO A n)) l).
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pX a0 (pO A n)) l).
change
  (eqP A eqA n (pX a0 l)
     (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
        (pX a0 (pO A n)) l)) in |- *; 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 (pO A n) l)).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite pluspf_inv1_eqa; auto.
apply canonicalp1; auto.
apply (canonical_nzeroP A A0 eqA n ltM) with (p := l); auto.
inversion H'2; auto.
auto.
auto.
Qed.

Theorem canonical_Rminus :
 forall (r p q : list (Term A n)) (a : Term A n)
   (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 canonical A0 eqA ltM r -> canonical A0 eqA ltM (Rminus a nZa p q r).
intros r; elim r; simpl in |- *; auto.
intros a l nZa p q a0 H'0 H'1 H'2 H'3.
cut (canonical A0 eqA ltM l);
 [ idtac | apply canonical_imp_canonical with (a := a); auto ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ idtac | apply canonical_nzeroP with (ltM := ltM) (p := l) ];
 auto.
Qed.
Hint Resolve canonical_Rminus.

Theorem Rminus_in :
 forall (r p q : list (Term A n)) (a b : Term A n)
   (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b),
 divPp b r ->
 In a p ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM (pX b q) ->
 canonical A0 eqA ltM (pX a r) -> In a (Rminus b nZb p (pX b q) r).
intros r; elim r; simpl in |- *; auto.
intros a l H' p q a0 b nZb H'0 H'1 H'2 H'3 H'4.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q); auto ].
elim H'0; intros H'6 H'7; clear H'0.
apply minuspf_in; auto.
apply H'; auto.
apply canonical_skip_fst with (b := a); auto.
apply eqT_compat_ltTl with (b := a); auto.
apply (eqTerm_imp_eqT A eqA n); auto.
inversion H'6; auto.
apply (canonical_pX_order A A0 eqA) with (l := l); auto.
apply canonical_Rminus; auto.
apply canonical_imp_canonical with (a := a); auto.
apply canonical_imp_canonical with (a := a0); auto.
change
  (canonical A0 eqA ltM
     (mults (A:=A) multA (n:=n)
        (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb)
        (pX b q))) in |- *; auto.
Qed.

Theorem Rminus_is_reduceplus :
 forall (Q : list (poly A0 eqA ltM)) (a : Term A n)
   (q : list (Term A n)) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
 canonical A0 eqA ltM q ->
 inPolySet A A0 eqA n ltM (pX a q) Q ->
 forall r : list (Term A n),
 canonical A0 eqA ltM r ->
 divPp a r ->
 forall p : list (Term A n),
 canonical A0 eqA ltM p ->
 incl r p ->
 reduceplus A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q p
   (Rminus a nZa p (pX a q) r).
intros Q a q nZa Op0 in0 r; elim r; clear r.
simpl in |- *; intros H' H'0 p H'1 H'2; auto.
apply Rstar_0; auto.
intros a0 r1 Rec Op1 divp0 p Op2 incl0.
cut (canonical A0 eqA ltM r1);
 [ intros Cr1 | apply canonical_imp_canonical with (a := a0); auto ].
cut (canonical A0 eqA ltM (pX a q));
 [ intros Caq | apply inPolySet_imp_canonical with (L := Q); auto ].
elim divp0; intros H' H'0; clear divp0.
apply reduceplus_trans with (1 := cs) (y := Rminus a nZa p (pX a q) r1); auto.
apply Rec; auto.
red in |- *; intros p' H; apply incl0; auto with datatypes.
apply
 reduceplus_eqp_com
  with
    (1 := cs)
    (p := Rminus a nZa p (pX a q) r1)
    (q := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (Rminus a nZa p (pX a q) r1)
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a0 (b:=a) nZa)
               (pX a q))); auto.
apply reduce_imp_reduceplus with (1 := cs); auto.
apply minus_is_reduce; auto.
apply Rminus_in; auto with datatypes.
Qed.

Definition Dmult :
  forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
  list (Term A n) -> list (Term A n) -> list (Term A n).
intros a nZa p q; elim p; clear p.
exact (pO A n).
intros a1 p1 rec;
 exact
  (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
     (divpf a nZa (mults (A:=A) multA (n:=n) a1 q)) rec).
Defined.

Theorem canonical_Dmult :
 forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a)
   (p q : list (Term A n)),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q -> canonical A0 eqA ltM (Dmult a nZa p q).
intros a nZa p; elim p; simpl in |- *; auto.
intros a0 l H' q H'0 H'1.
cut (canonical A0 eqA ltM l);
 [ idtac | apply canonical_imp_canonical with (a := a0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a0); auto.
apply canonical_nzeroP with (ltM := ltM) (p := l); auto.
Qed.
Hint Resolve canonical_Dmult.

Theorem divp_is_multTerm :
 forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b),
 divP A A0 eqA multA divA n a b ->
 forall p : list (Term A n),
 canonical A0 eqA ltM p ->
 eqP A eqA n
   (mults (A:=A) multA (n:=n)
      (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb) p)
   (divpf b nZb (mults (A:=A) multA (n:=n) a p)).
intros a b nZb H'; inversion H'.
intros p; elim p; simpl in |- *; auto.
intros a1 p1 H'0 H'1.
cut (canonical A0 eqA ltM p1);
 [ intros Op0 | apply canonical_imp_canonical with (a := a1) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a1);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p1) ];
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (pX
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                  (multTerm (A:=A) multA (n:=n) a a1) (b:=b) nZb)
               (pO A n))
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb)
               p1)); auto.
cut
 (eqTerm (A:=A) eqA (n:=n)
    (multTerm (A:=A) multA (n:=n)
       (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb) a1)
    (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
       (multTerm (A:=A) multA (n:=n) a a1) (b:=b) nZb));
 auto.
intros H'2.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pX
            (multTerm (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb)
               a1)
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (pO A n)
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b)
                     nZb) p1))); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
rewrite pluspf_inv1_eqa; auto.
change
  (canonical A0 eqA ltM
     (mults (A:=A) multA (n:=n)
        (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=b) nZb)
        (pX a1 p1))) in |- *; auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n);
 apply divTerm_multTerm_r with (1 := cs); auto.
Qed.

Theorem Rminus_is_mult :
 forall (r p q : list (Term A n)) (a : Term A n)
   (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 canonical A0 eqA ltM r ->
 divPp a r ->
 eqP A eqA n (Rminus a nZa p q r)
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p
      (Dmult a nZa r q)).
intros r; elim r; clear r; simpl in |- *; auto.
intros p q a nZa H'0 H'1 H'2 H'3; apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 auto.
apply minuspf_pO_refl with (1 := cs); auto.
intros a l H' p q a0 nZa0 H'1 H'2 H'3 H'4; elim H'4; intros H'5 H'6;
 clear H'4.
cut (canonical A0 eqA ltM l);
 [ intros Op0 | 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 := l); auto ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p
               (Dmult a0 nZa0 l q))
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a0) nZa0)
               q)); [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p
               (Dmult a0 nZa0 l q))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a0)
                     nZa0) q))); [ auto | idtac ].
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
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (Dmult a0 nZa0 l q)))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a0)
                     nZa0) q))); [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            p
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (Dmult a0 nZa0 l q))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n)
                     (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a
                        (b:=a0) nZa0) q)))); [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := 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))
               (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
                  ltM_dec (Dmult a0 nZa0 l q)
                  (mults (A:=A) multA (n:=n)
                     (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a
                        (b:=a0) nZa0) q)))).
2: apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply mults_dist_pluspf with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (Dmult a0 nZa0 l q)
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a0)
                     nZa0) q))).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply minuspf_comp with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a0) nZa0)
               q) (Dmult a0 nZa0 l q)).
apply pluspf_com with (1 := cs); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply divp_is_multTerm; auto.
auto.
Qed.

Theorem divpf_comp :
 forall (a b : Term A n) (p q : list (Term A n)),
 eqP A eqA n p q ->
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 eqTerm (A:=A) eqA (n:=n) a b ->
 forall (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a)
   (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b),
 eqP A eqA n (divpf a nZa p) (divpf b nZb q).
intros a b p q H'; elim H'; simpl in |- *; auto.
intros ma mb p0 q0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 H'7.
cut (canonical A0 eqA ltM p0);
 [ intros Op1 | apply canonical_imp_canonical with (a := ma); auto ].
cut (canonical A0 eqA ltM q0);
 [ intros Op2 | apply canonical_imp_canonical with (a := mb); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) ma);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) mb);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q0); auto ].
auto.
Qed.

Theorem Dmult_is_mulpf :
 forall (a : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a)
   (p q : list (Term A n)),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 eqP A eqA n (Dmult a nZa (mults (A:=A) multA (n:=n) a p) q)
   (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q).
intros a nZa p; elim p; simpl in |- *; auto.
intros a0 l H'0 q H'1 H'2.
cut (canonical A0 eqA ltM l);
 [ intros Op0 | apply canonical_imp_canonical with (a := a0); auto ].
cut
 (canonical A0 eqA ltM
    (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec l q));
 [ intros Op1 | auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a0);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := l); auto ].
apply eqp_pluspf_com with (1 := cs); 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 a0) (b:=a) nZa) q).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n).
apply divp_is_multTerm; auto.
apply mults_comp with (1 := cs); auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := multTerm (A:=A) multA (n:=n) a0
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) a (b:=a) nZa));
 auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
            (multTerm (A:=A) multA (n:=n) a0 a) (b:=a) nZa);
 auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem sp_Rminus :
 forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b)
   (p q : list (Term A n)),
 canonical A0 eqA ltM (pX a p) ->
 canonical A0 eqA ltM (pX b q) ->
 eqP A eqA n
   (Rminus b nZb
      (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
         (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q))
      (pX b q) (mults (A:=A) multA (n:=n) b p))
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
      (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec (pX a p) q)).
intros a b nZb p q H' H'0.
cut (canonical A0 eqA ltM p);
 [ intros Op0 | apply canonical_imp_canonical with (a := a); auto ].
cut (canonical A0 eqA ltM q);
 [ intros Op1 | apply canonical_imp_canonical with (a := b); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q); auto ];
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n) a q))
            (Dmult b nZb (mults (A:=A) multA (n:=n) b p) (pX b q))).
apply Rminus_is_mult; auto.
generalize Op0; elim p; simpl in |- *; auto.
intros a0 l H'1 H'2; split; auto.
apply divTerm_multTerml with (1 := cs); auto.
apply canonical_nzeroP with (ltM := ltM) (p := l); auto.
apply H'1.
apply canonical_imp_canonical with (a := a0); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n) a q))
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p (pX b q))).
apply minuspf_comp with (1 := cs); auto.
apply Dmult_is_mulpf; auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n) a q))
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p (pX b q))).
apply minuspf_comp with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n) a q))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) b p)
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)));
 [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) a q)))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) b p)
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)));
 [ auto | idtac ].
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 (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) a q)))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
                  ltM_dec (mults (A:=A) multA (n:=n) b p)
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q))));
 [ auto | idtac ].
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 (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) a q)))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) b p))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q))));
 [ auto | idtac ].
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
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) a q))
               (mults (A:=A) multA (n:=n) b p))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) b p))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)))).
apply eqp_pluspf_com with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a q))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) b p)
               (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
                  ltM_dec
                  (mults (A:=A) multA (n:=n)
                     (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                     (mults (A:=A) multA (n:=n) b p))
                  (mults (A:=A) multA (n:=n)
                     (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                     (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)))));
 [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a q))
            (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 (mults (A:=A) multA (n:=n) b p)
                  (mults (A:=A) multA (n:=n)
                     (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                     (mults (A:=A) multA (n:=n) b p)))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)))).
apply eqp_pluspf_com with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a q))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec
               (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
                  (mults (A:=A) multA (n:=n) b p)
                  (mults (A:=A) multA (n:=n) b p))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)))).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a q))
            (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))
                  (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q))));
 [ auto | idtac ].
apply eqp_pluspf_com with (1 := cs); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply minuspf_refl with (1 := cs); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a q))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)));
 [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) a q)
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)));
 auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem minuspf_spoly_in :
 forall (a b : Term A n) (nZa : ~ zeroP (A:=A) A0 eqA (n:=n) a)
   (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b),
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall p q : list (Term A n),
 canonical A0 eqA ltM p ->
 canonical A0 eqA ltM q ->
 (forall c : Term A n,
  In c p ->
  ltT ltM c (multTerm (A:=A) multA (n:=n) a b) /\
  eqT c
    (multTerm (A:=A) multA (n:=n)
       (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) c (b:=b) nZb) b)) ->
 (forall c : Term A n,
  In c q ->
  ltT ltM c (multTerm (A:=A) multA (n:=n) a b) /\
  eqT c
    (multTerm (A:=A) multA (n:=n)
       (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) c (b:=a) nZa) a)) ->
 forall c : Term A n,
 In c p ->
 In c (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec p q).
intros a b nZa nZb H'1 p q; pattern p, q in |- *.
apply (Opm_ind A n ltM ltM_dec); simpl in |- *; intros; auto.
elim H3; auto.
rewrite minuspf_pO_refl_eq; auto.
rewrite <- minuspf_inv2_eq; simpl in |- *; auto.
right; apply H; auto.
apply canonical_imp_canonical with (a := b0); auto.
rewrite <- minuspf_inv1_eq; simpl in |- *; auto.
elim H5; intros H'2; clear H5; auto.
right; apply H; auto.
apply canonical_imp_canonical with (a := a0); auto.
elim (H4 b0); [ intros H'4 H'5 | idtac ]; auto.
elim (H3 a0); [ intros H'6 H'7 | idtac ]; auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a0);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p0); auto ].
cut (~ zeroP (A:=A) A0 eqA (n:=n) b0);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q0); auto ].
absurd (eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b));
 auto.
apply eqT_not_ltT with (1 := os); auto.
case (ltT_dec A n ltM ltM_dec (ppc (A:=A) A1 (n:=n) a b) a0); intros test;
 [ case test; clear test; intros test | idtac ].
apply (ltT_trans A n ltM os) with (y := a0); auto.
absurd (ltT ltM a0 (ppc (A:=A) A1 (n:=n) a b)); auto.
apply divP_is_not_order with (1 := cs); auto.
cut (ppcm A A0 eqA multA divA n a b (ppc (A:=A) A1 (n:=n) a b));
 [ intros H'8; inversion H'8 | idtac ]; auto.
apply H6; auto.
apply eqT_nzero_eqT_divP with (c := b0) (nZb := nZa) (1 := cs); auto.
apply eqT_nzero_divP with (nZb := nZb) (1 := cs); auto.
apply ppc_is_ppcm with (1 := cs); auto.
apply eqT_compat_ltTl with (b := a0); auto.
apply (eqT_sym A n); auto.
Qed.

Theorem multTerm_or_z_d1 :
 forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b)
   (p : list (Term A n)),
 canonical A0 eqA ltM (pX a p) ->
 forall c : Term A n,
 In c (mults (A:=A) multA (n:=n) b p) ->
 ltT ltM c (multTerm (A:=A) multA (n:=n) a b) /\
 eqT c
   (multTerm (A:=A) multA (n:=n)
      (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) c (b:=b) nZb) b).
intros a b nZb p; elim p; simpl in |- *; auto.
intros H' c H'0; elim H'0; auto.
intros a0 l H' H'0 c H'1; elim H'1;
 [ intros H'2; rewrite <- H'2; clear H'1 | intros H'2; clear H'1 ];
 auto.
2: apply H'; auto.
2: apply canonical_skip_fst with (b := a0); auto.
split; auto.
apply eqT_compat_ltTr with (b := multTerm (A:=A) multA (n:=n) b a); auto.
apply (eqTerm_imp_eqT A eqA n); auto.
apply multTerm_ltT_l; auto.
apply (canonical_pX_order A A0 eqA) with (l := l); auto.
apply (eqT_trans A n) with (y := multTerm (A:=A) multA (n:=n) a0 b); auto.
apply (eqTerm_imp_eqT A eqA n); auto.
apply multTerm_eqT; auto.
apply (eqTerm_imp_eqT A eqA n); auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := multTerm (A:=A) multA (n:=n)
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) b (b:=b) nZb) a0);
 auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with (y := multTerm (A:=A) multA (n:=n) (T1 A1 n) a0);
 auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem multTerm_or_z_d2 :
 forall (a b : Term A n) (nZb : ~ zeroP (A:=A) A0 eqA (n:=n) b)
   (p : list (Term A n)),
 canonical A0 eqA ltM (pX a p) ->
 forall c : Term A n,
 In c (mults (A:=A) multA (n:=n) b p) ->
 ltT ltM c (multTerm (A:=A) multA (n:=n) b a) /\
 eqT c
   (multTerm (A:=A) multA (n:=n)
      (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) c (b:=b) nZb) b).
intros a b H' p; elim p; simpl in |- *; auto.
intros H'0 c H'1; elim H'1.
intros a0 l H'0 H'1 c H'2; elim H'2;
 [ intros H'3; rewrite <- H'3; clear H'2 | intros H'3; clear H'2 ];
 auto.
2: apply H'0; auto.
2: apply canonical_skip_fst with (b := a0); auto.
split; auto.
apply multTerm_ltT_l; auto.
apply (canonical_pX_order A A0 eqA) with (l := l); auto.
apply (eqT_trans A n) with (y := multTerm (A:=A) multA (n:=n) a0 b); auto.
apply (eqTerm_imp_eqT A eqA); auto.
apply multTerm_eqT; auto.
apply (eqTerm_imp_eqT A eqA); auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := multTerm (A:=A) multA (n:=n)
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) b (b:=b) H') a0);
 auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem in_minuspf_spoly_in :
 forall a b : Term A n,
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall p q : list (Term A n),
 canonical A0 eqA ltM (pX a p) ->
 canonical A0 eqA ltM (pX b q) ->
 forall c : Term A n,
 In c (mults (A:=A) multA (n:=n) b p) ->
 In c
   (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
      (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q)).
intros a b H' p q H'0 H'1 c H'2.
cut (canonical A0 eqA ltM p);
 [ intros Op0 | apply canonical_imp_canonical with (a := a) ];
 auto.
cut (canonical A0 eqA ltM q);
 [ intros Op1 | apply canonical_imp_canonical with (a := b) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q) ];
 auto.
apply minuspf_spoly_in with (a := a) (b := b) (nZa := Z0) (nZb := Z1); auto.
intros c0 H'6.
apply multTerm_or_z_d1 with (p := p); auto.
intros c0 H'6.
apply multTerm_or_z_d2 with (p := q); auto.
Qed.

Theorem divPp_mults1 :
 forall a : Term A n,
 ~ zeroP (A:=A) A0 eqA (n:=n) a ->
 forall p : list (Term A n),
 (forall b : Term A n, In b p -> ~ zeroP (A:=A) A0 eqA (n:=n) b) ->
 divPp a (mults (A:=A) multA (n:=n) a p).
intros a H' p; elim p; simpl in |- *; auto.
Qed.

Theorem spoly_Reduce :
 forall (Q : list (poly A0 eqA ltM)) (a b : Term A n),
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall p q : list (Term A n),
 inPolySet A A0 eqA n ltM (pX b q) Q ->
 canonical A0 eqA ltM (pX a p) ->
 reduceplus 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
      (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q))
   (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
      (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec (pX a p) q)).
intros Q a b H' p q H'0 H'1.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros nZb
 | apply canonical_nzeroP with (ltM := ltM) (p := q);
    apply inPolySet_imp_canonical with (L := Q) ];
 auto.
cut (canonical A0 eqA ltM p);
 [ intros Op0 | apply canonical_imp_canonical with (a := a) ];
 auto.
cut (canonical A0 eqA ltM (pX b q));
 [ intros Op1 | apply inPolySet_imp_canonical with (L := Q) ];
 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 q);
 [ intros Op2 | apply canonical_imp_canonical with (a := b) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q) ];
 auto.
apply
 reduceplus_eqp_com
  with
    (1 := cs)
    (p := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q))
    (q := Rminus b nZb
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) b p)
               (mults (A:=A) multA (n:=n) a q)) (pX b q)
            (mults (A:=A) multA (n:=n) b p)); auto.
apply Rminus_is_reduceplus; auto.
apply divPp_mults1; auto.
intros b0 H'2; apply (canonical_imp_in_nzero A A0 eqA n ltM p); auto.
red in |- *; intros a0 H'2; apply in_minuspf_spoly_in; auto.
apply sp_Rminus; auto; auto.
Qed.

Theorem spoly_reduceplus_pO :
 forall (Q : list (poly A0 eqA ltM)) (p q : list (Term A n)),
 inPolySet A A0 eqA n ltM q Q ->
 canonical A0 eqA ltM p ->
 reduceplus A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
   (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p q)
   (pO A n).
intros Q p; elim p; auto.
simpl in |- *; auto.
intros; apply Rstar_0; auto.
intros a1 p1 H' q H'0 H'1.
cut (canonical A0 eqA ltM p1);
 [ intros Op0 | apply canonical_imp_canonical with (a := a1) ];
 auto.
cut (canonical A0 eqA ltM q);
 [ intros Op1 | apply inPolySet_imp_canonical with (L := Q) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a1);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p1) ];
 auto.
apply
 reduceplus_trans
  with
    (1 := cs)
    (y := multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1 q);
 auto.
generalize Op1 H'0; case q; clear Op1 H'0 q.
intros H'0 H'2; elim (not_nil_in_polySet A A0 eqA n ltM Q); auto.
intros b1 q1 H'0 H'2.
cut (canonical A0 eqA ltM q1);
 [ intros Op2 | apply canonical_imp_canonical with (a := b1) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b1);
 [ intros nZb1 | apply canonical_nzeroP with (ltM := ltM) (p := q1) ];
 auto.
apply
 reduceplus_eqp_com
  with
    (1 := cs)
    (p := multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec
            (pX a1 p1) (pX b1 q1))
    (q := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec
               (pX a1 p1) (pX b1 q1))
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                  (multTerm (A:=A) multA (n:=n) a1 b1) (b:=b1) nZb1)
               (pX b1 q1))); auto.
apply reduce_imp_reduceplus with (1 := cs); auto.
apply minus_is_reduce; auto.
apply in_multpf_head; auto.
cut
 (eqTerm (A:=A) eqA (n:=n)
    (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
       (multTerm (A:=A) multA (n:=n) a1 b1) (b:=b1) nZb1) a1);
 [ intros Eq0 | auto ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec
               (pX a1 p1) (pX b1 q1))
            (mults (A:=A) multA (n:=n) a1 (pX b1 q1)));
 [ auto | idtac ].
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 (mults (A:=A) multA (n:=n) a1 (pX b1 q1))
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1
                  (pX b1 q1)))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a1 (pX b1 q1))));
 [ auto | idtac ].
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
               (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1
                  (pX b1 q1)) (mults (A:=A) multA (n:=n) a1 (pX b1 q1)))
            (mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
               (mults (A:=A) multA (n:=n) a1 (pX b1 q1))));
 [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1 (pX b1 q1))
            (pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM)
               ltM_dec (mults (A:=A) multA (n:=n) a1 (pX b1 q1))
               (mults (A:=A) multA (n:=n)
                  (invTerm (A:=A) invA (n:=n) (T1 A1 n))
                  (mults (A:=A) multA (n:=n) a1 (pX b1 q1)))));
 [ auto | idtac ].
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1 (pX b1 q1))
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n) a1 (pX b1 q1))
               (mults (A:=A) multA (n:=n) a1 (pX b1 q1)))).
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := pluspf (A:=A) A0 (eqA:=eqA) plusA eqA_dec (n:=n) (ltM:=ltM) ltM_dec
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec p1 (pX b1 q1))
            (pO A n)); auto.
apply eqp_pluspf_com with (1 := cs); auto.
apply minuspf_refl with (1 := cs); auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := multTerm (A:=A) multA (n:=n) a1
            (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n) b1 (b:=b1) nZb1));
 auto.
apply
 (eqTerm_trans _ _ _ _ _ _ _ _ _ cs n)
  with (y := multTerm (A:=A) multA (n:=n) a1 (T1 A1 n));
 auto.
apply (eqTerm_sym _ _ _ _ _ _ _ _ _ cs n); auto.
Qed.

Theorem fspoly_Reduceplus_pO :
 forall (Q : list (poly A0 eqA ltM)) (a b : Term A n),
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall p q : list (Term A n),
 inPolySet A A0 eqA n ltM (pX b q) Q ->
 inPolySet A A0 eqA n ltM (pX a p) Q ->
 reduceplus 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
      (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q))
   (pO A n).
intros Q a b H' p q H'0 H'1.
cut (canonical A0 eqA ltM (pX a p));
 [ intros Op0 | apply inPolySet_imp_canonical with (L := Q) ];
 auto.
cut (canonical A0 eqA ltM (pX b q));
 [ intros Op1 | apply inPolySet_imp_canonical with (L := Q) ];
 auto.
cut (canonical A0 eqA ltM p);
 [ intros Op2 | apply canonical_imp_canonical with (a := a) ];
 auto.
cut (canonical A0 eqA ltM q);
 [ intros Op3 | apply canonical_imp_canonical with (a := b) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a);
 [ intros Z0 | apply canonical_nzeroP with (ltM := ltM) (p := p) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b);
 [ intros Z1 | apply canonical_nzeroP with (ltM := ltM) (p := q) ];
 auto.
apply
 reduceplus_trans
  with
    (1 := cs)
    (y := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec (pX a p) q));
 auto.
apply spoly_Reduce; auto.
apply
 reduceplus_eqp_com
  with
    (1 := cs)
    (p := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (multpf A A0 eqA plusA multA eqA_dec n ltM ltM_dec q (pX a p)))
    (q := mults (A:=A) multA (n:=n) (invTerm (A:=A) invA (n:=n) (T1 A1 n))
            (pO A n)); auto.
apply reduceplus_mults with (1 := cs); auto.
apply spoly_reduceplus_pO; auto.
apply mults_comp with (1 := cs); auto.
apply multpf_com with (1 := cs); auto.
Qed.

Theorem spoly_Reducestar_pO :
 forall (Q : list (poly A0 eqA ltM)) (a b : Term A n),
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall (p q : list (Term A n)) (Cpxb : canonical A0 eqA ltM (pX b q))
   (Cpxa : canonical A0 eqA ltM (pX a p)),
 inPolySet A A0 eqA n ltM (pX b q) Q ->
 inPolySet A A0 eqA n ltM (pX a p) Q ->
 reduceplus A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
   (spolyf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
      (pX a p) (pX b q) Cpxa Cpxb) (pO A n).
intros Q a b H' p q Cpxb Cpxa H'0 H'1.
cut (canonical A0 eqA ltM p);
 [ intros Op2 | apply canonical_imp_canonical with (a := a) ];
 auto.
cut (canonical A0 eqA ltM q);
 [ intros Op3 | apply canonical_imp_canonical with (a := b) ];
 auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) a); [ intros nZa | idtac ]; auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) b); [ intros nZb | idtac ]; auto.
cut (~ zeroP (A:=A) A0 eqA (n:=n) (ppc (A:=A) A1 (n:=n) a b));
 [ intros nZppab | idtac ]; auto.
apply
 reduceplus_mults_inv
  with
    (a := divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
            (multTerm (A:=A) multA (n:=n) a b) (b:=
            ppc (A:=A) A1 (n:=n) a b) nZppab)
    (1 := cs); auto.
apply divP_on_eqT_eqT; auto.
apply (eqT_sym A n); auto.
2: apply spolyf_canonical with (1 := cs); auto.
2: apply canonical_nzeroP with (ltM := ltM) (p := q); auto.
2: apply canonical_nzeroP with (ltM := ltM) (p := p); auto.
apply
 reduceplus_eqp_com
  with
    (1 := cs)
    (p := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (mults (A:=A) multA (n:=n) b p) (mults (A:=A) multA (n:=n) a q))
    (q := pO A n); auto.
apply fspoly_Reduceplus_pO; 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 b)
               (b:=ppc (A:=A) A1 (n:=n) a b) nZppab)
            (minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=a) nZa) p)
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=b) nZb) q)));
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                  (multTerm (A:=A) multA (n:=n) a b)
                  (b:=ppc (A:=A) A1 (n:=n) a b) nZppab)
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=a) nZa) p))
            (mults (A:=A) multA (n:=n)
               (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                  (multTerm (A:=A) multA (n:=n) a b)
                  (b:=ppc (A:=A) A1 (n:=n) a b) nZppab)
               (mults (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=b) nZb) q)));
 auto.
apply
 (eqp_trans _ _ _ _ _ _ _ _ _ cs n)
  with
    (y := minuspf A A0 A1 eqA invA minusA multA eqA_dec n ltM ltM_dec
            (mults (A:=A) multA (n:=n)
               (multTerm (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (multTerm (A:=A) multA (n:=n) a b)
                     (b:=ppc (A:=A) A1 (n:=n) a b) nZppab)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=a) nZa)) p)
            (mults (A:=A) multA (n:=n)
               (multTerm (A:=A) multA (n:=n)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (multTerm (A:=A) multA (n:=n) a b)
                     (b:=ppc (A:=A) A1 (n:=n) a b) nZppab)
                  (divTerm (A:=A) (A0:=A0) (eqA:=eqA) divA (n:=n)
                     (ppc (A:=A) A1 (n:=n) a b) (b:=b) nZb)) q));
 auto.
apply minuspf_comp with (1 := cs); auto.
apply mults_comp with (1 := cs); auto.
apply divP_comp_ppc0 with (1 := cs); auto.
apply mults_comp with (1 := cs); auto.
apply divP_comp_ppc1 with (1 := cs); auto.
apply minuspf_comp with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n);
 apply mults_comp_minuspf with (1 := cs); auto.
apply mults_comp with (1 := cs); auto.
apply (eqp_sym _ _ _ _ _ _ _ _ _ cs n); apply spolyf_def with (1 := cs); auto.
Qed.

Theorem spoly_Reducestar_ppc :
 forall (Q : list (poly A0 eqA ltM)) (a b : Term A n),
 eqT (ppc (A:=A) A1 (n:=n) a b) (multTerm (A:=A) multA (n:=n) a b) ->
 forall (p q : list (Term A n)) (Cpxb : canonical A0 eqA ltM (pX b q))
   (Cpxa : canonical A0 eqA ltM (pX a p)),
 inPolySet A A0 eqA n ltM (pX b q) Q ->
 inPolySet A A0 eqA n ltM (pX a p) Q ->
 reducestar A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec Q
   (spolyf A A0 A1 eqA invA minusA multA divA eqA_dec n ltM ltM_dec
      (pX a p) (pX b q) Cpxa Cpxb) (pO A n).
intros Q a b H' p q Cpxb Cpxa H'0 H'1.
apply reducestar0; auto.
apply spoly_Reducestar_pO; auto.
apply pO_irreducible; auto.
Qed.
End crit.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableAux.Spec.
Require Import AbsAccessor.Spec.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsRef3.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition smc_rtt_map_spec0 (rd_addr: Z64) (map_addr: Z64) (level: Z64) (adt: RData) : option (RData * Z64) :=
    match rd_addr, map_addr, level with
    | VZ64 _rd_addr, VZ64 _map_addr, VZ64 _level =>
      rely is_int64 _map_addr;
      rely is_int64 _level;
      when _t'1 == validate_table_commands_spec (VZ64 _map_addr) (VZ64 _level) (VZ64 2) (VZ64 3) (VZ64 2) adt;
      rely is_int _t'1;
      rely is_int64 _t'1;
      let _ret := _t'1 in
      if (_ret =? 0) then
        rely is_int64 _rd_addr;
        when'' _g_rd_base, _g_rd_ofst, adt == find_lock_granule_spec (VZ64 _rd_addr) (VZ64 2) adt;
        rely is_int _g_rd_ofst;
        when _t'4 == is_null_spec (_g_rd_base, _g_rd_ofst) adt;
        rely is_int _t'4;
        if (_t'4 =? 1) then
          let _ret := 1 in
          Some (adt, (VZ64 _ret))
        else
          when' _ret, adt == table_map3_spec (_g_rd_base, _g_rd_ofst) (VZ64 _map_addr) (VZ64 _level) adt;
          rely is_int64 _ret;
          when adt == granule_unlock_spec (_g_rd_base, _g_rd_ofst) adt;
          Some (adt, (VZ64 _ret))
      else
        Some (adt, (VZ64 _ret))
     end
    .

End SpecLow.