Require Export Base.
Require Export Chapter10.

Inductive gen : context → form → Prop :=
| genV A x : Var x el A → gen A (Var x)
| genF A u : Fal el A → gen A u
| genIR A s t : gen (s::A) t → gen A (Imp s t)
| genIL A s t u : Imp s t el A → gen A s → gen (t::A) u → gen A u.

(* Fact 12.1.1 - Soundness *)

Lemma gen_nd A s :
  gen A s → nd A s.
Proof.
  induction 1; eauto using nd.
Qed.

(* Fact 12.1.2 - Weakening *)

Lemma genW A B s :
  gen A s → A <<= B → gen B s.
Proof.
  intros C; revert B.
  induction C; eauto 7 using gen.
Qed.

(* Example 12.1.3 *)

Goal ∀ x y,
   gen [Imp (Var x) (Var y)] (Imp (Var x) (Var y)).
Proof.
  intros x y. apply genIR. apply genIL with (s := Var x) (t := Var y).
  - auto.
  - apply genV. auto.
  - apply genV. auto.
Qed.

(* Fact 12.1.4 -  Assumption rule *)

Lemma genA A s :
  s el A → gen A s.
Proof.
  revert A. induction s; eauto 6 using gen.
Qed.

(* Fact 12.1.5 - Consistency *)

Lemma gen_con :
  ¬ gen nil Fal.
Proof.
  intros B. inv B; intuition.
Qed.

(* Fact 12.1.6 *)

Lemma gen_DN' A x s :
  A <<= [Var x; Not (Not (Var x))] → gen A s → s ≠ Fal ∧ s ≠ Not (Var x).
Proof.
  intros H D.
  induction D as [A y E|A v E|A s t E IHE|A s t v E F IHF G _ ].
  - split; discriminate.
  - exfalso. apply H in E. unfold In in E; intuition; discriminate.
  - split.
    + intros B. discriminate.
    + unfold Not. intros B. injection B; intros → →.
      cut (Fal ≠ Fal). auto. apply IHE. auto.
  - exfalso. apply H in E. destruct E as [E|[E|[]]]; inv E. apply IHF; auto.
Qed.

(* Fact 12.1.7 *)

Lemma gen_DN x :
  ¬ gen [Not (Not (Var x))] (Var x).
Proof.
  intros E.
  inv E; unfold In in *; intuition; try discriminate.
  inv H2. apply gen_DN' with (x:=x) in H0; intuition.
Qed.

(* Exercise 12.1.8 *)

Goal ∀ x y,
       gen [Not (Var x)] (Imp (Var x) (Var y)).
Abort.

(* Exercise 12.1.9 *)

Goal ∀ x y z,
       gen [Imp (Var x) (Var y); Imp (Var y) (Var z)] (Imp (Var x) (Var z)).
Abort.

Instance dec_form (s t: form):
  dec (s = t).
Proof.
  unfold dec. repeat decide equality.
Qed.

(* Lemma 12.2.1 - Generalized Cut *)

Lemma genC' A s B u :
  gen A s → gen B u → gen (A ++ rem B s) u.
Proof.
  intro C; revert A B u C.
  induction s as [x|s1 IHs1 s2 IHs2|]; intros A B u C D.
  - remember (Var x) as v.
    induction C as [A y E|A v E| |A t1 t2 v E F _ _ IHG];
      subst; try inv Heqv.
    + apply (genW D). auto.
    + apply genF. auto.
    + eapply genIL with (s:=t1) (t:=t2); eauto. apply (genW F). auto.
  - remember (Imp s1 s2) as v.
    induction C as [ |A v E|A t1 t2 E _|A t1 t2 v E F _ _ IHG];
      subst; try inv Heqv.
    + apply genF. auto.
    + induction D as [B y F|B u F|B t1 t2 _ IHF|B t1 t2 u F _ IHG _ IHH].
      × apply genV. assert (Var y ≠ Imp s1 s2) by congruence. auto.
      × apply genF. assert (Fal ≠ Imp s1 s2) by congruence. auto.
      × apply genIR. apply (genW IHF). auto.
      × { decide (Imp t1 t2 = Imp s1 s2) as [K|K].
          - inv K. (* Imp s1 s2 is principal formula of both derivations *)
            specialize (IHs1 _ _ _ IHG E).
            specialize (IHs2 _ _ _ IHs1 IHH).
            apply (genW IHs2).
            repeat apply incl_app; auto.
            apply rem_app'; auto.
            rewrite rem_comm. auto.
          - eapply genIL; eauto. apply (genW IHH). auto. }
    + eapply genIL; eauto. apply (genW F). auto.
  - remember Fal as v.
    induction C as [ |A v E| |A t1 t2 v E F _ _ IHG];
      subst; try inv Heqv.
    + apply (genW D). auto.
    + eapply genIL; eauto. apply (genW F). auto.
Qed.

(* Lemma 12.2.2. - Cut *)

Lemma genC A s u :
  gen A s → gen (s::A) u → gen A u.
Proof.
  intros E F. apply (genW (genC' E F)). auto.
Qed.

(* Lemma 12.2.3 - Completeness for ND *)

Lemma nd_gen A s :
  nd A s → gen A s.
Proof.
  intros D.
  induction D as [A s D|A s t _ IHD|A s t _ IHD _ IHC|A s _ IHD].
  - apply genA, D.
  - apply genIR, IHD.
  - apply (genC IHD). eapply genIL; eauto using genA.
    apply (genW IHC). auto.
  - apply (genC IHD). apply genF; auto.
Qed.

(* Corollary 12.2.4 *)

Theorem gen_iff_nd A s :
  gen A s ↔ nd A s.
Proof.
  split. apply gen_nd. apply nd_gen.
Qed.

Goal ∀ x,
  ¬ nd [Not (Not (Var x))] (Var x).
Proof.
  intros x. rewrite <- gen_iff_nd.
  now apply gen_DN.
Qed.

(* Exercise 12.2.5 *)

Goal ∀ A s u,
       gen A (Not s) → gen A s → gen A u.
Abort.

Definition sf_closed (A : context) : Prop :=
  ∀ u, u el A → match u with
                 | Imp s t ⇒ s el A ∧ t el A
                 | _ ⇒ True
               end.

Definition goal := prod (context) form.

Instance goal_eq_dec gamma delta :
  dec (gamma = delta :> goal).
Proof.
  unfold dec. repeat decide equality.
Qed.

(* Fact 12.3.1 *)

Lemma sf_closed_app A B :
  sf_closed A → sf_closed B → sf_closed (A ++ B).
Proof.
  intros E F [|s t|] G; auto.
  apply in_app_or in G as [G|G].
  - apply E in G. intuition; eauto.
  - apply F in G. intuition; eauto.
Qed.

Lemma sf_closed_cons s t A :
  s el A → t el A → sf_closed A → sf_closed (Imp s t :: A).
Proof.
  intros D E F [|s' t'|] G; auto.
  destruct G as [G|G].
  - inv G. auto.
  - apply (F _) in G. destruct G; auto.
Qed.

Fixpoint scl' (s : form) : context :=
  s :: match s with
         | Imp u v ⇒ scl' u ++ scl' v
         | _ ⇒ nil
       end.

Lemma scl'_in s :
  s el scl' s.
Proof.
  destruct s; simpl; auto.
Qed.

Lemma scl'_closed s :
  sf_closed (scl' s).
Proof.
  induction s; simpl; auto.
  - intros [] [A|A]; auto; congruence.
  - apply sf_closed_cons; auto using scl'_in, sf_closed_app.
  - intros [] [A|A]; auto; congruence.
Qed.

Fixpoint scl (A : context) : context :=
  match A with
    | nil ⇒ nil
    | s :: A' ⇒ scl' s ++ scl A'
  end.

Lemma scl_incl' A :
  A <<= scl A.
Proof.
  induction A as [|s A]; simpl; auto using scl'_in.
Qed.

Lemma scl_incl A B :
  A <<= B → A <<= scl B.
Proof.
  intros E. setoid_rewrite E. apply scl_incl'.
Qed.

Lemma scl_closed A :
  sf_closed (scl A).
Proof.
  induction A as [|s A]; simpl. now auto.
  auto using scl'_closed, sf_closed_app.
Qed.

(* You can find a definition of Finite closure iteration in the Base File. *)

Section Decidability.
  Variable A0 : context.
  Variable s0 : form.
  Definition U := scl (s0::A0).
  Definition U_sfc : sf_closed U := @scl_closed _.
  Definition Gamma := list_prod (power U) U.


  (* Fact 12.3.2 *)

  Goal ∀ A s,
         A <<= U → s el U → (rep A U, s) el Gamma.
  Proof.
    intros A s H H'.
    apply in_prod_iff. split.
    - apply rep_power.
    - assumption.
  Qed.

  Goal ∀ A s,
      A <<= U → s el U → gen A s ↔ gen (rep A U) s.
  Proof.
    intros A s H1 H2.
    split; intros H3.
    - apply genW with (A := A); [assumption|].
      now apply rep_equi.
    - apply genW with (A := rep A U); [assumption|].
      now apply rep_equi.
  Qed.


  (* Construction of 12.3.3 *)

  Definition step (Delta : list goal) (gamma : goal) : Prop :=
    let (A,u) := gamma in
    match u with
       | Var _ ⇒ u el A
       | Imp s t ⇒ (rep (s::A) U, t) el Delta
       | _ ⇒ False
    end
    ∨
    ∃ v, v el A ∧
         match v with
           | Fal ⇒ True
           | Imp s t ⇒ (A, s) el Delta ∧ (rep (t::A) U, u) el Delta
           | _ ⇒ False
          end.

  Instance step_dec Delta gamma :
    dec (step Delta gamma).
  Proof.
    destruct gamma as [A u]; simpl.
    apply or_dec.
    - destruct u as [x|s t|]; auto.
    - apply list_exists_dec. intros [x|s t|]; auto.
  Qed.

  Definition Lambda : list goal :=
    FCI.C (step := step) Gamma.

  Lemma lambda_closure gamma :
    gamma el Gamma → step Lambda gamma → gamma el Lambda.
  Proof. apply FCI.closure. Qed.

  Lemma lambda_ind (p : goal → Prop) :
    (∀ Delta gamma, inclp Delta p → gamma el Gamma → step Delta gamma → p gamma) → inclp Lambda p.
  Proof. apply FCI.ind. Qed.

  Lemma lambda_gen A u :
    (A,u) el Lambda → gen A u.
  Proof.
    revert A u.
    cut (inclp Lambda (fun gamma ⇒ gen (fst gamma) (snd gamma))).
    { intros E A u. apply E. }
    apply lambda_ind. intros Delta [A u] E F G; simpl.
    assert (E': ∀ B v, (B,v) el Delta → gen B v).
    { intros B v. apply E. }
    clear E.
    destruct G as [G|[[x|s t|] [G H]]].
    - destruct u; intuition; eauto using gen, genW, rep_incl.
    - contradiction H.
    - intuition; eauto using gen, genW, rep_incl.
    - eauto using gen.
  Qed.

  (* Lemma 12.3.4 *)

  Lemma gen_lambda A u :
    A <<= U → u el U → gen A u → (rep A U,u) el Lambda.
  Proof.
    intros D1 D2 E.
    induction E as [A x F|A u F|A s t F IHF|A s t u F G IHG H IHH];
      (apply lambda_closure; [now eauto using in_prod, rep_power|]); simpl.
    -left. auto using rep_in.
    - right. ∃ Fal. auto using rep_in.
    - apply U_sfc in D2 as [D2 D3].
      left. rewrite rep_eq with (B := s::A).
      + auto.
      + setoid_rewrite rep_equi; auto.
    - assert (K := F). apply D1 in K.
      apply U_sfc in K as [K1 K2].
      right. ∃ (Imp s t); repeat split; auto using rep_in.
      rewrite rep_eq with (B := t::A).
      + auto.
      + setoid_rewrite rep_equi; auto.
  Qed.

  (* Theorem 12.3.5 *)

  Theorem nd_dec :
    dec (nd A0 s0).
  Proof.
    apply (dec_prop_iff (gen_iff_nd _ _)).
    assert (A1: A0 <<= U).
    { apply scl_incl; auto. }
    assert (A2: s0 el U).
    { apply scl_incl'; auto. }
    apply dec_prop_iff with (X:= gen (rep A0 U) s0).
    - split; intros E; apply (genW E), rep_equi; auto.
    - decide ((rep A0 U, s0) el Lambda) as [E|E].
      + left. apply lambda_gen, E.
      + right. intros F. apply E.
        apply gen_lambda; auto.
        apply genW with (A := rep A0 U); auto.
        apply rep_equi, A1.
  Qed.

End Decidability.