Require Import Relations.
Require Import mathcomp.ssreflect.ssreflect.
Require Import Kstar_def.
Set Implicit Arguments.
Import Prenex Implicits.
Require Import mathcomp.ssreflect.ssreflect.
Require Import Kstar_def.
Set Implicit Arguments.
Import Prenex Implicits.
History-based Gentzen system for K*
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))
.
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.