Library back_forth_ref

Require Import base.
Require Import prelim.
Require Import lts_ref.
Require Import branch_ref.

Require Import Arith.
Require Import Wf_nat.
Require Import Omega.

Module BF_REF.
Import BRANCH_REF.
Section bf_ref. Context {Obs:ObservationSystem}.

  Definition forth X Y (R:run X -> run Y -> Prop) x y :=
      (forall a x', weak_must_extend X x a x' -> exists y', weak_must_extend Y y a y' /\ R x' y')
      /\
      (forall a y', weak_may_extend Y y a y' -> exists x', weak_may_extend X x a x' /\ R x' y').

  Definition back X Y (R:run X -> run Y -> Prop) x y :=
      (forall a x', weak_may_extend X x' a x -> exists y', weak_may_extend Y y' a y /\ R x' y')
      /\
      (forall a y', weak_may_extend Y y' a y -> exists x', weak_may_extend X x' a x /\ R x' y').

  Definition back_forth := rtd_and forth back.

  Definition forth' X Y (R:run X -> run Y -> Prop) x y :=
      (forall a x', must_extend X x a x' -> exists y', weak_must_extend Y y a y' /\ R x' y')
      /\
      (forall a y', may_extend Y y a y' -> exists x', weak_may_extend X x a x' /\ R x' y').

  Definition back' X Y (R:run X -> run Y -> Prop) x y :=
      (forall a x', may_extend X x' a x -> exists y', weak_may_extend Y y' a y /\ R x' y')
      /\
      (forall a y', may_extend Y y' a y -> exists x', weak_may_extend X x' a x /\ R x' y').

  Definition back_forth' := rtd_and forth' back'.

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

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

  Definition div_forth' X Y (R:run X -> run Y -> Prop) x y :=
    forall D,
      must_hdivergence_set X D -> D x ->
      must_hdiverge Y (fun y' => exists x', D x' /\ R x' y') y.

  Definition div_back' X Y (R:run X -> run Y -> Prop) x y :=
    forall D,
      may_hdivergence_set Y D -> D y ->
      may_hdiverge X (fun x' => exists y', D y' /\ R x' y') x.

  Definition back_forth_div := rtd_and div_forth div_back.
  Definition back_forth_div' := rtd_and div_forth' div_back'.

  Lemma extended_run_push1 : forall X Y R x x' y,
    run_refinement forth' X Y R ->
    R x y ->
    must_extend_star X x x' ->
    exists y',
      R x' y' /\
      must_extend_star Y y y'.

  Lemma extended_run_push1' : forall X Y R x y y',
    run_refinement forth' X Y R ->
    R x y ->
    may_extend_star Y y y' ->
    exists x',
      R x' y' /\
      may_extend_star X x x'.

  Lemma extended_run_push2' : forall X Y R x y x',
    run_refinement back' X Y R ->
    R x y ->
    may_extend_star X x' x ->
    exists y',
      R x' y' /\
      may_extend_star Y y' y.

  Lemma extended_run_push2 : forall X Y R x y y',
    run_refinement back' X Y R ->
    R x y ->
    may_extend_star Y y' y ->
    exists x',
      R x' y' /\
      may_extend_star X x' x.

  Lemma back_back' : forall X Y R,
    run_refinement back X Y R ->
    run_refinement back' X Y R.

  Lemma forth_forth' : forall X Y R,
    run_refinement forth X Y R ->
    run_refinement forth' X Y R.

  Lemma bf_bf' : forall X Y R,
    run_refinement back_forth X Y R ->
    run_refinement back_forth' X Y R.

  Lemma back'_back : forall X Y R,
    run_refinement back' X Y R ->
    run_refinement back X Y R.

  Lemma forth'_forth : forall X Y R,
    run_refinement forth' X Y R ->
    run_refinement forth X Y R.

  Lemma bf'_bf : forall X Y R,
    run_refinement back_forth' X Y R ->
    run_refinement back_forth X Y R.

  Lemma bf_sim_comp : forall X Y Z R1 R2,
    run_refinement back_forth X Y R1 ->
    run_refinement back_forth Y Z R2 ->
    run_refinement back_forth X Z (comp R1 R2).

  Lemma bf_sim_eq : forall X,
    run_refinement back_forth X X eq.

  Theorem bf_ref_refl : forall X x,
    run_refines back_forth X X x x.

  Lemma bf_bisimilar_simulation : forall X Y,
    run_refinement back_forth X Y (run_refines back_forth X Y).

  Theorem bf_ref_trans : forall X Y Z x y z,
    run_refines back_forth X Y x y ->
    run_refines back_forth Y Z y z ->
    run_refines back_forth X Z x z.

  Definition Xclosure X Y (R:run X -> run Y -> Prop) x y :=
    exists x0, exists y0,
      may_extend_star X x0 x /\
      may_extend_star Y y0 y /\
      R x0 y /\
      R x y0.

  Definition Xproperty X Y R :=
    forall x0 y0 x y,
      may_extend_star X x0 x ->
      may_extend_star Y y0 y ->
      R x0 y ->
      R x y0 ->
      R x y.

  Lemma Xclosure_property : forall X Y R,
    Xproperty X Y (Xclosure X Y R).

  Lemma Xclosure_incl : forall X Y (R:run X -> run Y -> Prop) x y,
    R x y -> Xclosure X Y R x y.

  Lemma Xclosure_back_sim : forall X Y R,
    run_refinement back X Y R ->
    run_refinement back X Y (Xclosure X Y R).

  Lemma Xclosure_forth_sim : forall X Y R,
    run_refinement forth X Y R ->
    run_refinement forth X Y (Xclosure X Y R).

  Lemma Xclosure_bf_sim : forall X Y R,
    run_refinement back_forth X Y R ->
    run_refinement back_forth X Y (Xclosure X Y R).

  Section X_stutter.
    Variables X Y:LTS.
    Variable R : run X -> run Y -> Prop.

    Hypothesis HR : run_refinement back X Y R.
    Hypothesis HRX : Xproperty X Y R.

    Lemma Xproperty_stutter : forall x y0 y y1,
      R x y0 ->
      R x y1 ->
      may_extend_star Y y0 y ->
      may_extend_star Y y y1 ->
      R x y.

    Lemma Xproperty_stutter' : forall x0 x x1 y,
      R x0 y ->
      R x1 y ->
      may_extend_star X x0 x ->
      may_extend_star X x x1 ->
      R x y.

    Lemma curr_path : forall (rx:run X) (ry1 ry2:run Y),
      must_extend_star Y ry1 ry2 ->
      R rx ry1 -> R rx ry2 ->
      path_where (lstate Y) (fun a b : lstate Y => must_step Y a None b)
        (curr_rel X Y R (curr rx)) (curr ry1) (curr ry2).

    Lemma curr_path' : forall (rx1 rx2:run X) (ry:run Y),
      may_extend_star X rx1 rx2 ->
      R rx1 ry -> R rx2 ry ->
      path_where (lstate X) (fun a b => may_step X a None b)
        (fun x => curr_rel X Y R x (curr ry)) (curr rx1) (curr rx2).

  End X_stutter.

  Definition forth1 X Y (R:run X -> run Y -> Prop) x y :=
      (forall a x', weak_must_extend X x a x' -> exists y', weak_must_extend Y y a y' /\ R x' y').

  Definition forth2 X Y (R:run X -> run Y -> Prop) x y :=
      (forall a y', weak_may_extend Y y a y' -> exists x', weak_may_extend X x a x' /\ R x' y').

  Section bf_to_branch.
    Variables X Y:LTS.
    Variable R : run X -> run Y -> Prop.

    Hypothesis HR : run_refinement back X Y R.
    Hypothesis HR1 : run_refinement forth1 X Y R.
    Hypothesis HR2 : run_refinement forth2 X Y R.

    Hypothesis HRX : Xproperty X Y R.

    Let R' x y := curr_rel X Y R x y.

    Lemma bf_to_branch_forward : refinement branch_forward X Y R'.

    Lemma bf_to_branch_backward : refinement branch_backward X Y R'.

    Lemma bf_to_branch_sim : refinement branch X Y R'.
  End bf_to_branch.

  Section branch_to_bf.
    Variables X Y:LTS.
    Variable R : lstate X -> lstate Y -> Prop.

    Hypothesis HR : refinement branch X Y R.

    Lemma branch_to_back' :
      run_refinement back' X Y (related_runs X Y R).

    Lemma branch_to_forth' :
      run_refinement forth' X Y (related_runs X Y R).

  End branch_to_bf.

  Section bf_to_related_preruns.
    Lemma extended_star_length_le : forall Z z1 z2,
      may_extend_star Z z1 z2 ->
      length (prev z1) <= length (prev z2).

    Variables X Y:LTS.
    Variable R : run X -> run Y -> Prop.

    Hypothesis H : run_refinement back X Y R.
    Let R' := curr_rel X Y (Xclosure X Y R).

    Lemma related_runs_push : forall x y1 y2,
      Xclosure X Y R x y1 ->
      Xclosure X Y R x y2 ->
      may_extend_star Y y1 y2 ->
      related_runs X Y R' x y1 ->
      related_runs X Y R' x y2.

    Lemma bf_to_related_preruns :
      forall n
        (x : lstate X) (xs : prerun X) (gx : good_prerun X xs x)
        (y : lstate Y) (ys : prerun Y) (gy : good_prerun Y ys y),
        R {| curr := x; prev := xs; good_run := gx |}
          {| curr := y; prev := ys; good_run := gy |} ->
        n = length xs + length ys ->
        related_preruns X Y R' xs x ys y.
  End bf_to_related_preruns.

  Lemma bf_to_related_runs : forall X Y R x y,
    run_refinement back X Y R ->
    let R' := curr_rel X Y (Xclosure X Y R) in
    R x y ->
    related_runs X Y R' x y.

  Lemma branch_to_bf : forall X Y R,
    refinement branch X Y R ->
    run_refinement back_forth X Y (related_runs X Y R).

  Lemma bf_to_branch : forall X Y R,
    run_refinement back_forth X Y R ->
    refinement branch X Y (curr_rel X Y (Xclosure X Y R)).

  Theorem bf_branch_related_runs : forall X Y x y,
    run_refines back_forth X Y x y <->
    exists R,
      refinement branch X Y R /\
      related_runs X Y R x y.

  Theorem bf_branch_related_runs2 : forall X Y,
    run_refines back_forth X Y =
    related_runs X Y (refines branch X Y).

  Theorem branch_to_bf_start : forall X Y x y,
    refines branch X Y x y ->
    run_refines back_forth X Y (start_run X x) (start_run Y y).

  Theorem bf_to_branch_curr : forall X Y x y,
    run_refines back_forth X Y x y ->
    refines branch X Y (curr x) (curr y).

  Fixpoint safe_prerun X (r:prerun X) :=
    match r with
    | nil => True
    | (x,_)::r' => safe_state X x /\ safe_prerun X r'
    end.

  Definition safe_run X (r:run X) :=
    safe_state X (curr r) /\ safe_prerun X (prev r).

  Lemma safe_run_may_extend : forall X x a x',
    safe_run X x ->
    may_extend X x a x' ->
    safe_run X x'.

  Lemma safe_run_may_extend_star : forall X x x',
    safe_run X x ->
    may_extend_star X x x' ->
    safe_run X x'.

  Lemma safe_run_weak_may_extend : forall X x a x',
    safe_run X x ->
    weak_may_extend X x a x' ->
    safe_run X x'.

  Lemma safe_run_may_extend' : forall X x' a x,
    safe_run X x ->
    may_extend X x' a x ->
    safe_run X x'.

  Lemma safe_run_may_extend_star' : forall X x' x,
    safe_run X x ->
    may_extend_star X x' x ->
    safe_run X x'.

  Lemma safe_run_weak_may_extend' : forall X x' a x,
    safe_run X x ->
    weak_may_extend X x' a x ->
    safe_run X x'.

  Lemma back_forth_inv : forall X Y R,
    run_refinement back_forth X Y R ->
    run_refinement back_forth Y X (fun y x => R x y /\ safe_run X x).

  Theorem run_refines_safe : forall X Y x y,
    safe_run X x ->
    run_refines back_forth X Y x y ->
    run_refines back_forth Y X y x.

  Lemma div_forth_eq : forall X Y R,
    run_refinement div_forth X Y R <->
    run_refinement div_forth' X Y R.

  Lemma div_back_eq : forall X Y R,
    run_refinement div_back X Y R <->
    run_refinement div_back' X Y R.

  Lemma div_forth_ref_eq : forall X,
    run_refinement div_forth X X eq.

  Lemma div_back_ref_eq : forall X,
    run_refinement div_back X X eq.

  Lemma bf_div_ref_eq : forall X,
    run_refinement back_forth_div X X eq.

  Lemma div_forth'_comp : forall X Y Z R1 R2,
    run_refinement div_forth' X Y R1 ->
    run_refinement div_forth' Y Z R2 ->
    run_refinement div_forth' X Z (comp R1 R2).

  Lemma div_back'_comp : forall X Y Z R1 R2,
    run_refinement div_back' X Y R1 ->
    run_refinement div_back' Y Z R2 ->
    run_refinement div_back' X Z (comp R1 R2).

  Lemma back_forth'_div_comp : forall X Y Z R1 R2,
    run_refinement back_forth_div' X Y R1 ->
    run_refinement back_forth_div' Y Z R2 ->
    run_refinement back_forth_div' X Z (comp R1 R2).

  Theorem bf_div_refl : forall X x,
    run_refines (rtd_and back_forth back_forth_div) X X x x.

  Theorem bf_div_trans : forall X Y Z x y z,
    run_refines (rtd_and back_forth back_forth_div) X Y x y ->
    run_refines (rtd_and back_forth back_forth_div) Y Z y z ->
    run_refines (rtd_and back_forth back_forth_div) X Z x z.


  Lemma bf_div_forth_related_runs : forall X Y R,
    refinement branch_forward X Y R ->
    refinement cond_D1 X Y R ->
    run_refinement div_forth X Y (related_runs X Y R).

  Lemma bf_div_back_related_runs : forall X Y R,
    refinement branch_backward X Y R ->
    refinement cond_D1' X Y R ->
    run_refinement div_back X Y (related_runs X Y R).

  Theorem bf_div_related_runs : forall X Y R,
    refinement (td_and branch (td_and cond_D1 cond_D1')) X Y R ->
    run_refinement (rtd_and back_forth back_forth_div) X Y (related_runs X Y R).

  Section bf_to_div.
    Variables X Y:LTS.
    Variable R:run X -> run Y -> Prop.

    Let R' := curr_rel X Y (Xclosure X Y R).

    Hypothesis H : run_refinement back_forth X Y R.
    Hypothesis H0 : run_refinement div_forth X Y R.
    Hypothesis H1 : run_refinement div_back X Y R.

    Lemma bf_to_condD1 : refinement cond_D1 X Y R'.

    Lemma bf_to_condD1' : refinement cond_D1' X Y R'.
  End bf_to_div.

  Theorem bf_branch_related_runs_div1 : forall X Y R,
    let R' := curr_rel X Y (Xclosure X Y R) in

    run_refinement (rtd_and back_forth back_forth_div) X Y R ->
    refinement (td_and branch (td_and cond_D1 cond_D1')) X Y R'.

  Theorem bf_branch_related_runs_div : forall X Y x y,
    run_refines (rtd_and back_forth back_forth_div) X Y x y <->
    (exists R,
      refinement (td_and branch (td_and cond_D1 cond_D1')) X Y R /\
      related_runs X Y R x y).

  Theorem bf_branch_related_runs_div2 : forall X Y,
    run_refines (rtd_and back_forth back_forth_div) X Y =
    related_runs X Y (refines branch_div X Y).

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

  Theorem bf_branch_related_runs_div_bisim : forall X Y x y,
    run_bisimilar (rtd_and back_forth back_forth_div) X Y x y <->
    (exists R,
      bisimulation (td_and branch (td_and cond_D1 cond_D1')) X Y R /\
      related_runs X Y R x y).

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

  Lemma td_and_mono (T1 T2:transition_diagram) :
    td_mono T1 -> td_mono T2 -> td_mono (td_and T1 T2).

  Lemma bisimilar_mono_fixpoint X Y (T:transition_diagram) :
    td_mono T ->
    bisimulation T X Y (bisimilar T X Y).

  Theorem bisimilar_div_bisimulation X Y :
   bisimulation (td_and branch (td_and cond_D1 cond_D1')) X Y
     (bisimilar branch_div X Y).

  Theorem bf_branch_related_runs_bisim : forall X Y,
    run_bisimilar (rtd_and back_forth back_forth_div) X Y =
    related_runs X Y (bisimilar branch_div X Y).

  Theorem branch_ind_div_bisim : forall X Y R,
    bisimulation branch_ind X Y R ->
    bisimulation branch_div X Y R.

  Lemma bf_bisimilar_div_refl : forall X x,
    run_bisimilar (rtd_and back_forth back_forth_div) X X x x.

  Lemma run_bisim_ref : forall T X Y R,
    run_bisimulation T X Y R ->
    run_refinement T X Y R /\
    run_refinement T Y X (inv R).

  Lemma bf_run_bisim_div_trans : forall X Y Z x y z,
    run_bisimilar (rtd_and back_forth back_forth_div) X Y x y ->
    run_bisimilar (rtd_and back_forth back_forth_div) Y Z y z ->
    run_bisimilar (rtd_and back_forth back_forth_div) X Z x z.

  Lemma related_runs_append : forall X Y (r1 r2:run X) (r1' r2':run Y) H H' R,
    related_runs X Y R r1 r1' ->
    related_runs X Y R r2 r2' ->
    related_runs X Y R (append_run X r1 r2 H) (append_run Y r1' r2' H').

  Lemma remove_tau_prerun_cycle {Classic:EM} : forall X x z h,
    may_extend_star X (start_run X x) h ->
    prerun_cycle X z (prev h) ->
    may_step_star X (curr h) z ->
    exists h',
      length (prev h') < length (prev h) /\
      may_extend_star X (start_run X x) h' /\
      curr h' = z /\
      related_runs X X (bisimilar branch_div X X) h' h.

  Lemma remove_tau_prerun_cycle_must {Classic:EM} : forall X x z h,
    must_extend_star X (start_run X x) h ->
    prerun_cycle X z (prev h) ->
    must_step_star X (curr h) z ->
    exists h',
      length (prev h') < length (prev h) /\
      must_extend_star X (start_run X x) h' /\
      curr h' = z /\
      related_runs X X (bisimilar branch_div X X) h' h.

  Lemma remove_tau_cycle {Classic:EM} : forall X x h,
    may_extend_star X (start_run X x) h ->
    run_cycle X (curr h) (prev h) ->
    exists h',
      length (prev h') < length (prev h) /\
      may_extend_star X (start_run X x) h' /\
      curr h = curr h' /\
      related_runs X X (bisimilar branch_div X X) h' h.

  Lemma remove_tau_cycle_must {Classic:EM} : forall X x h,
    must_extend_star X (start_run X x) h ->
    run_cycle X (curr h) (prev h) ->
    exists h',
      length (prev h') < length (prev h) /\
      must_extend_star X (start_run X x) h' /\
      curr h = curr h' /\
      related_runs X X (bisimilar branch_div X X) h' h.

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

  Lemma step_run_remove_cycle {Classic:EM} : forall X x o h,
    weak_may_extend X (start_run X x) o h ->
    run_cycle X (curr h) (prev h) ->
    exists h',
      length (prev h') < length (prev h) /\
      weak_may_extend X (start_run X x) o h' /\
      related_runs X X (bisimilar branch_div X X) h' h.

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

  Lemma step_run_remove_cycle_must {Classic:EM} : forall X x o h,
    weak_must_extend X (start_run X x) o h ->
    run_cycle X (curr h) (prev h) ->
    exists h',
      length (prev h') < length (prev h) /\
      weak_must_extend X (start_run X x) o h' /\
      related_runs X X (bisimilar branch_div X X) h' h.

  Lemma step_run_acyclic_bisimilar {Classic:EM} : forall X x o h,
    weak_may_extend X (start_run X x) o h ->
    exists h',
      acyclic_run X h' /\
      weak_may_extend X (start_run X x) o h' /\
      run_bisimilar (rtd_and back_forth back_forth_div) X X h' h.

  Lemma step_run_acyclic_bisimilar_must {Classic:EM} : forall X x o h,
    weak_must_extend X (start_run X x) o h ->
    exists h',
      acyclic_run X h' /\
      weak_must_extend X (start_run X x) o h' /\
      run_bisimilar (rtd_and back_forth back_forth_div) X X h' h.

  Require Import finiteness.

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

  Lemma weak_image_finite_acyclic_extensions_must {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_must_extend X (start_run X (curr h)) a q).

  Lemma weak_may_extend_finite {Classic:EM} X :
    weak_image_finite X ->
    forall h o, exists l,
      (forall q, In q l -> weak_may_extend X h o q) /\
      (forall h', weak_may_extend X h o h' ->
        exists q, In q l /\ run_bisimilar (rtd_and back_forth back_forth_div) X X q h').

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

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

  Lemma weak_must_extend_finite {Classic:EM} X :
    weak_image_finite X ->
    forall h o, exists l,
      (forall q, In q l -> weak_must_extend X h o q) /\
      (forall h', weak_must_extend X h o h' ->
        exists q, In q l /\ run_bisimilar (rtd_and back_forth back_forth_div) X X q h').

End bf_ref.
End BF_REF.