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

Set Implicit Arguments.
Import Prenex Implicits.

K* in Coq


Notation "P =p Q" := (forall x, P x <-> Q x) (at level 40).
Definition PredC X (p : X -> Prop) x := ~ p x.


Section Characterizations.

Inductive Characterizations


  Variables (X : Type) (e : X -> X -> Prop).

  Definition cEX (p : X -> Prop) (w : X) : Prop := exists2 v, e w v & p v.
  Definition cAX (p : X -> Prop) (w : X) : Prop := forall v, e w v -> p v.

  CoInductive cAG (p : X -> Prop) (w : X) : Prop :=
  | AGs : p w -> (forall v, e w v -> cAG p v) -> cAG p w.

The coinductive definiton of AG is equivalent to the standard defintion using reflexive transitive closure.

  Fact cAG_crt p w :
    cAG p w <-> forall v, clos_refl_trans e w v -> p v.

  Inductive cEF (p : X -> Prop) (w : X) : Prop :=
  | EF0 : p w -> cEF p w
  | EFs v : e w v -> cEF p v -> cEF p w.

  Lemma cAG_cEF (p : X -> Prop) (w : X) :
    cEF (PredC p) w -> ~ cAG p w.

Strengthening Lemmas

  Lemma AG_strengthen (p1 p2 : X -> Prop) w :
    (forall v, p1 v -> p2 v) -> cAG p1 w -> cAG p2 w.

  Lemma EF_strengthen (p1 p2 : X -> Prop) w :
    (forall v, p1 v -> p2 v) -> cEF p1 w -> cEF p2 w.

End Characterizations.

Formulas


Definition var := nat.

Inductive form :=
| fF
| fV of var
| fImp of form & form
| fAX of form
| fAG of form.

Lemma eq_form_dec (s t : form) : { s = t} + { s <> t}.

Definition form_eqMixin := EqMixin (compareP eq_form_dec).
Canonical Structure form_eqType := Eval hnf in @EqType form form_eqMixin.

To use formulas and other types built around formulas as base type for the finite set libaray, we need to show that formulas are countable. We do this by embedding formulas into the Ssreflect's generic trees

Module formChoice.
  Import GenTree.

  Fixpoint pickle (s : form) :=
    match s with
      | fV v => Leaf v
      | fF => Node 0 [::]
      | fImp s t => Node 1 [:: pickle s ; pickle t]
      | fAX s => Node 2 [:: pickle s]
      | fAG s => Node 3 [:: pickle s]
    end.

  Fixpoint unpickle t :=
    match t with
      | Leaf v => Some (fV v)
      | Node 0 [::] => Some (fF)
      | Node 1 [:: t ; t' ] =>
          obind (fun s => obind (fun s' => Some (fImp s s')) (unpickle t')) (unpickle t)
      | Node 2 [:: t ] => obind (fun s => Some (fAX s)) (unpickle t)
      | Node 3 [:: t ] => obind (fun s => Some (fAG s)) (unpickle t)
      | _ => None
    end.

  Lemma pickleP : pcancel pickle unpickle.
End formChoice.

Definition form_countMixin := PcanCountMixin formChoice.pickleP.
Definition form_choiceMixin := CountChoiceMixin form_countMixin.
Canonical Structure form_ChoiceType := Eval hnf in ChoiceType form form_choiceMixin.
Canonical Structure form_CountType := Eval hnf in CountType form form_countMixin.

Models

We distinguish thee classes of models
  • raw models or transition systems (ts): The inductive satisfaction relation eval is defined on this class
  • finite models (fmodel): models where the type of states is finite and everything else is decidable
  • classical models, i.e., models where eval is logically decidable (cmodel): This is the largest class of models for which we can show soundness of the hilbert system.

Definition stable X Y (R : X -> Y -> Prop) := forall x y, ~ ~ R x y -> R x y.
Definition ldec X Y (R : X -> Y -> Prop) := forall x y, R x y \/ ~ R x y.

Record ts := TS {
  state :> Type;
  trans : state -> state -> Prop;
  label : var -> state -> Prop
}.

Record fmodel := FModel {
  fstate :> finType;
  ftrans : rel fstate;
  flabel : var -> pred fstate
}.

Make ts inferable for states of fmodels
Canonical ts_of_fmodel (M : fmodel) : ts := TS (@ftrans M) (@flabel M).
Coercion ts_of_fmodel : fmodel >-> ts.

Fixpoint eval (M:ts) (s : form) :=
  match s with
    | fF => (fun _ => False)
    | fV v => label v
    | fImp s t => (fun w => eval M s w -> eval M t w)
    | fAX s => cAX (@trans M) (eval M s)
    | fAG s => cAG trans (eval M s)
  end.

Record cmodel := CModel { sts_of :> ts; modelP : ldec (@eval sts_of) }.

Hilbert System


Section Hilbert.

  Inductive prv : form -> Prop :=
  | rMP s t : prv (s ---> t) -> prv s -> prv t
  | axK s t : prv (s ---> t ---> s)
  | axS s t u : prv ((u ---> s ---> t) ---> (u ---> s) ---> u ---> t)
  | axDN s : prv (((s ---> fF) ---> fF) ---> s)
  | rNec s : prv s -> prv (fAX s)
  | axN s t : prv (fAX (s ---> t) ---> fAX s ---> fAX t)

  | axAGEl s : prv (fAG s ---> s)
  | axAGEr s : prv (fAG s ---> fAX (fAG s))
  | rAG_ind u s : prv (u ---> fAX u) -> prv (u ---> s) -> prv (u --->fAG s)
  .

The hilbert system for K* can be seen as the composition of Hilbert systems for minimal logic (M), classical propositional logic (P), basic modal logic (K) and the rules and axioms specific to K*

  Canonical Structure prv_mSystem := MSystem rMP axK axS.
  Canonical Structure prv_pSystem := PSystem axDN.
  Canonical Structure prv_kSystem := KSystem rNec axN.
  Canonical Structure prv_ksSystem := KSSystem axAGEl axAGEr rAG_ind.

  Definition valid s := forall (M:cmodel) (w:M), eval s w.

Soundness

The Hilbert System is sound for classical models.

  Lemma soundness s : prv s -> forall (M:cmodel) (w:M), eval s w.

With excluded middle, every model is a classical model, and the Hilbert system is sound for all models

  Lemma xm_soundness (xm : forall P, P \/ ~ P) s :
    prv s -> forall (M : ts) (w : M), eval s w.

End Hilbert.

Equivalence to Segerberg style Hilbert system


Module S.
Section Seg.

  Inductive prv : form -> Prop :=
  | rMP s t : prv (s ---> t) -> prv s -> prv t
  | axK s t : prv (s ---> t ---> s)
  | axS s t u : prv ((u ---> s ---> t) ---> (u ---> s) ---> u ---> t)
  | axDN s : prv (((s ---> fF) ---> fF) ---> s)
  | rNec s : prv s -> prv (fAX s)
  | axN s t : prv (fAX (s ---> t) ---> fAX s ---> fAX t)

  | axAGEl s : prv (fAG s ---> s)
  | axAGEr s : prv (fAG s ---> fAX (fAG s))

  | axSeg s : prv (fAG (s ---> fAX s) ---> s ---> fAG s)
  | axNS s t : prv (fAG (s ---> t) ---> fAG s ---> fAG t)
  | rNecS s : prv s -> prv (fAG s)
  .

End Seg.
End S.

Ltac S_rule H :=
  first [ eapply S.rMP; first eapply H | eapply S.rMP; first eapply S.rMP; first eapply H ].

Fact prv_Sprv s : prv s <-> S.prv s.

Soundness for Finite Models

A model is finite, if the underlying type of states is a finite type. We show that the Hilbert system is sound for finite models. For this we show that eval is decidable on finite models. For this we need to evaluate the evanutalities. This requires a boolean reflection of AG which we obtain using a fixpoint computation

Section DecidabilityAndAgreement.
  Variables (T: finType) (e : rel T) (p : pred T).

  Definition AG_fun (X : {set T}) := [set x | p x && [forall (y | e x y), y \in X]].

  Lemma AR_mono : mono AG_fun.

  Definition AGb w := w \in gfp AG_fun.

  Lemma agP w : reflect (cAG e p w) (AGb w).

End DecidabilityAndAgreement.


Given decidability and correctness for AG, decidavility and correctness of evalb follows using a simple induction on formulas

Section FiniteModels.
  Variables (M : fmodel).

  Fixpoint evalb s : pred M :=
    match s with
    | fV p => flabel p
    | fF => xpred0
    | fImp s t => fun w => evalb s w ==> evalb t w
    | fAX s => fun w => [forall (v | ftrans w v) , evalb s v]
    | fAG s => AGb ftrans (evalb s)
  end.

  Lemma evalP (w:M) s : reflect (@eval M s w) (evalb s w).

  Lemma fin_modelP : ldec (@eval M).

End FiniteModels.

Every finite decidable model is a clasical model. Therefore, the Hilberst system is sound for finite decidable models.

Definition cmodel_of_fmodel (M : fmodel) := CModel (@fin_modelP M).
Coercion cmodel_of_fmodel : fmodel >-> cmodel.

Theorem finite_soundness s : prv s -> forall (M:fmodel) (w : M), eval s w.

Clauses and Support

Signed Formulas

Our decision methods for CTL employ signed formulas. we also define a number of inversion lemmas and other useful constructiuons

Definition sform := (form * bool) %type.
Notation "s ^-" := (s,false) (at level 20, format "s ^-").
Notation "s ^+" := (s,true) (at level 20, format "s ^+").

Definition body s := match s with fAX t^+ => t^+ | fAX t^- => t^- | _ => s end.

Definition positive (s:sform) := if s is t^+ then true else false.
Definition positives C := [fset s.1 | s <- [fset t in C | positive t]].

Lemma posE C s : (s \in positives C) = (s^+ \in C).

Definition negative (s:sform) := ~~ positive s.
Definition negatives C := [fset s.1 | s <- [fset t in C | negative t]].

Lemma negE C s : (s \in negatives C) = (s^- \in C).

Definition isBox s := if s is fAX s^+ then true else false.

Inductive isBox_spec s : bool -> Type :=
| isBox_true t : s = fAX t^+ -> isBox_spec s true
| isBox_false : isBox_spec s false.

Lemma isBoxP s : isBox_spec s (isBox s).

Definition isDia s := if s is fAX s^- then true else false.

Inductive isDia_spec s : bool -> Type :=
| isDia_true t : s = fAX t^- -> isDia_spec s true
| isDia_false : isDia_spec s false.

Lemma isDiaP s : isDia_spec s (isDia s).

Clauses and Support


Definition clause := {fset sform}.

Definition lcons (L : clause) :=
  (fF^+ \notin L) && [all s in L, if s is fV p^+ then fV p^- \notin L else true].

Fixpoint literal (s : sform) :=
  let: (t,_) := s in
  match t with
    | fV _ => true
    | fAX _ => true
    | fF => true
    | _ => false
  end.

Fixpoint supp (L : clause) u b :=
    match u,b with
      | fImp s t,true => supp L s false || supp L t true
      | fImp s t,false => supp L s true && supp L t false
      | fAG s,true => supp L s true && ((fAX (fAG s),true) \in L)
      | fAG s,false => supp L s false || ((fAX (fAG s),false) \in L)
      | _,_ => (u,b) \in L
    end.

Notation "C |> s ^ b" := (supp C s b) (at level 30, format "C |> s ^ b").
Notation "C |> s ^+" := (supp C s true) (at level 30, format "C |> s ^+").
Notation "C |> s ^-" := (supp C s false) (at level 30, format "C |> s ^-").
Notation "C |> s" := (supp C s.1 s.2) (at level 30).

Would like to use Definition supp' L (s : sform) := let: (t,b) := s in supp L t b. Notation "L |> t" := (supp' L t) (at level 30) However, simplification then breaks the notation
For a locally consistent clause L, the collection of formulas supported by L corresponds to an (infinite) Hintikka set.

Lemma supp_mon L1 L2 s : L1 `<=` L2 -> L1 |> s -> L2 |> s.

Fixpoint f_weight (s : form) :=
  match s with
    | fImp s t => (f_weight s + f_weight t).+1
    | fAG s => (f_weight s).+1
    | _ => 0
  end.

Lemma sweight_lit s : f_weight s.1 = 0 <-> literal s.

Lemma supp_lit C s b : literal (s,b) -> supp C s b = ((s,b) \in C).

Definition form_slClass := SLClass supp_mon supp_lit sweight_lit.
Canonical Structure form_slType := SLType form_slClass.
Canonical Structure form_slpType := @SLPType prv_pSystem form_slClass.

Want suppC on singletons to expose the concrete support operation, not the abstract one
Lemma suppC1 L s : suppC L [fset s] = L |> s.

Request


Definition R C := [fset body s | s <- [fset t in C | isBox t]].

Lemma RE C s : (s^+ \in R C) = (fAX s^+ \in C).

Lemma Rpos s C : s^- \notin R C.

Lemma RU (C C' : clause) : R (C `|` C') = (R C `|` R C').

Lemma R1 (s : sform) : R [fset s] = if s is fAX u^+ then [fset u^+] else fset0.

Lemma R0 : R fset0 = fset0.

Subformula Closure


Fixpoint ssub' b s :=
  (s,b) |` match s with
             | fImp s t => ssub' (negb b) s `|` ssub' b t
             | fAX t => ssub' b t
             | fAG s => (fAX (fAG s),b) |` ssub' b s
             | _ => fset0
           end.

Lemma ssub'_refl s b : (s,b) \in ssub' b s.

Definition ssub (s : sform) := let (t,b) := s in (ssub' b t).

Lemma ssub_refl s : s \in ssub s.

Definition sf_closed' (F : {fset sform}) (s:sform) :=
  match s with
    | (fImp s t,b) => ((s,negb b) \in F) && ((t,b) \in F)
    | (fAX s, b) => (s,b) \in F
    | (fAG s, b) => [&& (fAX (fAG s),b) \in F & (s,b) \in F]
    | _ => true
  end.

Definition sf_closed (F :{fset sform}) := forall s, s \in F -> sf_closed' F s.

Lemma sf_closed'_mon (X Y : clause) s : sf_closed' X s -> X `<=` Y -> sf_closed' Y s.

Lemma sf_ssub F s : sf_closed F -> s \in F -> ssub s `<=` F.

Lemma sfc_ssub s : sf_closed (ssub s).

Lemma sfcU (X Y : {fset sform}) : sf_closed X -> sf_closed Y -> sf_closed (X `|` Y).

Definition sfc C : clause := \bigcup_(s in C) ssub s.

Lemma sfc_bigcup (T : choiceType) (C : {fset T}) F :
  (forall s, sf_closed (F s)) -> sf_closed (\bigcup_(s in C) F s).

Lemma closed_sfc C : sf_closed (sfc C).

Lemma sub_sfc C : C `<=` (sfc C).

Lemma RinU (F : clause) : sf_closed F ->
  forall C, C \in powerset F -> R C \in powerset F.

Associtated Formuals


Lemma satA (M:cmodel) (w:M) (C:clause) :
  (forall s, s \in C -> eval (interp s) w) <-> eval [af C] w.

Lemma box_request (C : clause) : prv ([af C] ---> AX [af R C]).

Fixpoint f_size (s : form) :=
  match s with
    | fF => 1
    | fV p => 1
    | fImp s t => (f_size s + f_size t).+1
    | fAX s => (f_size s).+1
    | fAG s => (f_size s).+1
  end.

Require Import Omega.

Lemma size_ssub (s : form) (b : bool) : size (ssub (s,b)) <= 2 * f_size s.