Module Type sequent_mod (B: base_mod) (S: sound_mod B) (C: complete_mod B S).
(** * Gentzen's Sequent Calculus *)
Reserved Notation "Γ ⊃ A" (at level 80).
Inductive G : list PropF->list PropF->Prop :=
| Gax  : forall A Γ Δ      , In A Γ           -> In A Δ          -> Γ ⊃ Δ
| GBot : forall Γ Δ        , In ⊥ Γ                              -> Γ ⊃ Δ
| AndL : forall A B Γ1 Γ2 Δ, Γ1++A::B::Γ2 ⊃ Δ                    -> Γ1++A∧B::Γ2 ⊃ Δ
| AndR : forall A B Γ Δ1 Δ2, Γ ⊃ Δ1++A::Δ2    -> Γ ⊃ Δ1++B::Δ2   -> Γ ⊃ Δ1++A∧B::Δ2
| OrL  : forall A B Γ1 Γ2 Δ, Γ1++A::Γ2 ⊃ Δ    -> Γ1++B::Γ2 ⊃ Δ   -> Γ1++A∨B::Γ2 ⊃ Δ
| OrR  : forall A B Γ Δ1 Δ2, Γ ⊃ Δ1++A::B::Δ2                     -> Γ ⊃ Δ1++A∨B::Δ2
| ImpL : forall A B Γ1 Γ2 Δ, Γ1++B::Γ2 ⊃ Δ    -> Γ1++Γ2 ⊃ A::Δ   -> Γ1++A→B::Γ2 ⊃ Δ
| ImpR : forall A B Γ Δ1 Δ2, A::Γ ⊃ Δ1++B::Δ2                     -> Γ ⊃ Δ1++A→B::Δ2
| Cut  : forall A Γ Δ      , Γ ⊃ A::Δ         -> A::Γ ⊃ Δ        -> Γ ⊃ Δ
where "Γ ⊃ Δ" := (G Γ Δ) : My_scope.
(** The disjunction of a list of formulas*)
Definition BigOr := fold_right Disj ⊥.
Notation "⋁ Δ" := (BigOr Δ) (at level 19).
(** Γ ⊢⊢ Δ means that Γ ⊢ A for all A in Δ*)
Definition Ncl Γ := map_fold_right (Nc Γ) and True.
Notation "Γ ⊢⊢ Δ" := (Ncl Γ Δ) (at level 80).
Notation "¬l Γ" := (map Neg Γ) (at level 40).
(** * Theorems *)
(** Gc to Nc*)
do 3 intro;apply prov_impl.
apply ImpI;apply BotC;apply ImpE with (A ∧ B);
[is_ass|apply AndI;apply BotC;(apply ImpE with (¬A ∨ ¬B);[is_ass|])].
apply OrI1;is_ass.
apply OrI2;is_ass.
Qed.
intros;induction Δ.
trivial.
destruct H0;split.
eapply weakening2;eassumption.
apply IHΔ;apply H1.
Qed.
induction 1;intros;[induction Γ;destruct H;[subst;apply H0|apply IHΓ;[assumption|apply H0]]
|constructor 2|econstructor 3|constructor 4|constructor 5|econstructor 6
|econstructor 7|constructor 8|constructor 9|econstructor 10];try eauto;
[apply IHNc..|apply IHNc2|try apply IHNc3];
(split;[is_ass|eapply Nc_list_weakening;[|eassumption];in_solve]).
Qed.
intros;induction Δ.
exact I.
split.
constructor;apply H;in_solve.
apply IHΔ;intros;apply H;in_solve.
Qed.
intros;induction Δ1.
assumption.
destruct H;split.
assumption.
apply IHΔ1;apply H1.
Qed.
Ltac Ncl_solve := repeat match goal with
| |- _ ⊢ _     => idtac
| |- _ ⊢⊢ _::_ => split;[eassumption||(try (is_ass;fail))|]
| |- _ ⊢⊢ _++_ => apply Nc_list_app
| |- map_fold_right (Nc ?Γ) and True _ => change (map_fold_right (Nc Γ) and True) with (Ncl Γ)
| _            => eassumption||(apply Nc_list_contained;in_solve)
end.
induction 1;try rewrite map_app in *;simpl in *.
mp;[|is_ass]. constructor. apply in_app_iff;right.
change (A → ⊥) with (¬A). apply in_map;assumption.
is_ass.
eapply Nc_list_impl;[eassumption|]. Ncl_solve.
eapply AndE1;is_ass.
eapply AndE2;is_ass.
eapply OrE;[apply NegAnd_impl_OrNeg;is_ass|eapply Nc_list_impl..];
[apply IHG1| |apply IHG2|];Ncl_solve.
eapply OrE;[is_ass|eapply Nc_list_impl..];[apply IHG1| |apply IHG2|];Ncl_solve.
eapply Nc_list_impl;[eassumption|]. Ncl_solve;(apply ImpI;mp;[is_ass|]).
eapply OrI1;is_ass.
eapply OrI2;is_ass.
eapply OrE;[apply Excluded_Middle|eapply Nc_list_impl..];
[apply IHG1| |apply IHG2|Ncl_solve];Ncl_solve;mp;is_ass.
eapply Nc_list_impl;[eassumption|]. Ncl_solve.
apply BotC;mp;[|apply ImpI;apply BotC;apply ImpE with A];is_ass.
apply ImpI;mp;[|apply ImpI];is_ass.
eapply OrE;[apply Excluded_Middle|eapply Nc_list_impl..];
[apply IHG2| |apply IHG1|];Ncl_solve.
Qed.
induction Δ;simpl;intros.
rewrite app_nil_r in H;trivial.
eapply OrE.
apply Excluded_Middle.
apply OrI1;is_ass.
apply OrI2;apply IHΔ;eapply Nc_list_impl;[eassumption|Ncl_solve].
Qed.
intros;apply ConjNeg_Disj;apply G_to_Nc_Neg;assumption.
Qed.
(** Nc to Gc  The hardest part is proving weakening for Gc*)
Local Ltac temp1 := econstructor;split;reflexivity||(rewrite app_comm_cons;reflexivity).
induction l1;intros;
(destruct l3;[destruct l4|];discriminate||(injection H;intros;subst)).
right;exists [];split;reflexivity.
left;temp1.
right;temp1.
destruct (IHl1 _ H0) as [(?&?&?)|(?&?&?)];subst.
left;temp1.
right;temp1.
Qed.
intros;apply in_split_app in H as [(?&?&?)|(?&?&?)];subst.
left;econstructor;split;reflexivity.
destruct x;injection H;intros;subst.
repeat (right||split||rewrite app_nil_r||reflexivity).
right;left;econstructor;split;reflexivity.
Qed.
Ltac rew1 := repeat rewrite <- app_assoc;repeat rewrite <- app_comm_cons.
Ltac rew2 := repeat rewrite app_comm_cons;try rewrite app_assoc.
Ltac constr := constructor 3||constructor 4||constructor 5||constructor 6||constructor 7||constructor 8.
Local Ltac temp2 X Y Z :=
(rew1;constr;rew2;eapply X;rew1;reflexivity)||
(rew2;constr;rew1;eapply X;rew2;reflexivity)||
(rew1;constr;rew2;[eapply Y|eapply Z];rew1;reflexivity)||
(rew2;constr;rew1;[eapply Y|eapply Z];rew2;reflexivity).
Local Ltac temp3 H IHG IHG1 IHG2 Heql A0 := induction H;intros;subst;
try apply in_split_app in Heql as [(?&?&?)|(?&?&?)];
subst;try (temp2 IHG IHG1 IHG2;fail);[is_ass|constructor 2;in_solve|
apply Cut with A0;[try rewrite app_comm_cons|rew2];auto..].

Lemma WeakL : forall Γ1 Γ2 Δ A, Γ1++Γ2 ⊃ Δ -> Γ1++A::Γ2 ⊃ Δ.