Require Import Relations.
Require Import mathcomp.ssreflect.ssreflect.

Require Import Kstar_def.

Set Implicit Arguments.
Import Prenex Implicits.

History-based Gentzen system for K*

As for formulas, we need to show that the type of annotations is a countable type.

Inductive annot :=
| aAG of form * {fset clause}
| aAXG of form * {fset clause}
| aVoid.

Lemma eq_annot_dec (E1 E2 : annot) : {E1 = E2} + {E1 <> E2}.

Definition annot_eqMixin := EqMixin (compareP eq_annot_dec).
Canonical Structure annot_eqType := Eval hnf in @EqType annot annot_eqMixin.

Module Annot.
  Definition pickle A :=
    match A with
      | aAG s => (1,pickle s)
      | aAXG s => (2,pickle s)
      | aVoid => (3,0)
    end.


  Definition unpickle p :=
    match p with
      | (1,n) => obind (Some \o aAG) (unpickle n)
      | (2,n) => obind (Some \o aAXG) (unpickle n)
      | (3,_) => Some aVoid
      | _ => None
    end.

  Lemma pickleP : pcancel pickle unpickle.
End Annot.

Definition annot_countMixin := PcanCountMixin (Annot.pickleP).
Definition annot_choiceMixin := CountChoiceMixin annot_countMixin.
Canonical Structure annot_choiceType := Eval hnf in ChoiceType annot annot_choiceMixin.
Canonical Structure annot_CountType := Eval hnf in CountType annot annot_countMixin.

Implicit Types (S H : {fset clause}) (C D E : clause) (a : annot) (Ca : clause * annot).

Definition of the Rules

Inductive gen : clause * annot -> Prop :=
| gen_F C a :
    gen (fF^+ |` C, a)
| gen_p p C a :
    gen ([fset fV p^+ , fV p^- & C], a)
| gen_Ip s t C a :
    gen (s^- |` C, a) -> gen (t^+ |` C, a) -> gen (fImp s t^+ |` C, a)
| gen_In s t C a :
    gen ([fset s^+ , t^- & C], a) -> gen (fImp s t^- |` C, a)
| gen_AXn s C a :
    gen (s^- |` R C, aVoid) -> gen (fAX s^- |` C , a)
| gen_AXH s C H :
    gen (R C,aAG (s,H)) -> gen (C,aAXG (s,H))
| gen_AGp s C a :
    gen ([fset s^+ , fAX (fAG s)^+ & C],a ) -> gen (fAG s^+ |` C,a)
| gen_AGn s C a :
    gen (s^- |` C, a) -> gen (fAX (fAG s)^- |` C,a) -> gen (fAG s^- |` C, a)
| gen_foc s C :
    gen (C,aAXG (s,fset0)) -> gen (fAX (fAG s)^- |` C,aVoid)
| gen_AGh s C H :
    gen (s^- |` C, aVoid) -> gen (C, aAXG (s,C |` H))-> gen (C,aAG (s,H))
| gen_rep s C H :
    gen (C, aAG(s,C |` H))
.

Soundness for Finite Models


Definition satC (M : fmodel) (w:M) C := [all s in C, evalb (interp s) w].

Lemma satCU (M : fmodel) (w:M) C D : satC w (C `|` D) = satC w C && satC w D.

Lemma satC1 (M : fmodel) (w:M) s D : satC w (s |` D) = evalb (interp s) w && satC w D.

Definition dsatH (M : fmodel) (w:M) H := [all C in H, ~~ satC w C].

Lemma dsat0 (M : fmodel) (w:M) : dsatH w fset0.

Lemma dsatU1 (M : fmodel) (w:M) H C : dsatH w (C |` H) = ~~ satC w C && dsatH w H.

Inductive hist (M: fmodel) H s (w:M) : Prop :=
| hist0 : dsatH w H -> ~~ evalb s w -> hist H s w
| histS v : dsatH w H -> ftrans w v -> hist H s v -> hist H s w.

Lemma hist_dsatH (M: fmodel) H s (w:M) : hist H s w -> dsatH w H.

Definition satA (M: fmodel) (w:M) a :=
  match a with
  | aAG (s,H) => hist H s w
  | aAXG (s,H) => exists2 v, ftrans w v & hist H s v
  | aVoid => True
  end.

Lemma sat_hist0 (M : fmodel) (w : M) s : ~~ evalb (fAG s) w -> hist fset0 s w.

Definition satCA (M : fmodel) (w : M) Ca := satC w Ca.1 /\ satA w Ca.2.

Definition funsat (M : fmodel) Ca := ~ exists w:M, satCA w Ca.

Lemma funsat2 (M : fmodel) C C1 C2 a : (forall w:M, satC w C -> satC w C1 || satC w C2) ->
  funsat M (C1,a) -> funsat M (C2,a) -> funsat M (C,a).

Lemma funsat1 (M : fmodel) C C1 a : (forall w:M, satC w C -> satC w C1) ->
  funsat M (C1,a) -> funsat M (C,a).

Lemma satU1P (M : fmodel) (w : M) s C : reflect (evalb (interp s) w /\ satC w C) (satC w (s |` C)).

Lemma satCR (M : fmodel) (w v : M) C : satC w C -> ftrans w v -> satC v (R C).

Lemma evalbAG (M : fmodel) (w : M) s : evalb (fAG s) w = (evalb s w && evalb (fAX (fAG s)) w).

Lemma soundness (M : fmodel) Ca : gen Ca -> funsat M Ca.