Library lts_ref

Require Import base.
Require Import prelim.

Module LTS_REF.
Section lts_ref. Context {Obs:ObservationSystem}.

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

  Definition lstate X := lift (state X).

  Definition must_step (X:LTS) (s:lstate X) o (s':lstate X) :=
    exists s_, contains s s_ /\ steps X s_ o s'.

  Definition may_step (X:LTS) (s:lstate X) o (s':lstate X) :=
    (forall s_, contains s s_ -> steps X s_ o s') /\
    (forall s'_, contains s' s'_ -> exists s_, contains s s_).

  Lemma must_may_step : forall X s o s',
    must_step X s o s' ->
    may_step X s o s'.

  Lemma may_step_step : forall A a o a',
    may_step A (into a) o a' ->
    steps A a o a'.

  Hint Resolve must_may_step.

  Definition void_lts : LTS := Build_LTS Empty_set (fun _ _ _ => False).

  Definition lts_halt L x :=
    forall o x', steps L x o x' -> False.

  Definition internally_deterministic (L:LTS) :=
    forall s o s1 s2,
      steps L s o s1 ->
      steps L s o s2 ->
      s1 = s2.

  Section SOS.

    Record SOS :=
    { sos_state : Type
    ; sos_step : sos_state -> option O -> sos_state -> Prop
    ; sos_halt : sos_state -> option O -> Prop

    ; sos_halt_dec : forall s o, sos_halt s o \/ ~sos_halt s o

    ; sos_halt_no_step : forall s o,
        sos_halt s o -> forall s', sos_step s o s' -> False
          
    ; sos_determ : forall s o s1 s2,
        sos_step s o s1 ->
        sos_step s o s2 ->
        s1 = s2
    }.

    Definition sos_irreducable S s o :=
      ~exists s', sos_step S s o s'.

    Definition sos_stuck S s o :=
      sos_irreducable S s o /\ ~sos_halt S s o.

    Definition SOS_to_LTS (S:SOS) : LTS :=
      {| state := sos_state S
       ; steps s o s' :=
           ~sos_halt S s o /\
           forall s_, contains s' s_ <->
                      sos_step S s o s_
       |}.

    Lemma SOS_to_LTS_deterministic : forall SOS,
      internally_deterministic (SOS_to_LTS SOS).

    Lemma SOS_decide {Classic:EM} : forall S s o,
      sos_halt S s o \/
      sos_stuck S s o \/
      exists s', sos_step S s o s'.

    Lemma SOS_to_LTS_halt_correct : forall S s o,
      sos_halt S s o <-> ~exists s', steps (SOS_to_LTS S) s o s'.

    Lemma SOS_to_LTS_step_correct : forall S s o s',
      sos_step S s o s' <-> steps (SOS_to_LTS S) s o (into s').

    Lemma SOS_to_LTS_crash_correct : forall S s o,
      sos_stuck S s o <-> steps (SOS_to_LTS S) s o (mho _).
  End SOS.

  Definition must_step_star (X:LTS) :=
    clos_refl_trans (lstate X) (fun s s' => must_step X s None s').

  Definition may_step_star (X:LTS) :=
    clos_refl_trans (lstate X) (fun s s' => may_step X s None s').

  Definition must_step_plus (X:LTS) :=
    clos_trans (lstate X) (fun s s' => must_step X s None s').

  Definition may_step_plus (X:LTS) :=
    clos_trans (lstate X) (fun s s' => may_step X s None s').

  Lemma must_may_step_star : forall X x y,
    must_step_star X x y ->
    may_step_star X x y.

  Definition weak_must_step (X:LTS) (x:lstate X) (o:option O) (x':lstate X) :=
    match o with
    | Some o =>
       exists q1, exists q2,
         must_step_star X x q1 /\
         must_step X q1 (Some o) q2 /\
         must_step_star X q2 x'
    | None =>
         must_step_star X x x'
    end.

  Definition weak_may_step (X:LTS) (x:lstate X) (o:option O) (x':lstate X) :=
    match o with
    | Some o =>
       exists q1, exists q2,
         may_step_star X x q1 /\
         may_step X q1 (Some o) q2 /\
         may_step_star X q2 x'
    | None =>
         may_step_star X x x'
    end.

  Lemma may_must_step : forall X x a x' x_,
    may_step X x a x' ->
    contains x' x_ ->
    must_step X x a x'.

  Lemma may_must_step_star : forall X x x',
    may_step_star X x x' ->
    (exists x_, contains x' x_) ->
    must_step_star X x x'.

  Definition must_divergence_set X (D:lstate X -> Prop) :=
    forall x, D x -> exists x', must_step X x None x' /\ D x'.

  Definition may_divergence_set X (D:lstate X -> Prop) :=
    forall x, D x -> exists x', may_step X x None x' /\ D x'.

  Definition must_diverge X (P:lstate X -> Prop) x :=
    exists D, must_divergence_set X D /\ (forall x, D x -> P x) /\ D x.

  Definition may_diverge X (P:lstate X -> Prop) x :=
    exists D, may_divergence_set X D /\ (forall x, D x -> P x) /\ D x.

  Definition must_convergence_set X (P:lstate X -> Prop) (C:lstate X -> Prop) :=
    forall x,
      (P x \/ forall x', must_step X x None x' -> C x') -> C x.

  Definition may_convergence_set X (P:lstate X -> Prop) (C:lstate X -> Prop) :=
    forall x,
      (P x \/ forall x', may_step X x None x' -> C x') -> C x.

  Definition must_converge X (P:lstate X -> Prop) x :=
    forall C, must_convergence_set X P C -> C x.

  Definition may_converge X (P:lstate X -> Prop) x :=
    forall C, may_convergence_set X P C -> C x.

  Lemma may_divergence_convergence_dual {Classic:EM} : forall X P x,
    may_converge X P x <-> ~may_diverge X (fun x => ~P x) x.

  Lemma must_divergence_convergence_dual {Classic:EM} : forall X P x,
    must_converge X P x <-> ~must_diverge X (fun x => ~P x) x.


  Definition transition_diagram :=
    forall (X Y:LTS) (R:lstate X -> lstate Y -> Prop), lstate X -> lstate Y -> Prop.

  Definition td_and (T1 T2:transition_diagram) : transition_diagram :=
    fun X Y R x y => T1 X Y R x y /\ T2 X Y R x y.

  Definition refinement (T:transition_diagram) X Y (R:lstate X -> lstate Y -> Prop) :=
    forall x y, R x y -> T X Y R x y.

  Definition bisimulation (T:transition_diagram) X Y (R:lstate X -> lstate Y -> Prop) :=
    forall x y, R x y ->
      T X Y R x y /\ T Y X (inv R) y x.

  Definition refines T X Y x y :=
    exists R, refinement T X Y R /\ R x y.

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

  Lemma ref_bisim : forall T X Y R,
    refinement T X Y R ->
    refinement T Y X (inv R) ->
    bisimulation T X Y R.

  Lemma inv_bisimulation : forall T X Y R,
    bisimulation T X Y R ->
    bisimulation T Y X (inv R).

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

  Lemma inv_bisimilar : forall T X Y,
    inv (bisimilar T X Y) = bisimilar T Y X.

  Lemma refinement_and : forall T1 T2 X Y R,
    refinement T1 X Y R ->
    refinement T2 X Y R ->
    refinement (td_and T1 T2) X Y R.

  Lemma and_refinement : forall T1 T2 X Y R,
    refinement (td_and T1 T2) X Y R ->
    refinement T1 X Y R /\ refinement T2 X Y R.

  Lemma bisimulation_and : forall T1 T2 X Y R,
    bisimulation T1 X Y R ->
    bisimulation T2 X Y R ->
    bisimulation (td_and T1 T2) X Y R.

  Lemma and_bisimulation : forall T1 T2 X Y R,
    bisimulation (td_and T1 T2) X Y R ->
    bisimulation T1 X Y R /\ bisimulation T2 X Y R.

  Record process :=
    { sys : LTS
    ; root : lstate sys
    }.

  Definition accessible T (w1 w2:process) :=
    refines T (sys w1) (sys w2) (root w1) (root w2).

  Definition equiv T (w1 w2:process) :=
    bisimilar T (sys w1) (sys w2) (root w1) (root w2).


  Definition prerun X := list (lstate X * option O).

  Fixpoint good_prerun X (pr:prerun X) (z:lstate X) {struct pr} : Prop :=
    match pr with
    | nil => True
    | (x,a)::pr' => may_step X x a z /\ good_prerun X pr' x
    end.

  Record run X :=
    { curr : lstate X
    ; prev : prerun X
    ; good_run : good_prerun X prev curr
    }.
  Global Implicit Arguments curr.
  Global Implicit Arguments prev.

  Lemma run_ext : forall X (x1 x2:run X),
    curr x1 = curr x2 -> prev x1 = prev x2 -> x1 = x2.

  Definition run_transition_diagram :=
    forall (X Y:LTS) (R:run X -> run Y -> Prop), run X -> run Y -> Prop.

  Definition rtd_and (T1 T2:run_transition_diagram) : run_transition_diagram :=
    fun X Y R x y => T1 X Y R x y /\ T2 X Y R x y.

  Definition run_refinement (T:run_transition_diagram) X Y (R:run X -> run Y -> Prop) :=
    forall x y, R x y -> T X Y R x y.

  Definition run_bisimulation (T:run_transition_diagram) X Y (R:run X -> run Y -> Prop) :=
    forall x y, R x y ->
      T X Y R x y /\ T Y X (inv R) y x.

  Definition run_refines T X Y x y :=
    exists R, run_refinement T X Y R /\ R x y.

  Definition run_bisimilar T X Y x y :=
    exists R, run_bisimulation T X Y R /\ R x y.

  Lemma inv_run_bisimulation : forall T X Y R,
    run_bisimulation T X Y R ->
    run_bisimulation T Y X (inv R).

  Lemma run_bisimilar_sym : forall T X Y x y,
    run_bisimilar T X Y x y -> run_bisimilar T Y X y x.

  Lemma inv_run_bisimilar : forall T X Y,
    inv (run_bisimilar T X Y) = run_bisimilar T Y X.

  Lemma run_refinement_and : forall T1 T2 X Y R,
    run_refinement T1 X Y R ->
    run_refinement T2 X Y R ->
    run_refinement (rtd_and T1 T2) X Y R.

  Lemma and_run_refinement : forall T1 T2 X Y R,
    run_refinement (rtd_and T1 T2) X Y R ->
    run_refinement T1 X Y R /\ run_refinement T2 X Y R.

  Lemma run_bisimulation_and : forall T1 T2 X Y R,
    run_refinement T1 X Y R ->
    run_refinement T2 X Y R ->
    run_refinement (rtd_and T1 T2) X Y R.

  Lemma and_run_bisimulation : forall T1 T2 X Y R,
    run_bisimulation (rtd_and T1 T2) X Y R ->
    run_bisimulation T1 X Y R /\ run_bisimulation T2 X Y R.

  Lemma run_bisimilar_refines : forall T X Y x y,
    run_bisimilar T X Y x y -> run_refines T X Y x y.

  Record history :=
    { hsys : LTS
    ; hrun : run hsys
    }.

  Definition hst {X:LTS} (x:run X) : history :=
    {| hsys := X ; hrun := x |}.

  Definition hist_accessable T (h1 h2:history) :=
    run_refines T (hsys h1) (hsys h2) (hrun h1) (hrun h2).

  Definition hist_equiv T (h1 h2:history) :=
    run_bisimilar T (hsys h1) (hsys h2) (hrun h1) (hrun h2).

  Definition start_run X (x:lstate X) :=
    {| curr := x; prev := nil ; good_run := I |}.

  Definition may_extend X (r:run X) (a:option O) (r':run X) :=
    (curr r, a) :: prev r = prev r'.

  Definition must_extend X (r:run X) (a:option O) (r':run X) :=
    may_extend X r a r' /\ must_step X (curr r) a (curr r').

  Definition may_extend_star X :=
    clos_refl_trans (run X) (fun r r' => may_extend X r None r').

  Definition must_extend_star X :=
    clos_refl_trans (run X) (fun r r' => must_extend X r None r').

  Definition weak_may_extend X (r:run X) (a:option O) (r':run X) :=
    match a with
    | None => may_extend_star X r r'
    | Some a => exists r0, exists r1,
        may_extend_star X r r0 /\
        may_extend X r0 (Some a) r1 /\
        may_extend_star X r1 r'
    end.

  Definition weak_must_extend X (r:run X) (a:option O) (r':run X) :=
    match a with
    | None => must_extend_star X r r'
    | Some a => exists r0, exists r1,
        must_extend_star X r r0 /\
        must_extend X r0 (Some a) r1 /\
        must_extend_star X r1 r'
    end.

  Definition must_hdivergence_set X (D:run X -> Prop) :=
    forall x, D x -> exists x', must_extend X x None x' /\ D x'.

  Definition may_hdivergence_set X (D:run X -> Prop) :=
    forall x, D x -> exists x', may_extend X x None x' /\ D x'.

  Definition must_hdiverge X (P:run X -> Prop) x :=
    exists D, must_hdivergence_set X D /\ (forall x, D x -> P x) /\ D x.

  Definition may_hdiverge X (P:run X -> Prop) x :=
    exists D, may_hdivergence_set X D /\ (forall x, D x -> P x) /\ D x.

  Definition extend_run X (r:run X) (a:option O) (x:lstate X)
    (Hstp:may_step X (curr r) a x) :=
    {| curr := x
     ; prev := (curr r,a) :: prev r
     ; good_run := conj Hstp (good_run X r)
     |}.

  Definition curr_rel X Y (R:run X -> run Y -> Prop) (x:lstate X) (y:lstate Y) : Prop :=
      exists rx, exists ry,
        R rx ry /\ (curr rx) = x /\ (curr ry) = y.

  Inductive related_preruns X Y (R:lstate X -> lstate Y -> Prop) :
    prerun X -> lstate X -> prerun Y -> lstate Y -> Prop :=

    | related_prerun_end : forall x y,
        R x y -> related_preruns X Y R nil x nil y

    | related_prerun_tau_left : forall x x' xs y ys,
        R x y ->
        related_preruns X Y R xs x' ys y ->
        related_preruns X Y R ((x',None)::xs) x ys y

    | related_prerun_tau_right : forall x xs y y' ys,
        R x y ->
        related_preruns X Y R xs x ys y' ->
        related_preruns X Y R xs x ((y',None)::ys) y

    | related_prerun_action : forall a x x' xs y y' ys,
        R x y ->
        related_preruns X Y R xs x' ys y' ->
        related_preruns X Y R ((x',a)::xs) x ((y',a)::ys) y.

  Definition related_runs X Y (R:lstate X -> lstate Y -> Prop) (r1:run X) (r2:run Y) :=
    related_preruns X Y R (prev r1) (curr r1) (prev r2) (curr r2).

  Lemma related_preruns_incl : forall X Y (R1 R2:lstate X -> lstate Y -> Prop),
    (forall x y, R1 x y -> R2 x y) ->
    (forall lx x ly y, related_preruns X Y R1 lx x ly y ->
                       related_preruns X Y R2 lx x ly y).

  Lemma related_runs_incl : forall X Y (R1 R2:lstate X -> lstate Y -> Prop),
    (forall x y, R1 x y -> R2 x y) ->
    (forall x y, related_runs X Y R1 x y ->
                 related_runs X Y R2 x y).

  Lemma may_extend_step : forall Z z1 o z2,
    may_extend Z z1 o z2 ->
    may_step Z (curr z1) o (curr z2).

  Lemma may_extend_star_step : forall Z z1 z2,
    may_extend_star Z z1 z2 ->
    may_step_star Z (curr z1) (curr z2).

  Lemma must_extend_step : forall Z z1 o z2,
    must_extend Z z1 o z2 ->
    must_step Z (curr z1) o (curr z2).

  Lemma must_extend_star_step : forall Z z1 z2,
    must_extend_star Z z1 z2 ->
    must_step_star Z (curr z1) (curr z2).

  Lemma must_may_extend : forall X x a x',
    must_extend X x a x' ->
    may_extend X x a x'.

  Lemma must_may_extend_star : forall X x x',
    must_extend_star X x x' ->
    may_extend_star X x x'.

  Lemma weak_must_may_extend : forall X x a x',
    weak_must_extend X x a x' ->
    weak_may_extend X x a x'.

  Lemma may_extend_def : forall X x a x' x_,
    may_extend X x a x' ->
    contains (curr x') x_ ->
    exists q, contains (curr x) q.

  Lemma may_must_extend : forall X x a x' x_,
    may_extend X x a x' ->
    contains (curr x') x_ ->
    must_extend X x a x'.

  Lemma may_extend_star_def : forall X x x' x_,
    may_extend_star X x x' ->
    contains (curr x') x_ ->
    exists q, contains (curr x) q.

  Lemma may_must_extend_star : forall X x x' x_,
    may_extend_star X x x' ->
    contains (curr x') x_ ->
    must_extend_star X x x'.

  Lemma weak_may_extend_def : forall X x a x' x_,
    weak_may_extend X x a x' ->
    contains (curr x') x_ ->
    exists q, contains (curr x) q.

  Lemma weak_may_must_extend : forall X x a x' x_,
    weak_may_extend X x a x' ->
    contains (curr x') x_ ->
    weak_must_extend X x a x'.

  Inductive run_from X (x0:lstate X) : run X -> Prop :=
    | run_from_start : forall r,
         curr r = x0 ->
         prev r = nil ->
         run_from X x0 r
    | run_from_step : forall r a r',
         run_from X x0 r ->
         may_extend X r a r' ->
         run_from X x0 r'.

  Program Definition append_run X (r:run X) (r':run X) (H:run_from X (curr r) r') :=
    {| curr := curr r'; prev := prev r' ++ prev r |}.

  Lemma append_run_from X r r' (H:run_from X (curr r) r') :
    forall x, run_from X x r ->
    run_from X x (append_run X r r' H).

  Lemma extended_run_star_decompose X : forall r r',
    may_extend_star X r r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      may_extend_star X (start_run X (curr r)) r2.

  Lemma extended_run_decompose X : forall r a r',
    may_extend X r a r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      may_extend X (start_run X (curr r)) a r2.

  Lemma step_run_decompose X : forall r a r',
    weak_may_extend X r a r' ->
    exists r2, exists H:run_from X (curr r) r2,
      r' = append_run X r r2 H /\
      weak_may_extend X (start_run X (curr r)) a r2.

  Lemma step_run_start_tau_run_from : forall X x0 h h',
    may_extend_star X h h'->
    run_from X x0 h ->
    run_from X x0 h'.

  Lemma step_run_start_run_from : forall X x o h,
    weak_may_extend X (start_run X x) o h -> run_from X x h.

  Lemma step_run_start_append : forall X h1 o h2 H,
    weak_may_extend X (start_run X (curr h1)) o h2 ->
    weak_may_extend X h1 o (append_run X h1 h2 H).

  Require Import finiteness.

  Definition weak_image_finite X := forall x o,
    finite (lstate X) (fun x' => weak_may_step X x o x').

  Fixpoint tau_path_from X x0 (l:list (lstate X)) :=
    match l with
    | nil => False
    | x1::l' =>
      match l' with
      | nil => x1 = x0
      | x2::_ => tau_path_from X x0 l' /\ may_step X x2 None x1
      end
    end.

  Inductive path_obs_extend X : list (lstate X) -> O -> lstate X -> Prop :=
    | path_obs_extend_intro : forall x l o x',
      may_step X x (Some o) x' ->
      path_obs_extend X (x::l) o x'.

  Inductive prerun_cycle X x0 : prerun X -> Prop :=
  | prerun_cycle_here : forall l,
      prerun_cycle X x0 ((x0,None)::l)
  | prerun_cycle_later : forall x' l,
      prerun_cycle X x0 l ->
      prerun_cycle X x0 ((x',None)::l).

  Inductive run_cycle X : lstate X -> prerun X -> Prop :=
  | run_cycle_here : forall x l,
      prerun_cycle X x l ->
      run_cycle X x l
  | run_cycle_later : forall x' x a l,
      run_cycle X x' l ->
      run_cycle X x ((x',a)::l).

  Section finite_runs.
    Context {Classic:EM}.

    Variable X:LTS.
    Hypothesis Hfin : weak_image_finite X.

    Lemma strong_step_finite : forall x o,
      finite (lstate X) (may_step X x o).

    Lemma tau_paths_finite : forall x0,
      finite (list (lstate X)) (fun l => tau_path_from X x0 l /\ NoDup l).

    Lemma tau_path_extend_states_finite : forall l o,
      finite (lstate X) (path_obs_extend X l o).

    Definition weak_paths_finite x0 o :
      finite (list (lstate X) * (lstate X * list (lstate X)))
        (fun x : list (lstate X) * (lstate X * list (lstate X)) =>
          (tau_path_from X x0 (fst x) /\ NoDup (fst x)) /\
          path_obs_extend X (fst x) o (fst (snd x)) /\
          tau_path_from X (fst (snd x)) (snd (snd x)) /\ NoDup (snd (snd x)))
    :=
      finite_mapping _ _ _ _
      (tau_paths_finite x0)
      (fun l _ =>
        finite_mapping _ _ _ _
          (tau_path_extend_states_finite l o)
          (fun a _ => tau_paths_finite a)).

    Inductive weak_path_run_rel o :
      (list (lstate X) * (lstate X * list (lstate X))) ->
      run X -> Prop :=
    | weak_path_run_rel_intro : forall x' l1 x c l2 r,
         curr r = c ->
         prev r = (map (fun x => (x,None)) l2 ++
                        (x',Some o) ::
                        map (fun x => (x,None)) l1) ->
      weak_path_run_rel o (x'::l1,(x,c :: l2)) r.

    Inductive weak_path_tau_rel :
      (list (lstate X)) -> run X -> Prop :=
      | weak_path_tau_rel_intro : forall x l r,
         curr r = x -> prev r = map (fun x => (x,None)) l ->
         weak_path_tau_rel (x::l) r.

    Lemma acyclic_tau_paths_finite x0 :
      finite (run X)
        (fun h => weak_may_extend X (start_run X x0) None h /\
                 ~run_cycle X (curr h) (prev h)).

    Lemma acyclic_obs_paths_finite x0 a :
      finite (run X) (fun h => weak_may_extend X (start_run X x0) (Some a) h /\ ~run_cycle X (curr h) (prev h)).
  End finite_runs.

  Definition acyclic_run X (h:run X) :=
    ~run_cycle X (curr h) (prev h).

  Lemma weak_image_finite_acyclic_runs {Classic:EM} X :
    weak_image_finite X ->
    forall x a,
      finite (run X) (fun h =>
         weak_may_extend X (start_run X x) a h /\ acyclic_run X h).

  Lemma weak_image_finite_acyclic_extensions {Classic:EM} X :
    weak_image_finite X ->
    forall h a,
      finite (run X) (fun h' => exists q, exists H,
         h' = append_run X h q H /\
         acyclic_run X q /\
         weak_may_extend X (start_run X (curr h)) a q).

  Definition finite_divergences X (x:lstate X) :=
    forall D, may_divergence_set X D -> D x ->
      exists l, forall z, In z l <-> (D z /\ may_step_star X x z).

  Lemma weak_image_finite_divergences {Classic:EM} X :
    weak_image_finite X ->
    (forall x, finite_divergences X x).

  Lemma step_star_extend_star : forall X h x x',
    may_step_star X x x' ->
    curr h = x ->
    exists h', may_extend_star X h h' /\
               curr h' = x'.

  Lemma weak_step_step_run : forall X h x o x',
    weak_may_step X x o x' ->
    curr h = x ->
    exists h', weak_may_extend X h o h' /\
               curr h' = x'.

  Lemma step_run_back_finite {Classic:EM} X : forall x o,
    exists l, forall x', In x' l <-> weak_may_extend X x' o x.

End lts_ref.

Hint Resolve @must_may_step.

End LTS_REF.