Library branch_ref

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

Module BRANCH_REF.
Include LTS_REF.
Section branch_ref. Context {Obs:ObservationSystem}.

  Definition branch_forward : transition_diagram := fun X Y R x y =>
    forall o x', must_step X x o x' ->
          (o = None /\ R x' y) \/
          exists y', exists y'',
            path_where _ (fun a b => must_step Y a None b) (R x) y y' /\
            must_step Y y' o y'' /\ R x y' /\ R x' y''.

  Definition branch_backward X Y R x y :=
    forall o y', may_step Y y o y' ->
          (o = None /\ R x y') \/
          exists x', exists x'',
            path_where _ (fun a b => may_step X a None b) (fun x => R x y) x x' /\
            may_step X x' o x'' /\ R x' y /\ R x'' y'.

  Definition branch_forward_no_stutter : transition_diagram := fun X Y R x y =>
    forall o x', must_step X x o x' ->
          (o = None /\ R x' y) \/
          exists y', exists y'',
            must_step_star Y y y' /\
            must_step Y y' o y'' /\ R x y' /\ R x' y''.

  Definition branch_backward_no_stutter X Y R x y :=
    forall o y', may_step Y y o y' ->
          (o = None /\ R x y') \/
          exists x', exists x'',
            may_step_star X x x' /\
            may_step X x' o x'' /\ R x' y /\ R x'' y'.


  Inductive branch_forward_ind X Y R : lstate X -> lstate Y -> Prop :=
    branch_forward_ind_intro : forall x y,
      (forall o x', must_step X x o x' ->
          (o = None /\ R x' y /\ branch_forward_ind X Y R x' y) \/
          exists y', exists y'',
            path_where _ (fun a b => must_step Y a None b) (R x) y y' /\
            must_step Y y' o y'' /\ R x y' /\ R x' y'') ->
      branch_forward_ind X Y R x y.

  Inductive branch_backward_ind X Y R : lstate X -> lstate Y -> Prop :=
    branch_backward_ind_intro : forall x y,
      (forall o y', may_step Y y o y' ->
          (o = None /\ R x y' /\ branch_backward_ind X Y R x y') \/
          exists x', exists x'',
            path_where _ (fun a b => may_step X a None b) (fun x => R x y) x x' /\
            may_step X x' o x'' /\ R x' y /\ R x'' y') ->
      branch_backward_ind X Y R x y.

  Inductive branch_forward_ind_no_stutter X Y R : lstate X -> lstate Y -> Prop :=
    branch_forward_ind_no_sutter_intro : forall x y,
      (forall o x', must_step X x o x' ->
          (o = None /\ R x' y /\ branch_forward_ind_no_stutter X Y R x' y) \/
          exists y', exists y'',
            must_step_star Y y y' /\
            must_step Y y' o y'' /\ R x y' /\ R x' y'') ->
      branch_forward_ind_no_stutter X Y R x y.

  Inductive branch_backward_ind_no_stutter X Y R : lstate X -> lstate Y -> Prop :=
    branch_backward_ind_no_stutter_intro : forall x y,
      (forall o y', may_step Y y o y' ->
          (o = None /\ R x y' /\ branch_backward_ind_no_stutter X Y R x y') \/
          exists x', exists x'',
            may_step_star X x x' /\
            may_step X x' o x'' /\ R x' y /\ R x'' y') ->
      branch_backward_ind_no_stutter X Y R x y.

  Lemma branch_forward_ind_ind
    : forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
       (forall (x : lstate X) (y : lstate Y),
        (forall (o : option O) (x' : lstate X),
         must_step X x o x' ->
         o = None /\ R x' y /\ P x' y \/
         (exists y' : lstate Y,
            exists y'' : lstate Y,
              path_where (lstate Y)
                (fun a b : lstate Y => must_step Y a None b)
                (R x) y y' /\ must_step Y y' o y'' /\ R x y' /\ R x' y'')) ->
        P x y) ->
       forall (l : lstate X) (l0 : lstate Y),
       branch_forward_ind X Y R l l0 -> P l l0.

  Lemma branch_backward_ind_ind : forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
       (forall (x : lstate X) (y : lstate Y),
        (forall (o : option O) (y' : lstate Y),
         may_step Y y o y' ->
         o = None /\ R x y' /\ P x y' \/
         (exists x' : lstate X,
            exists x'' : lstate X,
              path_where (lstate X)
                (fun a b : lstate X => may_step X a None b)
                (fun x0 : lstate X => R x0 y) x x' /\
              may_step X x' o x'' /\ R x' y /\ R x'' y')) ->
        P x y) ->
       forall (l : lstate X) (l0 : lstate Y),
       branch_backward_ind X Y R l l0 -> P l l0.

  Lemma branch_forward_ind_no_stutter_ind
    : forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
       (forall (x : lstate X) (y : lstate Y),
        (forall (o : option O) (x' : lstate X),
         must_step X x o x' ->
         o = None /\ R x' y /\ P x' y \/
         (exists y' : lstate Y,
            exists y'' : lstate Y,
              must_step_star Y y y' /\
              must_step Y y' o y'' /\ R x y' /\ R x' y'')) ->
        P x y) ->
       forall (l : lstate X) (l0 : lstate Y),
       branch_forward_ind_no_stutter X Y R l l0 -> P l l0.

  Lemma branch_backward_ind_no_stutter_ind : forall (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
       (forall (x : lstate X) (y : lstate Y),
        (forall (o : option O) (y' : lstate Y),
         may_step Y y o y' ->
         o = None /\ R x y' /\ P x y' \/
         (exists x' : lstate X,
            exists x'' : lstate X,
              may_step_star X x x' /\
              may_step X x' o x'' /\ R x' y /\ R x'' y')) ->
        P x y) ->
       forall (l : lstate X) (l0 : lstate Y),
       branch_backward_ind_no_stutter X Y R l l0 -> P l l0.

  Inductive goes_wrong (X:LTS) : lstate X -> Prop :=
    | go_wrong_now : goes_wrong X (mho _)
    | go_wrong_later : forall x,
          (exists x', steps X x None x') ->
          (forall o x', steps X x o x' -> o = None /\ goes_wrong X x') ->
          goes_wrong X (into x).

  Lemma goes_wrong_ind
     : forall (X : LTS) (P : lstate X -> Prop),
       P (mho (state X)) ->
       (forall x : state X,
         (exists x', steps X x None x') ->
        (forall (o : option O) (x' : lift (state X)),
         steps X x o x' -> o = None /\ P x') ->
        P (into x)) -> forall l : lstate X, goes_wrong X l -> P l.



  Definition branch :=
    td_and branch_forward branch_backward.

  Definition branch_no_stutter :=
    td_and branch_forward_no_stutter branch_backward_no_stutter.

  Definition branch_ind :=
    td_and branch_forward_ind branch_backward_ind.

  Definition branch_ind_no_stutter :=
    td_and branch_forward_ind_no_stutter branch_backward_ind_no_stutter.

  Definition branch_wrong X Y (R:lstate X -> lstate Y -> Prop) x y :=
    goes_wrong X x -> goes_wrong Y y.


  Definition reachable (X:LTS) : lstate X -> lstate X -> Prop :=
    clos_refl_trans _ (fun a b => exists o, must_step X a o b).

  Definition reachable' (X:LTS) : lstate X -> lstate X -> Prop :=
    clos_refl_trans _ (fun a b => exists o, may_step X a o b).

  Definition safe_state (X:LTS) (x:lstate X) :=
    forall x', reachable X x x' -> exists x_, contains x' x_.

  Lemma safe_refines_defined : forall X Y x y (ob:O),
    refines branch X Y x y ->
    safe_state X x ->
    exists y_, contains y y_.

  Lemma safe_refines_safe : forall X Y x y (ob:O),
    refines branch X Y x y ->
    safe_state X x ->
    safe_state Y y.

  Lemma safe_refines_ind_defined : forall X Y x y,
    refines branch_ind X Y x y ->
    safe_state X x ->
    exists y_, contains y y_.

  Lemma safe_refines_ind_safe : forall X Y x y,
    refines branch_ind X Y x y ->
    safe_state X x ->
    safe_state Y y.

  Definition state_def : transition_diagram := fun X Y R x y =>
    exists x_, contains x x_.

  Definition branch_def := td_and branch state_def.

  Lemma branch_def_safe : forall X Y R,
    refinement branch_def X Y R ->
    forall x y, R x y ->
    safe_state X x.

  Lemma branch_def_inv : forall X Y R (ob:O),
    refinement branch_def X Y R ->
    refinement branch_def Y X (inv R).

  Lemma branch_def_branch_safe: forall X Y x y (ob:O),
    refines branch_def X Y x y <->
    (safe_state X x /\ refines branch X Y x y).

  Lemma branch_forward_ref_compose : forall X Y Z R1 R2,
    refinement branch_forward X Y R1 ->
    refinement branch_forward Y Z R2 ->
    refinement branch_forward X Z (comp R1 R2).

  Lemma branch_backward_ref_compose : forall X Y Z R1 R2,
    refinement branch_backward X Y R1 ->
    refinement branch_backward Y Z R2 ->
    refinement branch_backward X Z (comp R1 R2).

  Lemma branch_ref_compose : forall X Y Z R1 R2,
    refinement branch X Y R1 ->
    refinement branch Y Z R2 ->
    refinement branch X Z (comp R1 R2).

  Section trans_forward.
    Variables X Y Z:LTS.
    Variable R1 : lstate X -> lstate Y -> Prop.
    Variable R2 : lstate Y -> lstate Z -> Prop.

    Hypothesis HR1 : refinement branch_forward_ind X Y R1.
    Hypothesis HR2 : refinement branch_forward_ind Y Z R2.

    Lemma path_push_comp : forall (x : lstate X) (y1 y2 : lstate Y),
      path_where (lstate Y) (fun a b => must_step Y a None b) (R1 x) y1 y2 ->
      forall z1 : lstate Z,
        R2 y1 z1 ->
        exists z2 : lstate Z,
          path_where (lstate Z) (fun a b => must_step Z a None b) (comp R1 R2 x) z1 z2 /\
          R2 y2 z2.

    Lemma branch_ind_compose_inner :
      forall x y z,
        R1 x y -> R2 y z ->

        (forall x x' y' y'',
          must_step X x None x' ->
          path_where _ (fun a b => must_step Y a None b) (R1 x) y y' ->
          R1 x y ->
          R1 x y' ->
          must_step Y y' None y'' ->
          R1 x' y'' ->

          (comp R1 R2 x' z /\
            branch_forward_ind X Z (comp R1 R2) x' z) \/
          (exists z' : lstate Z,
            exists z'' : lstate Z,
              path_where _ (fun a b => must_step Z a None b) (comp R1 R2 x) z z' /\
              must_step Z z' None z'' /\
              (comp R1 R2 x z') /\
              (comp R1 R2) x' z'')) ->

        branch_forward_ind X Z (comp R1 R2) x z.

    Lemma branch_forward_ind_compose :
      forall x z,
        comp R1 R2 x z ->
        branch_forward_ind X Z (comp R1 R2) x z.
  End trans_forward.

  Section trans_backward.
    Variables X Y Z:LTS.
    Variable R1 : lstate X -> lstate Y -> Prop.
    Variable R2 : lstate Y -> lstate Z -> Prop.

    Hypothesis HR1 : refinement branch_backward_ind X Y R1.
    Hypothesis HR2 : refinement branch_backward_ind Y Z R2.

    Lemma path_push_comp_back : forall (z : lstate Z) (y1 y2 : lstate Y),
      path_where (lstate Y) (fun a b => may_step Y a None b) (fun y => R2 y z) y1 y2 ->
      forall x1 : lstate X,
        R1 x1 y1 ->
        exists x2 : lstate X,
          path_where (lstate X) (fun a b => may_step X a None b) (fun x => comp R1 R2 x z) x1 x2 /\ R1 x2 y2.

    Lemma branch_ind_compose_inner_back :
      forall x y z,
        R1 x y -> R2 y z ->

        (forall z z' y' y'',
          may_step Z z None z' ->
          path_where _ (fun a b => may_step Y a None b) (fun y => R2 y z) y y' ->
          R2 y z ->
          R2 y' z ->
          may_step Y y' None y'' ->
          R2 y'' z' ->

          (comp R1 R2 x z' /\
            branch_backward_ind X Z (comp R1 R2) x z') \/
          (exists x' : lstate X,
            exists x'' : lstate X,
              path_where _ (fun a b => may_step X a None b) (fun x => comp R1 R2 x z) x x' /\
              may_step X x' None x'' /\
              (comp R1 R2 x' z) /\
              (comp R1 R2) x'' z')) ->

        branch_backward_ind X Z (comp R1 R2) x z.

    Lemma branch_back_ind_compose :
      forall x z,
        comp R1 R2 x z ->
        branch_backward_ind X Z (comp R1 R2) x z.
  End trans_backward.

  Lemma branch_ind_compose : forall X Y Z R1 R2,
    refinement branch_ind X Y R1 ->
    refinement branch_ind Y Z R2 ->
    refinement branch_ind X Z (comp R1 R2).

  Lemma branch_ref_eq : forall X, refinement branch X X eq.

  Lemma branch_ind_eq : forall X, refinement branch_ind X X eq.

  Theorem refines_refl : forall X x, refines branch X X x x.

  Theorem refines_ind_refl : forall X x, refines branch_ind X X x x.

  Theorem refines_trans : forall X Y Z x y z,
    refines branch X Y x y ->
    refines branch Y Z y z ->
    refines branch X Z x z.

  Theorem refines_ind_trans : forall X Y Z x y z,
    refines branch_ind X Y x y ->
    refines branch_ind Y Z y z ->
    refines branch_ind X Z x z.

  Lemma refinement_equiv (T:transition_diagram) :
    (forall X Y (R1 R2:lstate X -> lstate Y -> Prop),
      (forall x y, R1 x y -> R2 x y) ->
      (forall x y, T X Y R1 x y -> T X Y R2 x y)) ->
    forall X Y R R',
      refinement T X Y R ->
      (forall x y, R x y <-> R' x y) ->
      refinement T X Y R'.

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

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

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

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

  Lemma bisim_ind_refl : forall X x,
    bisimilar branch_ind X X x x.

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

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

  Theorem refines_refinement X Y :
    refinement branch X Y (refines branch X Y).

  Lemma refines_ind_no_stutter_refinement : forall A B,
    refinement branch_ind_no_stutter A B
      (refines branch_ind_no_stutter A B).

  Theorem refines_ind_refinement X Y :
    refinement branch_ind X Y (refines branch_ind X Y).

  Lemma refines_ind_mho : forall X Y y,
    refines branch_ind X Y (mho _) y.

  Lemma refines_ind_mho_step_star : forall A B x,
    refines branch_ind A B x (mho _) ->
    must_step_star A x (mho _).

  Lemma refines_ind_mho_goes_wrong : forall A B x,
    refines branch_ind A B x (mho _) ->
    goes_wrong A x.

  Lemma refines_ind_goes_wrong : forall A B x y,
    refines branch_ind A B x y ->
    goes_wrong B y -> goes_wrong A x.

  Definition wrong_bisim A B (R:lstate A -> lstate B -> Prop) :=
    forall x y, R x y ->
      branch_forward_ind A B R x y /\
      branch_forward_ind B A (inv R) y x /\
      (goes_wrong A x <-> goes_wrong B y).

  Lemma branch_forward_back_ind_wrong : forall A B (R:lstate A -> lstate B -> Prop) x y,
    forall (HR:forall x y, R x y -> branch_forward_ind A B R x y),
    (forall x y, R x y -> goes_wrong _ y -> goes_wrong _ x) ->
    R x y ->
    branch_forward_ind B A (inv R) y x ->
    branch_backward_ind A B R x y.

  Lemma wrong_bisim_iff_branch_ind_bisim A B R :
    wrong_bisim A B R <-> bisimulation branch_ind A B R.

  Definition wrong_bisimilar A B x y :=
    exists R, wrong_bisim A B R /\ R x y.

  Record wrong_expansion (X Y:LTS) (f:state X -> state Y) :=
  { expand_inj : forall x x', f x = f x' -> x = x'
  ; expand_prf1 : forall x o x',
       steps X x o (into x') ->
       steps Y (f x) o (into (f x'))
  ; expand_prf2 : forall x o,
       steps X x o (mho _) ->
       exists y, steps Y (f x) o y
  ; expand_prf3 : forall x o y,
       steps Y (f x) o y ->
       exists x', steps X x o x' /\
         match x' with
         | mho => True
         | into z => y = into (f z)
         end
  }.

  Inductive wrong_rel X Y (R:state X -> state Y -> Prop) : lstate X -> lstate Y -> Prop :=
    | wrong_rel_mho : forall y, wrong_rel X Y R (mho _) y
    | wrong_rel_into : forall x y, R x y -> wrong_rel X Y R (into x) (into y).

  Inductive wrong_rel' X Y (R:state X -> state Y -> Prop) : lstate X -> lstate Y -> Prop :=
    | wrong_rel_mho' : wrong_rel' X Y R (mho _) (mho _)
    | wrong_rel_into' : forall x y, R x y -> wrong_rel' X Y R (into x) (into y).

    Definition wrong_expands X Y x y :=
    exists f, wrong_expansion X Y f /\
      wrong_rel _ _ (fun x y => f x = y) x y.

  Definition wrong_expands' X Y x y :=
    exists Q1, exists Q2, exists q1, exists q2,
      bisimilar branch X Q1 x q1 /\
      wrong_expands Q1 Q2 q1 q2 /\
      bisimilar branch Q2 Y q2 y.

  Section expands_refine.
    Variables X Y:LTS.
    Variable R:lstate X -> lstate Y -> Prop.
    Hypothesis HR:refinement branch X Y R.

    Record Q1st := mkQ1 { q1x: lstate X; q1y: lstate Y; q1H : R q1x q1y }.

    Inductive Q1step : Q1st -> option O -> lift Q1st -> Prop :=
    | Q1step1 : forall o x x' y y' (H:R x y) (H':R x' y'),
        must_step X x o x' ->
        must_step Y y o y' ->
        Q1step (mkQ1 x y H) o (into (mkQ1 x' y' H'))
    | Q1step2 : forall x x' y (H:R x y) (H':R x' y),
        must_step X x None x' ->
        Q1step (mkQ1 x y H) None (into (mkQ1 x' y H'))
    | Q1step3 : forall x y y' (H:R x y) (H':R x y'),
        must_step Y y None y' ->
        Q1step (mkQ1 x y H) None (into (mkQ1 x y' H'))
    | Q1step4 : forall y H,
        Q1step (mkQ1 (mho _) y H) None (mho _).

    Definition Q1 := Build_LTS Q1st Q1step.

    Inductive Q2st :=
    | mkQ2 : forall (x:lstate X) (y:lstate Y), R x y -> Q2st
    | mkQ2Y : lstate Y -> Q2st.

    Definition q2y (q:Q2st) :=
    match q with
    | mkQ2 _ y _ => y
    | mkQ2Y y => y
    end.

    Inductive Q2step : Q2st -> option O -> lift Q2st -> Prop :=
    | Q2step1 : forall o x x' y y' (H:R x y) (H':R x' y'),
        must_step X x o x' ->
        must_step Y y o y' ->
        Q2step (mkQ2 x y H) o (into (mkQ2 x' y' H'))
    | Q2step2 : forall x x' y (H:R x y) (H':R x' y),
        must_step X x None x' ->
        Q2step (mkQ2 x y H) None (into (mkQ2 x' y H'))
    | Q2step3 : forall x y y' (H:R x y) (H':R x y'),
        must_step Y y None y' ->
        Q2step (mkQ2 x y H) None (into (mkQ2 x y' H'))
    | Q2step4 : forall y H,
        Q2step (mkQ2 (mho _) y H) None (into (mkQ2Y y))
    | Q2step5 : forall y o y',
        must_step Y y o y' ->
        Q2step (mkQ2Y y) o (into (mkQ2Y y'))
    | Q2step6 :
        Q2step (mkQ2Y (mho _)) None (mho _).

    Definition Q2 := Build_LTS Q2st Q2step.

    Definition Q1toQ2 (q:Q1st) : Q2st :=
      match q with mkQ1 x y Hxy => mkQ2 x y Hxy end.

    Lemma Q1Q2_wrong_expansion : wrong_expansion Q1 Q2 Q1toQ2.

    Lemma XQ1_bisim : bisimulation branch X Q1 (fun x q => lift_join (lift_map q1x q) = x).

    Lemma Q2Y_bisim : bisimulation branch Q2 Y (fun q y =>
      match q with
      | mho => y = mho _
      | into (mkQ2 x y' _) => y' = y
      | into (mkQ2Y y') => y' = y
      end).
  End expands_refine.

  Lemma wrong_expands_refine X Y f :
    wrong_expansion X Y f ->
    refinement branch X Y (wrong_rel X Y (fun x y => f x = y)).

  Theorem branch_expands_branch_ref X Y x y :
    refines branch X Y x y <-> wrong_expands' X Y x y.

  Lemma branch_forward_step_right : forall A B (R:lstate A -> lstate B -> Prop) a b b',
    must_step B b None b' ->
    R a b ->
    branch_forward_ind_no_stutter A B R a b' ->
    branch_forward_ind_no_stutter A B R a b.

  Lemma branch_forward_step_right' : forall A B (R:lstate A -> lstate B -> Prop) a b b',
    steps B b None b' ->
    R a (into b) ->
    branch_forward_ind_no_stutter A B R a b' ->
    branch_forward_ind_no_stutter A B R a (into b).

  Lemma branch_backward_step_left : forall A B (R:lstate A -> lstate B -> Prop) a b a',
    may_step A a None a' ->
    R a b ->
    branch_backward_ind_no_stutter A B R a' b ->
    branch_backward_ind_no_stutter A B R a b.

  Lemma branch_backward_step_left' : forall A B (R:lstate A -> lstate B -> Prop) a b a',
    steps A a None a' ->
    R (into a) b ->
    branch_backward_ind_no_stutter A B R a' b ->
    branch_backward_ind_no_stutter A B R (into a) b.

  Lemma refines_mho_forward_no_stutter : forall A B C (R:lstate A -> lstate B -> Prop) a,
    (forall x, refines branch_ind A C x (mho _) -> R x (mho _)) ->
    refines branch_ind A C a (mho _) ->
    branch_forward_ind_no_stutter A B R a (mho _).

  Lemma refines_mho_backward_no_stutter : forall A B C (R:lstate A -> lstate B -> Prop) a,
    (forall x, refines branch_ind A C x (mho _) -> R x (mho _)) ->
    refines branch_ind A C a (mho _) ->
    branch_backward_ind_no_stutter A B R a (mho _).

  Lemma branch_forward_ind_to_no_stutter : forall X Y R,
    refinement branch_forward_ind X Y R ->
    refinement branch_forward_ind_no_stutter X Y R.

  Lemma branch_back_ind_to_no_stutter : forall X Y R,
    refinement branch_backward_ind X Y R ->
    refinement branch_backward_ind_no_stutter X Y R.

  Lemma branch_ind_to_no_stutter : forall X Y R,
    refinement branch_ind X Y R ->
    refinement branch_ind_no_stutter X Y R.

  Lemma branch_forward_to_no_stutter : forall X Y R,
    refinement branch_forward X Y R ->
    refinement branch_forward_no_stutter X Y R.

  Lemma branch_back_to_no_stutter : forall X Y R,
    refinement branch_backward X Y R ->
    refinement branch_backward_no_stutter X Y R.

  Lemma branch_to_no_stutter : forall X Y R,
    refinement branch X Y R ->
    refinement branch_no_stutter X Y R.

  Definition stuttering_closure X Y (R:lstate X -> lstate Y -> Prop) x y :=
    exists x0, exists x1, exists y0, exists y1,
      may_step_star X x0 x /\
      may_step_star X x x1 /\
      may_step_star Y y0 y /\
      may_step_star Y y y1 /\
      R x0 y1 /\
      R x1 y0.

  Lemma stuttering_path : forall X Y (R:lstate X -> lstate Y -> Prop) y y1,
    may_step_star Y y y1 ->
    forall x0 x1 y0,
      R x1 y0 -> R x0 y1 ->
      may_step_star Y y0 y ->
      may_step_star X x0 x1 ->
      path_where _ (fun a b => must_step Y a None b) (stuttering_closure X Y R x0) y y1.

  Lemma stuttering_path' :
    forall X Y (R:lstate X -> lstate Y -> Prop) x x1,
      may_step_star X x x1 ->
      forall y0 y1 x0,
        R x1 y0 -> R x0 y1 ->
        may_step_star X x0 x ->
        must_step_star Y y0 y1 ->
        path_where _ (fun a b => may_step X a None b) (fun x => stuttering_closure X Y R x y0) x x1.

  Lemma stuttering_closure_incl : forall X Y (R:lstate X -> lstate Y -> Prop) x y,
    R x y -> stuttering_closure X Y R x y.

  Lemma stuttering_push_right : forall X Y R x y,
    refinement branch_forward_no_stutter X Y R ->
    stuttering_closure X Y R x y ->
    forall x_, contains x x_ ->
    exists y',
      path_where _ (fun a b => must_step Y a None b) (fun y => stuttering_closure X Y R x y) y y' /\
      R x y'.

  Lemma stuttering_push_left : forall X Y R x y,
    refinement branch_backward_no_stutter X Y R ->
    stuttering_closure X Y R x y ->
    exists x',
      path_where _ (fun a b => may_step X a None b) (fun x => stuttering_closure X Y R x y) x x' /\
      R x' y.

  Lemma stuttering_is_branch_forward : forall X Y R,
    refinement branch_forward_no_stutter X Y R ->
    refinement branch_forward X Y (stuttering_closure X Y R).

  Lemma stuttering_is_branch_backward : forall X Y R,
    refinement branch_backward_no_stutter X Y R ->
    refinement branch_backward X Y (stuttering_closure X Y R).

  Lemma stuttering_is_branch : forall X Y R,
    refinement branch_no_stutter X Y R ->
    refinement branch X Y (stuttering_closure X Y R).

  Lemma branch_forward_branch_ind_no_stutter : forall X Y R,
    refinement branch_forward_ind_no_stutter X Y R ->
    refinement branch_forward_no_stutter X Y R.

  Lemma branch_back_branch_ind_no_stutter : forall X Y R,
    refinement branch_backward_ind_no_stutter X Y R ->
    refinement branch_backward_no_stutter X Y R.

  Lemma branch_branch_ind_no_stutter : forall X Y R,
    refinement branch_ind_no_stutter X Y R ->
    refinement branch_no_stutter X Y R.

  Lemma branch_forward_branch_ind : forall X Y R,
    refinement branch_forward_ind X Y R ->
    refinement branch_forward X Y R.

  Lemma branch_back_branch_ind : forall X Y R,
    refinement branch_backward_ind X Y R ->
    refinement branch_backward X Y R.

  Lemma branch_branch_ind : forall X Y R,
    refinement branch_ind X Y R ->
    refinement branch X Y R.

  Lemma stuttering_is_branch_forward_ind : forall X Y R,
    refinement branch_forward_ind_no_stutter X Y R ->
    refinement branch_forward_ind X Y (stuttering_closure X Y R).

  Lemma stuttering_is_branch_backward_ind : forall X Y R,
    refinement branch_backward_ind_no_stutter X Y R ->
    refinement branch_backward_ind X Y (stuttering_closure X Y R).

  Lemma stuttering_is_branch_ind : forall X Y R,
    refinement branch_ind_no_stutter X Y R ->
    refinement branch_ind X Y (stuttering_closure X Y R).

  Theorem branch_stutter_eq : forall X Y x y,
    refines branch X Y x y <->
    refines branch_no_stutter X Y x y.

  Theorem branch_ind_stutter_eq : forall X Y x y,
    refines branch_ind X Y x y <->
    refines branch_ind_no_stutter X Y x y.

  Theorem bisim_branch_ind_stutter_eq : forall X Y x y,
    bisimilar branch_ind X Y x y <->
    bisimilar branch_ind_no_stutter X Y x y.

  Lemma goes_wrong_step_star : forall A a a',
    goes_wrong A a ->
    may_step_star A a a' ->
    goes_wrong A a'.

  Lemma stuttering_inv : forall A B R,
    inv (stuttering_closure A B R) = stuttering_closure B A (inv R).

  Lemma prove_branch_ind_bisim : forall A B R,
    refinement branch_forward_ind_no_stutter A B R ->
    refinement branch_forward_ind_no_stutter B A (inv R) ->
    (forall x y, R x y -> goes_wrong B y -> goes_wrong A x) ->
    (forall x y, R x y -> goes_wrong A x -> goes_wrong B y) ->
    (forall x y, R x y -> bisimilar branch_ind A B x y).

  Lemma accessible_refl : forall x, accessible branch x x.

  Lemma accessible_trans : forall x y z,
    accessible branch x y ->
    accessible branch y z ->
    accessible branch x z.

  Definition cond_D1 X Y R x y :=
    forall D,
      must_divergence_set X D -> D x ->
      exists x', exists y',
        D x' /\ must_step Y y None y' /\
        R x' y'.

  Definition cond_D2 X Y R x y :=
    forall D,
      must_divergence_set X D -> D x ->
      must_diverge Y (fun y' => exists x', D x' /\ R x' y') y.

  Definition cond_D1' X Y R x y :=
    forall D,
      may_divergence_set Y D -> D y ->
      exists x', exists y',
        D y' /\ may_step X x None x' /\
        R x' y'.

  Definition cond_D2' X Y R x y :=
    forall D,
      may_divergence_set Y D -> D y ->
      may_diverge X (fun x' => exists y', D y' /\ R x' y') x.

  Lemma cond_D1_D2 : forall X Y R,
    refinement cond_D1 X Y R <-> refinement cond_D2 X Y R.

  Lemma cond_D1_D2' : forall X Y R,
    refinement cond_D1' X Y R <-> refinement cond_D2' X Y R.

  Lemma cond_D2_eq : forall X,
    refinement cond_D2 X X eq.

  Lemma cond_D2'_eq : forall X,
    refinement cond_D2' X X eq.

  Lemma cond_D2_compose : forall X Y Z R1 R2,
    refinement cond_D2 X Y R1 ->
    refinement cond_D2 Y Z R2 ->
    refinement cond_D2 X Z (comp R1 R2).

  Lemma cond_D2'_compose : forall X Y Z R1 R2,
    refinement cond_D2' X Y R1 ->
    refinement cond_D2' Y Z R2 ->
    refinement cond_D2' X Z (comp R1 R2).

  Lemma cond_D1_stutter : forall X Y R,
    refinement branch_forward_no_stutter X Y R ->
    refinement cond_D1 X Y R ->
    refinement cond_D1 X Y (stuttering_closure X Y R).

  Lemma cond_D1'_stutter : forall X Y R,
    refinement branch_backward_no_stutter X Y R ->
    refinement cond_D1' X Y R ->
    refinement cond_D1' X Y (stuttering_closure X Y R).

  Lemma branch_forward_ind_D1 : forall X Y R,
    refinement branch_forward_ind X Y R ->
    refinement cond_D1 X Y R.

  Lemma branch_backward_ind_D1' : forall X Y R,
    refinement branch_backward_ind X Y R ->
    refinement cond_D1' X Y R.

  Lemma branch_D1_forward_ind {Classic:EM} : forall X Y R,
    refinement (td_and branch_forward cond_D1) X Y R ->
    refinement branch_forward_ind X Y R.

  Lemma branch_D1'_backward_ind {Classic:EM} : forall X Y R,
    refinement (td_and branch_backward cond_D1') X Y R ->
    refinement branch_backward_ind X Y R.

  Definition branch_div :=
    td_and branch (td_and cond_D1 cond_D1').

  Definition branch_div2 :=
    td_and branch (td_and cond_D2 cond_D2').

  Lemma branch_div12 : forall X Y R,
    refinement branch_div X Y R <->
    refinement branch_div2 X Y R.

  Theorem branch_ind_div : forall X Y R,
    refinement branch_ind X Y R ->
    refinement branch_div X Y R.

  Theorem branch_div_ind {Classic:EM} : forall X Y R,
    refinement branch_div X Y R ->
    refinement branch_ind X Y R.

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

  Lemma cond_D1'_mono : forall X Y (R1 R2:lstate X -> lstate Y -> Prop) x y,
    (forall x y, R1 x y -> R2 x y) ->
    cond_D1' X Y R1 x y ->
    cond_D1' X Y R2 x y.

  Lemma refines_div_stutter : forall X Y R,
    refinement branch_div X Y R ->
    refinement branch_div X Y (stuttering_closure X Y R).

  Theorem refines_div_refl : forall X x,
    refines branch_div X X x x.

  Lemma bisim_branch_div_refl : forall X x,
    bisimilar branch_div X X x x.

  Theorem refines_div_trans : forall X Y Z x y z,
    refines branch_div X Y x y ->
    refines branch_div Y Z y z ->
    refines branch_div X Z x z.

  Theorem bisim_div_trans : forall X Y Z x y z,
    bisimilar branch_div X Y x y ->
    bisimilar branch_div Y Z y z ->
    bisimilar branch_div X Z x z.

  Theorem refines_div_refinement X Y :
    refinement branch_div X Y (refines branch_div X Y).

Lemma refines_ind_mho_tau : forall X Y x o x',
  refines branch_ind X Y x (mho _) ->
  may_step X x o x' ->
  refines branch_ind X Y x' (mho _).

Lemma refines_ind_mho_star : forall X Y x x',
  refines branch_ind X Y x (mho _) ->
  reachable' X x x' ->
  refines branch_ind X Y x' (mho _).

Lemma refines_ind_mho_path_where_mho : forall X Y x,
  refines branch_ind X Y x (mho _) ->
  path_where _
    (fun a b => must_step X a None b)
    (fun x => refines branch_ind X Y x (mho _))
    x (mho _).

Lemma loop_simulation X :
  refinement branch_ind X X
     (fun x y => may_step_star X x y /\ may_step_star X y x).

Lemma loop_bisimulation X : bisimulation branch_ind X X
  (fun x y => may_step_star X x y /\ may_step_star X y x).

End branch_ref.
End BRANCH_REF.