Library stmt_semantics

Require Import base.

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

Inductive seq_ctl_st :=
| seq_stA
| seq_stB.

Module SEQ_INPUT <: SEQ_CTL_INPUT.
  Definition ctl_st := seq_ctl_st.
  Definition ctl_transfer (cs:ctl_st) (z:Z) : (ctl_st + Z) :=
    match cs with
    | seq_stA => inl _ seq_stB
    | seq_stB => inr _ z
    end.

  Definition ctl_st_init := seq_stA.
  Lemma ctl_st_eq_dec : forall x y:ctl_st, {x=y}+{x<>y}.
End SEQ_INPUT.

Module SEQ := SEQ_CTL(SEQ_INPUT).

Definition seq_choose (p q:prog) (x:seq_ctl_st) :=
  match x with seq_stA => p | seq_stB => q end.

Definition seq_prog (p q:prog) :=
  SEQ.ctl_prog (seq_choose p q).

Lemma seq_prog_support : forall p1 p2 v,
  support (seq_prog p1 p2) v ->
  support p1 v \/ support p2 v.

Lemma seq_prog_papp_commute : forall p x1 x2,
  papp p (seq_prog x1 x2) = seq_prog (papp p x1) (papp p x2).

Lemma seq_prog_peq : forall p1 p2 q1 q2,
  peq p1 p2 ->
  peq q1 q2 ->
  peq (seq_prog p1 q1) (seq_prog p2 q2).

Lemma seq_prog_pacc : forall p1 p2 q1 q2,
  pacc p1 p2 ->
  pacc q1 q2 ->
  pacc (seq_prog p1 q1) (seq_prog p2 q2).

Lemma seq_prog_choice_pacc : forall p1 p2 q1 q2,
  choice_pacc p1 p2 ->
  choice_pacc q1 q2 ->
  choice_pacc (seq_prog p1 q1) (seq_prog p2 q2).

Inductive ifte_state :=
    | ifte_expr
    | ifte_A
    | ifte_B.

Module IFTE_INPUT <: SEQ_CTL_INPUT.
  Definition ctl_st := ifte_state.
  Definition ctl_transfer (cs:ctl_st) (z:Z) : (ctl_st + Z) :=
    match cs with
    | ifte_expr =>
          if (Z_eq_dec z 0)
            then inl _ ifte_B
            else inl _ ifte_A
    | ifte_A => inr _ z
    | ifte_B => inr _ z
    end.

  Definition ctl_st_init := ifte_expr.
  Lemma ctl_st_eq_dec : forall x y:ctl_st, {x=y}+{x<>y}.
End IFTE_INPUT.

Module IFTE := SEQ_CTL(IFTE_INPUT).

Definition ifte_prog e x1 x2 :=
  IFTE.ctl_prog
  (fun x => match x with
            | ifte_expr => e
            | ifte_A => x1
            | ifte_B => x2
            end).

Lemma ifte_prog_support : forall e p1 p2 v,
  support (ifte_prog e p1 p2) v ->
  support e v \/ support p1 v \/ support p2 v.

Lemma ifte_prog_papp_commute : forall p e x1 x2,
  papp p (ifte_prog e x1 x2) = ifte_prog (papp p e) (papp p x1) (papp p x2).

Lemma ifte_prog_pacc : forall e1 e2 p1 p2 q1 q2,
  pacc e1 e2 ->
  pacc p1 p2 ->
  pacc q1 q2 ->
  pacc (ifte_prog e1 p1 q1) (ifte_prog e2 p2 q2).

Lemma ifte_prog_peq : forall e1 e2 p1 p2 q1 q2,
  peq e1 e2 ->
  peq p1 p2 ->
  peq q1 q2 ->
  peq (ifte_prog e1 p1 q1) (ifte_prog e2 p2 q2).

Lemma ifte_prog_choice_pacc : forall e1 e2 p1 p2 q1 q2,
  choice_pacc e1 e2 ->
  choice_pacc p1 p2 ->
  choice_pacc q1 q2 ->
  choice_pacc (ifte_prog e1 p1 q1) (ifte_prog e2 p2 q2).

Inductive while_state :=
    | while_expr
    | while_A.

Module WHILE_INPUT <: SEQ_CTL_INPUT.
  Definition ctl_st := while_state.
  Definition ctl_transfer (cs:ctl_st) (z:Z) : (ctl_st + Z) :=
    match cs with
    | while_expr =>
          if (Z_eq_dec z 0)
            then inr _ 0%Z
            else inl _ while_A

    | while_A => inl _ while_expr
    end.

  Definition ctl_st_init := while_expr.
  Lemma ctl_st_eq_dec : forall x y:ctl_st, {x=y}+{x<>y}.
End WHILE_INPUT.

Module WHILE:=SEQ_CTL(WHILE_INPUT).

Definition while_prog (e:prog) (p:prog) :=
  WHILE.ctl_prog
  (fun x => match x with
            | while_expr => e
            | while_A => p
            end).

Lemma while_prog_support : forall e p v,
  support (while_prog e p) v ->
  support e v \/ support p v.

Lemma while_prog_papp_commute : forall p e x,
  papp p (while_prog e x) = while_prog (papp p e) (papp p x).

Lemma while_prog_pacc : forall e1 e2 p1 p2,
  pacc e1 e2 ->
  pacc p1 p2 ->
  pacc (while_prog e1 p1) (while_prog e2 p2).

Lemma while_prog_peq : forall e1 e2 p1 p2,
  peq e1 e2 ->
  peq p1 p2 ->
  peq (while_prog e1 p1) (while_prog e2 p2).

Lemma while_prog_choice_pacc : forall e1 e2 p1 p2,
  choice_pacc e1 e2 ->
  choice_pacc p1 p2 ->
  choice_pacc (while_prog e1 p1) (while_prog e2 p2).

Fixpoint stmt_denote (s:STMT) : prog :=
  match s with
  | expr e => expr_prog e
  | seq s1 s2 => seq_prog (stmt_denote s1) (stmt_denote s2)
  | local x s => var_prog x (stmt_denote s)
  | ifte e s1 s2 => ifte_prog (expr_prog e) (stmt_denote s1) (stmt_denote s2)
  | while e s => while_prog (expr_prog e) (stmt_denote s)
  end.

Fixpoint lr_stmt_denote (s:STMT) : prog :=
  match s with
  | expr e => lr_expr_prog e
  | seq s1 s2 => seq_prog (lr_stmt_denote s1) (lr_stmt_denote s2)
  | local x s => var_prog x (lr_stmt_denote s)
  | ifte e s1 s2 => ifte_prog (lr_expr_prog e) (lr_stmt_denote s1) (lr_stmt_denote s2)
  | while e s => while_prog (lr_expr_prog e) (lr_stmt_denote s)
  end.

Theorem lr_stmt_choice_ref : forall s,
  choice_pacc (stmt_denote s) (lr_stmt_denote s).

Lemma stmt_support : forall s v,
  support (stmt_denote s) v ->
  In v (stmt_free_idents s).

Lemma pacc_trans : forall a b c,
  pacc a b -> pacc b c -> pacc a c.

Theorem stmt_papp_commute_eq :
  forall s p,
    peq
      (stmt_denote (papp p s))
      (papp p (stmt_denote s)).

Theorem stmt_papp_commute1 :
  forall s p,
    pacc
      (stmt_denote (papp p s))
      (papp p (stmt_denote s)).

Theorem stmt_papp_commute2 :
  forall s p,
    pacc
      (papp p (stmt_denote s))
      (stmt_denote (papp p s)).

Lemma papp_stmt_denote : forall s p,
  (forall v, In v (stmt_free_idents s) -> perm_f p v = v) ->
  peq (stmt_denote (papp p s)) (stmt_denote s).

Theorem alpha_conversion : forall s1 s2,
  alpha_eq s1 s2 ->
  peq (stmt_denote s1) (stmt_denote s2).