Module Type cut_mod (B: base_mod) (S: sound_mod B) (C: complete_mod B S) (G: sequent_mod B S C).
(** * Cut Elimination  We first give some definitions*)
Reserved Notation "Γ ⊃c A" (at level 80).
Inductive Gcf : list PropF->list PropF->Prop :=
| Gcax  : forall v Γ Δ      , In #v Γ            -> In #v Δ          -> Γ ⊃c Δ
| GcBot : forall Γ Δ        , In ⊥ Γ                                 -> Γ ⊃c Δ
| cAndL : forall A B Γ1 Γ2 Δ, Γ1++A::B::Γ2 ⊃c Δ                      -> Γ1++A∧B::Γ2 ⊃c Δ
| cAndR : forall A B Γ Δ1 Δ2, Γ ⊃c Δ1++A::Δ2    -> Γ ⊃c Δ1++B::Δ2   -> Γ ⊃c Δ1++A∧B::Δ2
| cOrL  : forall A B Γ1 Γ2 Δ, Γ1++A::Γ2 ⊃c Δ    -> Γ1++B::Γ2 ⊃c Δ   -> Γ1++A∨B::Γ2 ⊃c Δ
| cOrR  : forall A B Γ Δ1 Δ2, Γ ⊃c Δ1++A::B::Δ2                      -> Γ ⊃c Δ1++A∨B::Δ2
| cImpL : forall A B Γ1 Γ2 Δ, Γ1++B::Γ2 ⊃c Δ    -> Γ1++Γ2 ⊃c A::Δ   -> Γ1++A→B::Γ2 ⊃c Δ
| cImpR : forall A B Γ Δ1 Δ2, A::Γ ⊃c Δ1++B::Δ2                     -> Γ ⊃c Δ1++A→B::Δ2
where "Γ ⊃c Δ" := (Gcf Γ Δ) : My_scope.
Notation "Γ =⊃ Δ" := (forall v,Satisfies v Γ->Validates v Δ) (at level 80).
Inductive Atomic : Set :=
| AVar : PropVars -> Atomic
| ABot : Atomic
.
Fixpoint AtomicF (P:Atomic) : PropF := match P with
| AVar P => #P
| ABot   => ⊥
end.
Fixpoint size A : nat := match A with
| # P   => 0
| ⊥     => 0
| B ∨ C => S (size B + size C)
| B ∧ C => S (size B + size C)
| B → C => S (size B + size C)
end.
Definition sizel := map_fold_right size plus 0.
Definition sizes Γ Δ:= sizel Γ + sizel Δ.
(** * Theorems  reverse implication*)
induction 1;[econstructor|constructor|constr..];eassumption.
Qed.
(** Soundness of Gc *)
intros. apply G_to_Nc in H. apply Soundness_general in H.
remember (H v H0). clear -i H0.
induction Δ.
contradiction.
simpl in i. case_eq (TrueQ v a);intro K;rewrite K in *;simpl in *.
exists a;split;[in_solve|rewrite K;trivial].
destruct (IHΔ i) as (?&?&?). exists x;split;[in_solve|assumption].
Qed.
(** Preparation for the nonstructural induction *)
intros;destruct x;destruct y;try (right;discriminate);try (left;reflexivity);
destruct (Varseq_dec p p0);
(left;f_equal;assumption)||(right;intro HH;injection HH;contradiction).
Qed.
intros;unfold sizes;apply plus_comm;reflexivity.
Qed.
intros;induction Γ1;unfold sizes;unfold sizel;simpl.
rewrite plus_assoc;f_equal;apply plus_comm.
rewrite <- !plus_assoc;f_equal;apply IHΓ1.
Qed.
intros;rewrite sizes_comm;rewrite sizes_comm_r;apply sizes_comm.
Qed.
intros;rewrite plus_comm;apply le_plus_trans;assumption.
Qed.

Lemma sizes_decr :
(forall A B Γ1 Γ2 Δ, sizes (Γ1++A::B::Γ2) Δ < sizes (Γ1++A∧B::Γ2) Δ)/\
(forall A B Γ Δ1 Δ2, sizes Γ (Δ1++A::Δ2)    < sizes Γ (Δ1++A∧B::Δ2))/\
(forall A B Γ Δ1 Δ2, sizes Γ (Δ1++B::Δ2)    < sizes Γ (Δ1++A∧B::Δ2))/\
(forall A B Γ1 Γ2 Δ, sizes (Γ1++A::Γ2) Δ    < sizes (Γ1++A∨B::Γ2) Δ)/\
(forall A B Γ1 Γ2 Δ, sizes (Γ1++B::Γ2) Δ    < sizes (Γ1++A∨B::Γ2) Δ)/\
(forall A B Γ Δ1 Δ2, sizes Γ (Δ1++A::B::Δ2) < sizes Γ (Δ1++A∨B::Δ2))/\
(forall A B Γ1 Γ2 Δ, sizes (Γ1++B::Γ2)  Δ   < sizes (Γ1++A→B::Γ2) Δ)/\
(forall A B Γ1 Γ2 Δ, sizes (Γ1++Γ2) (A::Δ)  < sizes (Γ1++A→B::Γ2) Δ)/\
(forall A B Γ Δ1 Δ2, sizes (A::Γ)(Δ1++B::Δ2)< sizes Γ (Δ1++A→B::Δ2)).