Library strong_bisim

Require Import base.
Require Import prelim.
Require Import prop_logic.
Require Import logic.

Section lts.
  Context {Obs:ObservationSystem}.

  Record LTS :=
    { state : Type
    ; steps : state -> O -> state -> Prop
    }.

  Section bisim.
    Variables X Y:LTS.

    Definition bisimulation (R:state X -> state Y -> Prop) :=
      forall x y, R x y ->
        (forall o x', steps X x o x' ->
          exists y', steps Y y o y' /\ R x' y') /\
        (forall o y', steps Y y o y' ->
          exists x', steps X x o x' /\ R x' y').

    Definition bisimilar x y :=
      exists R, bisimulation R /\ R x y.

    Lemma bisimilar_bisimulation : bisimulation bisimilar.
  End bisim.

  Lemma eq_bisimulation X : bisimulation X X eq.

  Lemma compose_bisimulation : forall X Y Z R1 R2,
    bisimulation X Y R1 ->
    bisimulation Y Z R2 ->
    bisimulation X Z (fun x z => exists y, R1 x y /\ R2 y z).

  Lemma inv_bisimulation : forall X Y R,
    bisimulation X Y R ->
    bisimulation Y X (fun y x => R x y).

  Lemma bisimilar_refl : forall X x,
    bisimilar X X x x.

  Lemma bisimilar_sym : forall X Y x y,
    bisimilar X Y x y ->
    bisimilar Y X y x.

  Lemma bisimilar_trans : forall X Y Z x y z,
    bisimilar X Y x y ->
    bisimilar Y Z y z ->
    bisimilar X Z x z.

  Record world :=
    { sys : LTS
    ; root : state sys
    }.

  Definition equiv (x y:world) :=
    bisimilar (sys x) (sys y) (root x) (root y).

  Lemma equiv_refl : forall x, equiv x x.

  Lemma equiv_sym : forall x y,
    equiv x y -> equiv y x.

  Lemma equiv_trans : forall x y z,
    equiv x y -> equiv y z -> equiv x z.

  Inductive world_step : world -> O -> world -> Prop :=
  | intro_world_step : forall X x o x',
       steps X x o x' ->
       world_step (Build_world X x) o (Build_world X x').

  Inductive mode :=
    | box : O -> mode
    | dia : O -> mode.

  Definition interp_sb_mode (m:mode) (P:world -> Prop) (w:world) : Prop :=
    match m with
    | box o => forall w', world_step w o w' -> P w'
    | dia o => exists w', world_step w o w' /\ P w'
    end.

  Program Instance strong_bisim_logic_input : LOGIC_INPUT :=
  {| world := world
   ; accessable := equiv
   ; atom := Empty_set
   ; mode := mode
   ; interp_atom a := match a with end
   ; interp_mode := interp_sb_mode
   |}.

  Definition image_finite (Y:LTS) :=
    forall y o, exists l,
      forall y', steps Y y o y' <-> In y' l.

  Section adequacy.
    Import PropLogic.

    Context {Classic:EM}.

    Variable X:LTS.
    Variable Y:LTS.

    Hypothesis HfinX : image_finite X.
    Hypothesis HfinY : image_finite Y.

    Let R (x:state X) (y:state Y) :=
      forall f, interp f (Build_world X x) ->
                interp f (Build_world Y y).

    Lemma adequate_bisimulation : bisimulation X Y R.
  End adequacy.

  Theorem prop_soundness : forall x y,
    equiv x y ->
    (forall f, PropLogic.interp f x <-> PropLogic.interp f y).

  Theorem adequacy {Classic:EM} : forall x y,
    image_finite (sys x) ->
    image_finite (sys y) ->
    (forall f, PropLogic.interp f x -> PropLogic.interp f y) ->
    equiv x y.

  Section mucalc.
    Import MuCalc.

    Section characteristic.

    Variable X:LTS.

    Let E1 := extend emptyE (arr (state X) o).

    Definition CF_body (x:state X) (ob:O) : formula emptyE E1 o :=
      f_and
        (conj' (fun x':{ x' | steps X x ob x' } =>
          modality _ _ o (dia ob) (app (var emptyE E1 None) (proj1_sig x'))))
        (modality _ _ o (box ob) (disj' (fun x':{ x' | steps X x ob x'} =>
          app (var emptyE E1 None) (proj1_sig x')))).

    Definition CF_main : formula _ _ (arr (state X) o) :=
      nu _ _ (arr (state X) o) (lam emptyE E1 (state X) o (fun x =>
        conj' (fun ob => CF_body x ob))).

    Lemma characteristic_self : forall x,
      interp_cformula _ CF_main (x,tt) (Build_world X x).

    Lemma characteristic_other : forall x w,
      interp_cformula _ CF_main (x,tt) w ->
      equiv (Build_world X x) w.

    End characteristic.

    Definition CF (w:world) : cformula o :=
      app (CF_main (sys w)) (root w).

    Theorem CF_is_characteristic : characteristic_formula CF.
  End mucalc.

End lts.