Library par_semantics

Require Import base.

Require Import nominal.
Require Import syntax.
Require Import basic_semantics.

Section par_lts.
  Variables A B:LTS.
  Variable (x:VAR).

  Inductive par_step : (lstate A * lstate B) -> option OBS -> lift (lstate A * lstate B) -> Prop :=
    | par_stepA : forall a o a' b,
          ~support o x ->
          steps A a o a' ->
          par_step (into a,b) o (into (a',b))

    | par_stepB : forall b o b' a,
          ~support o x ->
          steps B b o b' ->
          par_step (a,into b) o (into (a,b'))

    | par_mho : forall a b,
          a = mho _ \/ b = mho _ ->
          par_step (a,b) None (mho _)

    | par_sync : forall a oa a' b ob b' v,
          obs_complement v oa ob ->
          steps A a (Some oa) a' ->
          steps B b (Some ob) b' ->

          par_step (into a, into b) None (into (a',b')).

  Definition par_lts := Build_LTS (lstate A * lstate B) par_step.

  Lemma par_prog_reachable : forall q1 q2,
    reachable' par_lts q1 q2 ->
    forall a b a' b', contains q1 (a,b) -> contains q2 (a',b') ->
      reachable' A a a' /\
      reachable' B b b'.
End par_lts.

Program Definition par_prog (x:VAR) (p1 p2:prog) :=
  Build_prog (par_lts (psys p1) (psys p2) x) (into (init p1),into (init p2)).

Lemma par_prog_support : forall x p1 p2 v,
  support (par_prog x p1 p2) v ->
  x <> v /\ (support p1 v \/ support p2 v).

Section par_lts_commute.
  Variable p:perm.
  Variable v:VAR.
  Variables x1 x2:prog.

  Let A := psys (papp p (par_prog v x1 x2)).
  Let B := psys (par_prog (papp p v) (papp p x1) (papp p x2)).

  Lemma par_prog_stepsAB : forall x o x',
    steps A x o x' <-> steps B x o x'.

  Lemma par_prog_papp_commute :
    papp p (par_prog v x1 x2) = par_prog (papp p v) (papp p x1) (papp p x2).
End par_lts_commute.


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

Section par_prog_peq.
  Variables x1 x2:VAR.
  Variables q1 q2 w1 w2:prog.

  Definition par_prog_peq_rel R1 R2 x y :=
  match x with
  | into (a1,a2) =>
      match y with
      | into (b1,b2) =>
          reachable' (psys q1) (into (init q1)) a1 /\
          reachable' (psys w1) (into (init w1)) a2 /\
          reachable' (psys q2) (into (init q2)) b1 /\
          reachable' (psys w2) (into (init w2)) b2 /\
          R1 a1 b1 /\ R2 a2 b2
      | mho => a1 = mho _/\ a2 = mho _
      end
  | mho => y = mho _ \/ (y = into (mho _, mho _))
  end.

  Lemma must_step_star_left : forall v A B x y q,
    must_step_star (psys A) x y ->
    must_step_star (psys (par_prog v A B)) (into (x, q)) (into (y, q)).

  Lemma must_step_star_right : forall v A B x y q,
    must_step_star (psys B) x y ->
    must_step_star (psys (par_prog v A B)) (into (q, x)) (into (q, y)).

  Lemma may_step_star_left : forall v A B x y q,
    may_step_star (psys A) x y ->
    may_step_star (psys (par_prog v A B)) (into (x, q)) (into (y, q)).

  Lemma may_step_star_right : forall v A B x y q,
    may_step_star (psys B) x y ->
    may_step_star (psys (par_prog v A B)) (into (q, x)) (into (q, y)).

  Lemma must_step_papp : forall A x y,
    must_step_star (papp (perm_swap x1 x2) (psys A)) x y ->
    must_step_star (psys A) x y.

  Hypothesis Hsupport :
    x1 = x2 \/
    (~support q1 x2 /\ ~support w1 x2 /\
     ~support q2 x1 /\ ~support w2 x1).

Opaque lts_nominal.

  Lemma par_refines_peq_wrong0 : forall R1 R2
    (HR1 : bisimulation branch_ind (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1)
    (HR2 : bisimulation branch_ind (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2)
    b1 b2 a1 a2,
    R1 a1 b1 -> R2 a2 b2 ->
    goes_wrong (psys (par_prog x2 q2 w2)) (into (b1, b2)) ->
    exists x' : lift (state (psys (par_prog x1 q1 w1))),
      steps (psys (par_prog x1 q1 w1)) (a1, a2) None x'.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma par_refines_peq_wrong1 R1 R2 :
    forall (HR1 : bisimulation branch_ind (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1),
    forall (HR2 : bisimulation branch_ind (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2),

    forall a b,
      par_prog_peq_rel R1 R2 a b ->
      goes_wrong (psys (par_prog x2 q2 w2)) b ->
      goes_wrong (psys (par_prog x1 q1 w1)) a.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma par_refines_peq_forward R1 R2 :
    forall z1 t1, branch_forward_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1 z1 t1 ->
    forall z2 t2, branch_forward_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2 z2 t2 ->

    reachable' (psys q1) (into (init q1)) z1 ->
    reachable' (psys w1) (into (init w1)) z2 ->
    reachable' (psys q2) (into (init q2)) t1 ->
    reachable' (psys w2) (into (init w2)) t2 ->

    forall (HR1 : refinement branch_forward_ind_no_stutter _ _ R1),
    forall (HR2 : refinement branch_forward_ind_no_stutter _ _ R2),
    forall (HR1_mho : R1 (mho _) (mho _)),
    forall (HR2_mho : R2 (mho _) (mho _)),
    forall (HR1_mho' : forall x, R1 (mho _) x ->
      must_step_star _ x (mho _)),
    forall (HR2_mho' : forall x, R2 (mho _) x ->
      must_step_star _ x (mho _)),

      R1 z1 t1 -> R2 z2 t2 ->
      
    branch_forward_ind_no_stutter
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_peq_rel R1 R2)
      (into (z1,z2)) (into (t1,t2)).
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma bisimilar_ind_no_stuttter_mho_mho : forall A B,
      bisimilar branch_ind_no_stutter A B (mho _) (mho _).

  Lemma branch_ind_branch_ind_no_stutter : forall A B R x y,
    branch_ind A B R x y ->
    branch_ind_no_stutter A B R x y.

  Lemma bisimilar_ind_no_sutter_bisimulation_stutter : forall A B,
    bisimulation branch_ind A B
     (bisimilar branch_ind_no_stutter A B).

  Lemma bisimilar_ind_no_stuttter_bisimulation : forall A B,
    bisimulation branch_ind_no_stutter A B
      (bisimilar branch_ind_no_stutter A B).

  Lemma par_prog_peq_rel_refinement :
    refinement branch_forward_ind_no_stutter
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_peq_rel
        (bisimilar branch_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)))
        (bisimilar branch_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)))).

End par_prog_peq.

Opaque lts_nominal.

Lemma peq_rel_inv : forall x1 x2 q1 q2 w1 w2,
  inv (par_prog_peq_rel q1 q2 w1 w2
    (bisimilar branch_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)))
    (bisimilar branch_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)))) =
    par_prog_peq_rel _ _ _ _
      (bisimilar branch_ind_no_stutter (psys q2) (papp (perm_swap x2 x1) (psys q1)))
      (bisimilar branch_ind_no_stutter (psys w2) (papp (perm_swap x2 x1) (psys w1))).

Lemma par_prog_peq : forall x1 x2 q1 q2 w1 w2,
    x1 = x2 \/
    (~support q1 x2 /\ ~support w1 x2 /\
     ~support q2 x1 /\ ~support w2 x1) ->
  peq q1 (papp (perm_swap x1 x2) q2) ->
  peq w1 (papp (perm_swap x1 x2) w2) ->

  peq (par_prog x1 q1 w1) (par_prog x2 q2 w2).

Lemma par_prog_peq' : forall x q1 q2 w1 w2,
  peq q1 q2 ->
  peq w1 w2 ->

  peq (par_prog x q1 w1) (par_prog x q2 w2).

Section par_prog_pacc.
  Variables x1 x2:VAR.
  Variables q1 q2 w1 w2:prog.

  Definition par_prog_pacc_rel R1 R2 x y :=
  match x with
  | into (a1,a2) =>
      reachable' (psys q1) (into (init q1)) a1 /\
      reachable' (psys w1) (into (init w1)) a2 /\
      match y with
      | into (b1,b2) =>
          reachable' (psys q2) (into (init q2)) b1 /\
          reachable' (psys w2) (into (init w2)) b2 /\
          R1 a1 b1 /\ R2 a2 b2
      | mho => False
      end
  | mho => True
  end.

  Hypothesis Hsupport :
    x1 = x2 \/
    (~support q1 x2 /\ ~support w1 x2 /\
     ~support q2 x1 /\ ~support w2 x1).

Opaque lts_nominal.

  Lemma par_refines_choice_forward R1 R2 :
    forall z1 t1, choice_forward' (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1 z1 t1 ->
    forall z2 t2, choice_forward' (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2 z2 t2 ->

    reachable' (psys q1) (into (init q1)) z1 ->
    reachable' (psys w1) (into (init w1)) z2 ->
    reachable' (psys q2) (into (init q2)) t1 ->
    reachable' (psys w2) (into (init w2)) t2 ->

    forall (HR1 : refinement choice_forward' _ _ R1),
    forall (HR2 : refinement choice_forward' _ _ R2),
      
    choice_forward'
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_pacc_rel R1 R2)
      (into (z1,z2)) (into (t1,t2)).
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma par_refines_forward R1 R2 :
    forall z1 t1, branch_forward_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1 z1 t1 ->
    forall z2 t2, branch_forward_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2 z2 t2 ->

    reachable' (psys q1) (into (init q1)) z1 ->
    reachable' (psys w1) (into (init w1)) z2 ->
    reachable' (psys q2) (into (init q2)) t1 ->
    reachable' (psys w2) (into (init w2)) t2 ->

    forall (HR1 : refinement branch_forward_ind_no_stutter _ _ R1),
    forall (HR2 : refinement branch_forward_ind_no_stutter _ _ R2),

      R1 z1 t1 -> R2 z2 t2 ->
      
    branch_forward_ind_no_stutter
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_pacc_rel R1 R2)
      (into (z1,z2)) (into (t1,t2)).
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma par_refines_backward R1 R2 :
    forall z1 t1, branch_backward_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)) R1 z1 t1 ->
    forall z2 t2, branch_backward_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)) R2 z2 t2 ->

    reachable' (psys q1) (into (init q1)) z1 ->
    reachable' (psys w1) (into (init w1)) z2 ->
    reachable' (psys q2) (into (init q2)) t1 ->
    reachable' (psys w2) (into (init w2)) t2 ->

    forall (HR1 : refinement branch_backward_ind_no_stutter _ _ R1),
    forall (HR2 : refinement branch_backward_ind_no_stutter _ _ R2),
    forall (HR1mho:forall x, R1 x (mho _) -> must_step_star _ x (mho _)),
    forall (HR1mho2 : R1 (mho _) (mho _)),
    forall (HR2mho:forall x, R2 x (mho _) -> must_step_star _ x (mho _)),
    forall (HR2mho2 : R2 (mho _) (mho _)),

      R1 z1 t1 -> R2 z2 t2 ->
      
    branch_backward_ind_no_stutter
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_pacc_rel R1 R2)
      (into (z1,z2)) (into (t1,t2)).
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.
Transparent lts_nominal.
Opaque lts_nominal.

  Lemma refines_choice_mho : forall A B x,
    refines choice A B (mho _) x.

  Lemma par_prog_choice_pacc_rel_refinement :
    refinement (td_and choice_forward' branch_backward_ind_no_stutter)
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_pacc_rel
        (refines (td_and choice_forward' branch_backward_ind_no_stutter)
             (psys q1) (papp (perm_swap x1 x2) (psys q2)))
        (refines (td_and choice_forward' branch_backward_ind_no_stutter)
             (psys w1) (papp (perm_swap x1 x2) (psys w2)))).

  Lemma par_prog_pacc_rel_refinement :
    refinement branch_ind_no_stutter
      (psys (par_prog x1 q1 w1))
      (psys (par_prog x2 q2 w2))
      (par_prog_pacc_rel
        (refines branch_ind_no_stutter (psys q1) (papp (perm_swap x1 x2) (psys q2)))
        (refines branch_ind_no_stutter (psys w1) (papp (perm_swap x1 x2) (psys w2)))).
End par_prog_pacc.

Lemma par_prog_pacc : forall x1 x2 q1 q2 w1 w2,
    x1 = x2 \/
    (~support q1 x2 /\ ~support w1 x2 /\
     ~support q2 x1 /\ ~support w2 x1) ->
  pacc q1 (papp (perm_swap x1 x2) q2) ->
  pacc w1 (papp (perm_swap x1 x2) w2) ->

  pacc (par_prog x1 q1 w1) (par_prog x2 q2 w2).

Lemma par_prog_pacc' : forall x q1 q2 w1 w2,
  pacc q1 q2 ->
  pacc w1 w2 ->
  pacc (par_prog x q1 w1) (par_prog x q2 w2).

Lemma par_prog_choice_pacc : forall x1 x2 q1 q2 w1 w2,
    x1 = x2 \/
    (~support q1 x2 /\ ~support w1 x2 /\
     ~support q2 x1 /\ ~support w2 x1) ->
  choice_pacc q1 (papp (perm_swap x1 x2) q2) ->
  choice_pacc w1 (papp (perm_swap x1 x2) w2) ->

  choice_pacc (par_prog x1 q1 w1) (par_prog x2 q2 w2).

Lemma par_prog_choice_pacc' : forall x q1 q2 w1 w2,
  choice_pacc q1 q2 ->
  choice_pacc w1 w2 ->
  choice_pacc (par_prog x q1 w1) (par_prog x q2 w2).

Lemma refines_mho_par_lemma : forall P A v z pb
  (HsupportP : forall p o p',
      steps P p o p' -> support o v),
  refines branch_ind A void_lts z (mho _) ->
  refines branch_ind (par_lts P A v) void_lts
  (into (pb, z)) (mho Empty_set).