Library basic_semantics

Require Import base.
Require Import ZArith.
Require Import ZArith_dec.

Require Import nominal.
Require Import syntax.
Require Import iface. Export CI.

Instance OBS_SYS : ObservationSystem :=
  { O := OBS; observations_inhabited := obs_val 0%Z }.

Lemma LTS_ext : forall A (S1 S2:A -> option O -> lift A -> Prop),
  (forall a o a', S1 a o a' <-> S2 a o a') ->
  Build_LTS A S1 = Build_LTS A S2.

Program Instance lts_nominal : Nominal LTS eq :=
  {| papp p X :=
       Build_LTS (state X)
          (fun x o x' => steps X x (papp (perm_inv p) o) x')
   ; support X v := exists x, exists o, exists x',
                      steps X x o x' /\ support o v
   |}.

Record prog :=
  { psys : LTS
  ; init : state psys
  }.

Definition pacc (p1 p2:prog) :=
  refines branch_ind (psys p1) (psys p2) (into (init p1)) (into (init p2)).

Definition choice_pacc (p1 p2: prog) :=
  refines choice (psys p1) (psys p2) (into (init p1)) (into (init p2)).

Definition peq (p1 p2:prog) :=
  bisimilar branch_ind (psys p1) (psys p2) (into (init p1)) (into (init p2)).

Lemma pacc_refl' : forall p1 p2,
  p1 = p2 -> pacc p1 p2.

Lemma peq_refl : forall a, peq a a.

Lemma peq_trans : forall a b c,
  peq a b -> peq b c -> peq a c.

Lemma prog_ext : forall A S1 S2 (r1:state (Build_LTS A S1)) (r2:state (Build_LTS A S2)),
  (forall a o a', S1 a o a' <-> S2 a o a') ->
  r1 = r2 ->
  Build_prog (Build_LTS A S1) r1 = Build_prog (Build_LTS A S2) r2.

Lemma reachable'_papp1 : forall p X q1 q2,
  reachable' X q1 q2 -> reachable' (papp p X) q1 q2.

Lemma reachable'_papp2 : forall p X q1 q2,
  reachable' (papp p X) q1 q2 ->
  reachable' X q1 q2.

Definition prog_papp (p:perm) (g:prog) :=
  Build_prog (papp p (psys g)) (init g).

Lemma prog_papp_refinement : forall p (X:LTS) a,
  (forall v,
    (exists x, exists o, exists x',
           reachable' X a (into x) /\
           steps _ x o x' /\ support o v) -> perm_f p v = v) ->
  let X' := @papp LTS eq lts_nominal p X in
    refinement branch_ind X' X
      (fun (x:lstate X') (y:lstate X) => x = y /\ reachable' X a x).

Lemma prog_papp_refinement' : forall p (X:LTS) a,
  (forall v,
    (exists x, exists o, exists x',
           reachable' X a (into x) /\
           steps _ x o x' /\ support o v) -> perm_f p v = v) ->
  let X' := @papp LTS eq lts_nominal p X in
    refinement branch_ind X X'
      (inv (fun (x:lstate X') (y:lstate X) => x = y /\ reachable' X a x)).

Lemma prog_papp_bisimulation : forall p (X:LTS) a,
  (forall v,
    (exists x, exists o, exists x',
           reachable' X a (into x) /\
           steps _ x o x' /\ support o v) -> perm_f p v = v) ->
  let X' := @papp LTS eq lts_nominal p X in
    bisimulation branch_ind X' X
      (fun (x:lstate X') (y:lstate X) => x = y /\ reachable' X a x).

Lemma prog_papp_bisimilar : forall p (X:LTS) a,
  (forall v,
    (exists x, exists o, exists x',
           reachable' X a (into x) /\
           steps _ x o x' /\ support o v) -> perm_f p v = v) ->
  let X' := @papp LTS eq lts_nominal p X in
    bisimilar branch_ind X' X a a.

Program Instance prog_nominal : Nominal prog peq :=
  {| papp p g := prog_papp p g
   ; support g v :=
         exists x, exists o, exists x',
           reachable' (psys g) (into (init g)) (into x) /\
           steps _ x o x' /\ support o v
   |}.
Obligation Tactic := idtac.

Section strong_refinement.
  Variables A B:LTS.
  Variable R:state A -> state B -> Prop.

  Definition lift_rel (la:lstate A) (lb:lstate B) :=
    match la, lb with
    | mho, _ => True
    | into a, into b => R a b
    | _, _ => False
    end.

  Definition strong_refinement :=
    forall a b, R a b ->
      (forall o a', steps A a o a' ->
        exists b', steps B b o b' /\
          lift_rel a' b') /\
      (forall o b', steps B b o b' ->
        exists a', steps A a o a' /\
          lift_rel a' b').

  Lemma strong_refinement_branch_forward :
    strong_refinement ->
    forall a b, R a b -> branch_forward_ind A B lift_rel (into a) (into b).

  Lemma strong_refinement_branch_backward :
    strong_refinement ->
    forall a b, R a b -> branch_backward_ind A B lift_rel (into a) (into b).
End strong_refinement.

Definition strong_refines A B a b :=
  exists R, strong_refinement A B R /\ lift_rel A B R a b.

Lemma strong_refines_branch_ind : forall A B a b,
  strong_refines A B a b -> refines branch_ind A B a b.

Section strong_birefinement.
  Variables A B:LTS.
  Variable R:lstate A -> lstate B -> Prop.

  Definition strong_birefinement :=
    forall qa qb, R qa qb ->
      (qa = mho _ <-> qb = mho _) /\
      (forall a o a',
        contains qa a -> steps A a o a' ->
        exists b, exists b',
          contains qb b /\ steps B b o b' /\ R a' b') /\
      (forall b o b',
        contains qb b -> steps B b o b' ->
        exists a, exists a',
          contains qa a /\ steps A a o a' /\ R a' b').

  Lemma strong_birefinement_branch_forward :
    strong_birefinement ->
    forall qa qb, R qa qb -> branch_forward_ind A B R qa qb.

  Lemma strong_birefinement_branch_backward :
    strong_birefinement ->
    forall qa qb, R qa qb -> branch_backward_ind A B R qa qb.
End strong_birefinement.

Definition strong_birefines A B a b :=
  exists R, strong_birefinement A B R /\ R a b.

Lemma strong_birefinement_inv : forall A B R,
  strong_birefinement A B R ->
  strong_birefinement B A (inv R).

Lemma strong_birefinement_branch_ind : forall A B R a b,
  strong_birefinement A B R -> R a b ->
  refines branch_ind A B a b.

Lemma strong_birefinement_branch_ind2 : forall A B R a b,
  strong_birefinement A B R -> R a b ->
  refines branch_ind B A b a.

Lemma lockstep_branch_ind : forall A B (R:lstate A -> lstate B -> Prop) a b,
  R (into a) (into b) ->
  (forall o a', steps A a o a' ->
    exists b', steps B b o b' /\
      R a' b') ->
  (forall o b', steps B b o b' ->
    exists a', steps A a o a' /\
      R a' b') ->
  branch_ind A B R (into a) (into b).

Lemma refines_papp_id : forall X x,
  refines branch_ind X (papp perm_id X) x x.

Lemma refines_papp1 : forall p X Y x y,
  refines branch_ind X Y x y ->
  refines branch_ind (papp p X) (papp p Y) x y.

Lemma refines_papp2 : forall p X Y x y,
  refines branch_ind (papp p X) (papp p Y) x y ->
  refines branch_ind X Y x y.

Lemma refines_papp_inv : forall p X Y x y,
  refines branch_ind (papp p X) Y x y ->
  refines branch_ind X (papp (perm_inv p) Y) x y.

Lemma refines_papp_inv2 : forall p X Y x y,
  refines branch_ind X (papp (perm_inv p) Y) x y ->
  refines branch_ind (papp p X) Y x y.

Lemma bisim_papp_inv2 : forall p X Y x y,
  bisimilar branch_ind X (papp (perm_inv p) Y) x y ->
  bisimilar branch_ind (papp p X) Y x y.

Lemma strong_refines_refl : forall A a,
  strong_refines A A a a.

Definition mho_obs (o:option OBS) :=
  (exists v, o = Some (read v var_indeterm)) \/
  (exists v, o = Some (write v var_indeterm)).

Definition mho_obs_crashes (A:LTS) :=
  forall a o a',
    steps A a o a' ->
    mho_obs o ->
    refines branch_ind A void_lts a' (mho _).

Definition read_receptive (A:LTS) :=
  forall a v z a' z2,
    steps A a (Some (read v z)) a' ->
    exists a2, steps A a (Some (read v z2)) a2.