Require Import mathcomp.ssreflect.ssreflect.
Require Import K_def demo gentzen.

Set Implicit Arguments.
Import Prenex Implicits.

Construction of a Universal Model


Implicit Types (C D : clause).

Hint Resolve closed_sfc.

Lemma gen_decP C : reflect (gen C) (gen_dec C).

Lemma gen_lcons C : ~~ gen_dec C -> lcons C.

Every underivable clause is supported by an underivable clause

Lemma genN_supp C : ~~ gen_dec C -> exists2 D:clause, suppC D C & ~~ gen_dec D.

Lemma sat_cons (M : cmodel) (w : M) C : (forall s, s \in C -> eval (interp s) w) -> ~~ gen_dec C.

Section UniversalModel.
  Record dmodel := DM { dstate :> choiceType ;
                        dtrans : dstate -> dstate -> bool;
                        dlabel : var -> pred dstate;
                        dbound : dstate -> {fset dstate};
                        dtransP x y : dtrans x y -> y \in dbound x
                      }.

  Fixpoint evald (M : dmodel) s : pred M :=
      match s with
      | fV p => dlabel p
      | fF => xpred0
      | fImp s t => fun w => evald s w ==> evald t w
      | fAX s => fun w => [all v in dbound w, dtrans w v ==> evald s v]
      end.

  Definition ts_of_dmodel (M : dmodel) : ts :=
    {| state := dstate M;
       trans := @dtrans M ;
       label p x := @dlabel M p x |}.

  Lemma evaldP (M : dmodel) (x:M) s : reflect (@eval (ts_of_dmodel M) s x) (evald s x).

  Lemma dmodelP (M : dmodel) : ldec (@eval (ts_of_dmodel M)).

  Definition model_of_dmodel (M : dmodel) : cmodel := CModel (@dmodelP M).

  Definition UMType := { C : clause | ~~ gen_dec C }.
  Definition UMLabel (p:var) (C : UMType) := fV p^+ \in val C.

  Lemma UM_default_proof : ~~ gen_dec fset0.

  Definition UM_default : UMType := Sub fset0 UM_default_proof.

  Lemma UMP s1 s2 C : s1 \in C -> ~~ gen_dec C -> s1 = fAX s2^- ->
     exists x:UMType, suppC (val x) (s2^- |` R C).

  Definition UM_select (u : sform) (x:UMType) : UMType :=
    (if u \in val x as b return u \in val x = b -> UMType
     then fun b =>
            (if u is fAX s^- as c return u = c -> UMType
             then fun e => (xchoose (UMP b (valP x) e))
             else fun _ => UM_default) erefl
     else fun _ => UM_default) erefl.

  Lemma UM_select_correct (u : sform) (x : UMType) :
    u \in val x -> isDia u -> suppC (val (UM_select u x)) (body u |` R (val x)).

  Definition UM_trans (x y : UMType) := [some u in val x, isDia u && (y == UM_select u x)].

  Definition UM_bound (x : UMType) := [fset UM_select u x | u <- [fset v in val x | isDia v]].

  Lemma UM_trans_bound x y : UM_trans x y -> y \in UM_bound x.

  Definition UMd := DM UMLabel UM_trans_bound.

  Definition UM : cmodel := model_of_dmodel UMd.

  Lemma UM_trans_R (x y : UM) : trans x y -> suppC (val y) (R (val x)).

  Lemma UM_trans_D (x : UM) s : fAX s^- \in val x -> exists2 y : UM, trans x y & val y |> s^-.

  Lemma supp_eval s (x : UM) : val x |> s -> eval (interp s) x.

  Theorem UM_universal s :
    (exists (M:cmodel) (w:M), eval s w) -> (exists (x:UM), eval s x).
End UniversalModel.