Library var_semantics

Require Import base.

Require Import nominal.
Require Import syntax.
Require Import basic_semantics.
Require Import expr_semantics.
Require Import par_semantics.

Section var_gadget.
  Variable (x:VAR).

  Inductive var_gadget_step : var_state -> option OBS -> lift var_state -> Prop :=
    | var_gadget_write_fail:
          var_gadget_step var_indeterm (Some (write x var_indeterm)) (mho _)

    | var_gadget_write : forall v,
          var_gadget_step (var_determ v) (Some (write x (var_determ v))) (into (var_determ v))

    | var_gadget_read_fail : forall s,
          var_gadget_step s (Some (read x var_indeterm)) (mho _)

    | var_gadget_read : forall s v,
          var_gadget_step s (Some (read x (var_determ v))) (into (var_determ v)).

  Definition var_gadget_lts := Build_LTS var_state var_gadget_step.
  Definition var_gadget init := Build_prog var_gadget_lts init.
End var_gadget.

Lemma var_gadget_support : forall x v init,
  support (var_gadget x init) v -> x = v.

Lemma refines_mho_par_var_lemma : forall p v b' z,
  refines branch_ind (psys p) void_lts b' (mho (state void_lts)) ->
  branch_ind (par_lts (var_gadget_lts v) (psys p) v)
     (par_lts (var_gadget_lts v) (psys p) v)
 (fun x y : lift (lift var_state * lstate (psys p)) =>
      match x with
      | into (into v1, p1) =>
          match y with
          | into (into v2, p2) => (v1 = var_indeterm \/ v1 = v2) /\ p1 = p2
          | into (mho, _) => False
          | mho => False
          end
      | into (mho, p1) => refines branch_ind (psys p) void_lts p1 (mho Empty_set)
      | mho => True
      end)
 (into (mho _, b')) z.

Lemma refines_par_var_indeterm : forall v pb p
  (Hread_recp : read_receptive (psys p))
  (Hcrash: mho_obs_crashes (psys p)),
  refines branch_ind (par_lts (var_gadget_lts v) (psys p) v)
     (par_lts (var_gadget_lts v) (psys p) v)
     (into (into var_indeterm, into (init p)))
     (into (into pb, into (init p))).

Lemma var_gadget_pacc : forall x1 x2 init,
  pacc (var_gadget x1 init) (papp (perm_swap x1 x2) (var_gadget x2 init)).

Lemma var_gadget_choice_pacc : forall x1 x2 init,
  choice_pacc (var_gadget x1 init) (papp (perm_swap x1 x2) (var_gadget x2 init)).

Lemma var_gadget_papp_commute : forall p v init,
  papp p (var_gadget v init) = var_gadget (papp p v) init.

Definition var_prog (x:VAR) (p:prog) :=
  par_prog x (var_gadget x var_indeterm) p.

Lemma var_prog_support : forall x p v,
  support (var_prog x p) v ->
  x <> v /\ support p v.

Lemma var_prog_papp_commute : forall p v x,
  papp p (var_prog v x) = var_prog (papp p v) (papp p x).

Lemma var_prog_pacc : forall x1 x2 p1 p2,
  x1 = x2 \/ (x1 <> x2 /\ ~support p2 x1 /\ ~support p1 x2) ->

  pacc p1 (papp (perm_swap x1 x2) p2) ->
  pacc (var_prog x1 p1) (var_prog x2 p2).

Lemma var_prog_pacc' : forall x p1 p2,
  pacc p1 p2 ->
  pacc (var_prog x p1) (var_prog x p2).

Opaque lts_nominal.

Lemma var_gadget_peq : forall x1 x2 init,
  peq (var_gadget x1 init) (papp (perm_swap x1 x2) (var_gadget x2 init)).
Transparent lts_nominal.

Lemma var_prog_peq : forall x1 x2 p1 p2,
  x1 = x2 \/ (x1 <> x2 /\ ~support p2 x1 /\ ~support p1 x2) ->

  peq p1 (papp (perm_swap x1 x2) p2) ->
  peq (var_prog x1 p1) (var_prog x2 p2).

Lemma var_prog_peq' : forall x p1 p2,
  peq p1 p2 ->
  peq (var_prog x p1) (var_prog x p2).

Lemma var_prog_choice_pacc : forall x1 x2 p1 p2,
  x1 = x2 \/ (x1 <> x2 /\ ~support p2 x1 /\ ~support p1 x2) ->

  choice_pacc p1 (papp (perm_swap x1 x2) p2) ->
  choice_pacc (var_prog x1 p1) (var_prog x2 p2).

Lemma var_prog_choice_pacc' : forall x p1 p2,
  choice_pacc p1 p2 ->
  choice_pacc (var_prog x p1) (var_prog x p2).

Lemma var_prog_read_receptive : forall v p,
  read_receptive (psys p) ->
  read_receptive (psys (var_prog v p)).

Lemma var_prog_mho_crashes : forall v p,
  mho_obs_crashes (psys p) ->
  mho_obs_crashes (psys (var_prog v p)).