Library config_stmt_semantics

Require Import Max.

Require Import base.

Require Import nominal.
Require Import syntax.
Require Import basic_semantics.
Require Import expr_semantics.
Require Import par_semantics.
Require Import var_semantics.
Require Import stmt_semantics.
Require Import config_semantics.


Definition mm_step (b:bool) :=
  if b then must_step else may_step.

Definition mm_step_star mm X :=
  clos_refl_trans _ (fun a b => mm_step mm X a None b).

Lemma mm_step_step1 : forall mm A x o x',
  mm_step mm A (into x) o x' -> steps A x o x'.

Lemma mm_step_step2 : forall mm A x o x',
  steps A x o x' ->
  mm_step mm A (into x) o x'.

Section mm_branch.

  Inductive branch_mm_ind (mm:bool) X Y R : lstate X -> lstate Y -> Prop :=
    branch_forward_ind_intro : forall x y,
      (forall o x', mm_step mm X x o x' ->
          (o = None /\ R x' y /\ branch_mm_ind mm X Y R x' y) \/
          exists y',
            mm_step_star mm Y y y' /\ R x y' /\
            exists y'', mm_step mm Y y' o y'' /\ R x' y'') ->
      branch_mm_ind mm X Y R x y.

  Lemma branch_mm_ind_ind
    : forall mm (X Y : LTS) (R P : lstate X -> lstate Y -> Prop),
       (forall (x : lstate X) (y : lstate Y),
        (forall o (x' : lstate X),
         mm_step mm X x o x' ->
         o = None /\ R x' y /\ P x' y \/
         (exists y',
            mm_step_star mm Y y y' /\ R x y' /\
            exists y'', mm_step mm Y y' o y'' /\ R x' y'')) ->
        P x y) ->
       forall (l : lstate X) (l0 : lstate Y),
       branch_mm_ind mm X Y R l l0 -> P l l0.

  Lemma mm_true_forward1 : forall X Y R x y,
    branch_mm_ind true X Y R x y ->
    branch_forward_ind_no_stutter X Y R x y.

  Lemma mm_true_forward2 : forall X Y R x y,
    branch_forward_ind_no_stutter X Y R x y ->
    branch_mm_ind true X Y R x y.

  Lemma mm_false_backward1 : forall X Y R x y,
    branch_mm_ind false Y X (inv R) y x ->
    branch_backward_ind_no_stutter X Y R x y.

  Lemma mm_false_backward2 : forall X Y R x y,
    branch_backward_ind_no_stutter X Y R x y ->
    branch_mm_ind false Y X (inv R) y x.
End mm_branch.

Lemma mm_local_step_star : forall mm v s a b vx,
  mm_step_star mm (psys (stmt_denote s)) a b ->
  mm_step_star mm (psys (stmt_denote (local v s)))
    (into (vx,a)) (into (vx,b)).

Lemma refines_mho_step_mho : forall mm A B a,
  refines branch_ind A B a (mho _) ->
  mm_step_star mm A a (mho _).


Lemma refines_mho_branch_mm2 : forall mm A B C (R:lstate A -> lstate B -> Prop) b,
  (forall x, refines branch_ind B C x (mho _) -> R (mho _) x) ->
  refines branch_ind B C b (mho _) ->
  branch_mm_ind mm A B R (mho _) b.

Definition list_max (l:list nat) :=
  fold_right max 0 l.

Lemma list_max_le : forall l x, In x l -> x <= list_max l.

Lemma list_max_fresh : forall l,
  ~In (S (list_max l)) l.

Lemma choose_fresh : forall (l:list nat),
  exists fresh, ~In fresh l.


Lemma refines_mho_local_lemma : forall A v z pb,
  refines branch_ind A void_lts z (mho _) ->
  refines branch_ind (par_lts (var_gadget_lts v) A v) void_lts
  (into (pb, z)) (mho Empty_set).

Fixpoint config_denote_match
  (s:STMT)
  (dom:list nat)
  (m:nat -> var_state)
  (env:ENV)
  (stk:list KCTL)
  (ex:expr_st)
  : state (psys (stmt_denote s)) -> Prop :=

  fun x =>
    config_invariants dom m env stk

    /\

  match s as s' return state (psys (stmt_denote s')) -> Prop with

  | expr e => fun x =>

       (stk = kstmt (expr e) :: nil
         /\ (exists z, ex = expr_select (const z))
         /\ x = init (stmt_denote (expr e)))

       \/

       (env = nil /\ stk = nil /\ ex = x)

  | seq s1 s2 => fun x =>
    match x with
    | SEQ.RUN seq_stA a =>

       (stk = kstmt (seq s1 s2) :: nil
         /\ (exists z, ex = expr_select (const z))
         /\ x = init (stmt_denote (seq s1 s2)))
      
       \/

       (exists k1, stk = k1 ++ kstmt s2 :: nil /\
         config_denote_match s1 dom m env k1 ex a
       )

    | SEQ.RUN seq_stB b =>

        config_denote_match s2 dom m env stk ex b

    | SEQ.FINISH =>

        stk = nil /\ ex = expr_finish

    end

  | local v s => fun x =>
      (stk = kstmt (local v s) :: nil
         /\ (exists z, ex = expr_select (const z))
         /\ x = init (stmt_denote (local v s)))
      \/
      (exists stk', stk = stk' ++ kenv v :: nil /\
       exists env', exists l, env = env' ++ (v,l) :: nil /\

        match x with
        | (mho, mho) => refines branch_ind config_lts void_lts (into (mk_config dom m env stk ex)) (mho _)
        | (_, mho) => refines branch_ind config_lts void_lts (into (mk_config dom m env stk ex)) (mho _)
        | (mho,into _) => False
        | (into vx, into x) =>

            m l = vx

            /\

            config_denote_match s dom m env' stk' ex x

        end)
      \/
      (stk = nil /\
        ((exists z, ex = expr_select (const z)) \/ ex = expr_finish) /\
        match x with
        | (mho, _) => False
        | (_,mho) => False
        | (into vx, into x) =>
           config_denote_match s dom m env stk ex x
        end
      )

  | ifte e s1 s2 => fun x =>
     match x with
     | IFTE.RUN ifte_expr e' =>
         
       (stk = kstmt (ifte e s1 s2) :: nil
         /\ (exists z, ex = expr_select (const z))
         /\ x = init (stmt_denote (ifte e s1 s2)))
      
       \/

       (stk = kif s1 s2 :: nil /\ ex = e')

     | IFTE.RUN ifte_A a =>

         config_denote_match s1 dom m env stk ex a

     | IFTE.RUN ifte_B b =>

         config_denote_match s2 dom m env stk ex b

     | IFTE.FINISH =>

        stk = nil /\ ex = expr_finish
     end

  | while e s => fun x =>
     match x with
     | WHILE.RUN while_expr e' =>

       (stk = kstmt (while e s) :: nil
         /\ (exists z, ex = expr_select (const z))
         /\ x = init (stmt_denote (while e s)))
      
       \/

       (stk = kwhile e s :: nil /\ ex = e')

       \/

       (stk = nil /\ ex = e' /\ ex = expr_select (const 0))

     | WHILE.RUN while_A a =>

       exists k1, stk = k1 ++ kstmt (expr e) :: kwhile e s :: nil /\
         config_denote_match s dom m env k1 ex a

     | WHILE.FINISH =>

        stk = nil /\ ex = expr_finish
     end

  end x.

Definition config_denote_match' (s:STMT) (cfg:lift config) (x:lstate (psys (stmt_denote s))) : Prop :=
  match cfg with
  | mho => refines branch_ind _ void_lts x (mho _)
  | into cfg =>
      match x with
      | mho => refines branch_ind config_lts void_lts (into cfg) (mho _)
      | into x =>
          config_denote_match s (c_dom cfg) (c_mem cfg) (c_env cfg) (c_stack cfg) (c_expr cfg) x
      end
  end.

Hint Constructors NoDup.

Lemma config_denote_match_init : forall dom m s z,
   (forall x, ~In x dom -> m x = var_indeterm) ->
   config_denote_match s dom m nil (kstmt s :: nil) (expr_select (const z))
     (init (stmt_denote s)).

Lemma config_denote_match_invariants : forall s dom m env stk ex y,
  config_denote_match s dom m env stk ex y ->
  config_invariants dom m env stk.

Lemma config_denote_match_mem_change : forall s dom m m' env stk ex x,
  config_invariants dom m' env stk ->
  (forall v l, In (v,l) env -> m l = m' l) ->
  config_denote_match s dom m env stk ex x ->
  config_denote_match s dom m' env stk ex x.

Lemma finish_config_not_mho : forall dom m,
  refines branch_ind config_lts void_lts
         (into
            {|
            c_dom := dom;
            c_mem := m;
            c_env := nil;
            c_stack := nil;
            c_expr := expr_finish |}) (mho _) -> False.

Lemma almost_finish_config_not_mho : forall dom m z,
  refines branch_ind config_lts void_lts
         (into
            {|
            c_dom := dom;
            c_mem := m;
            c_env := nil;
            c_stack := nil;
            c_expr := expr_select (const z) |}) (mho _) -> False.

Lemma local_mho_lemma1' : forall v s dom m env stk ex vx,
  refines branch_ind config_lts void_lts
         (into
            {|
            c_dom := dom;
            c_mem := m;
            c_env := env;
            c_stack := stk;
            c_expr := ex |}) (mho _) ->
         
   branch_backward_ind_no_stutter config_lts
     (par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     (config_denote_match' (local v s))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |}) (into (vx, mho (state (psys (stmt_denote s))))).

Lemma branch_mm_step_right : forall mm A B (R:lstate A -> lstate B -> Prop) a b b',
  mm_step mm B b None b' ->
  R a b ->
  branch_mm_ind mm A B R a b' ->
  branch_mm_ind mm A B R a b.

Lemma local_mho_lemma2' : forall v l s dom m env stk ex vx,
  config_invariants dom m (env ++ (v, l) :: nil) (stk ++ kenv v :: nil) ->
  refines branch_ind config_lts void_lts
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env ++ (v, l) :: nil;
        c_stack := stk ++ kenv v :: nil;
        c_expr := ex |}) (mho _) ->
   branch_forward_ind_no_stutter config_lts
     (par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     (config_denote_match' (local v s))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env ++ (v, l) :: nil;
        c_stack := stk ++ kenv v :: nil;
        c_expr := ex |}) (into (vx, mho (state (psys (stmt_denote s))))).

Lemma branch_mm_seq1 : forall mm s1 s2 q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s1)) (config_denote_match' s1) q1 q2 ->

  forall dom m env ex k1 x,
    q1 = into (mk_config dom m env k1 ex) ->
    q2 = into x ->

  forall q1',
    strict_lift config_lts config_lts
      (config_rel nil (kstmt s2::nil)) q1 q1' ->

    config_denote_match s1 dom m env k1 ex x ->

    branch_mm_ind mm config_lts
      (SEQ.ctl_lts (seq_choose (stmt_denote s1) (stmt_denote s2)))
      (config_denote_match' (seq s1 s2))
      q1' (into (SEQ.RUN _ seq_stA x)).

Lemma seq_config_step_star : forall mm a b,
  mm_step_star mm config_lts a b ->
  forall q s2,
  strict_lift config_lts config_lts
    (config_rel nil (kstmt s2::nil)) a q ->
  exists q',
    mm_step_star mm config_lts q q' /\
    strict_lift config_lts config_lts
      (config_rel nil (kstmt s2::nil)) b q'.

Lemma branch_mm_seq2 : forall mm s1 s2 q1 q2,
  branch_mm_ind mm (psys (stmt_denote s1)) config_lts (inv (config_denote_match' s1)) q1 q2 ->

  forall dom m env ex k1 x,
    q2 = into (mk_config dom m env k1 ex) ->
    q1 = into x ->

  forall q2',
    strict_lift config_lts config_lts
      (config_rel nil (kstmt s2::nil)) q2 q2' ->

    config_denote_match s1 dom m env k1 ex x ->

    branch_mm_ind mm
      (SEQ.ctl_lts (seq_choose (stmt_denote s1) (stmt_denote s2)))
      config_lts
      (inv (config_denote_match' (seq s1 s2)))
      (into (SEQ.RUN _ seq_stA x)) q2'.

Lemma branch_mm_seq3 : forall mm s1 s2 q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s2)) (config_denote_match' s2) q1 q2 ->

  forall dom m env ex k1 x,
    q1 = into (mk_config dom m env k1 ex) ->
    q2 = into x ->

    config_invariants dom m env k1 ->
    config_denote_match s2 dom m env k1 ex x ->

    branch_mm_ind mm config_lts
      (SEQ.ctl_lts (seq_choose (stmt_denote s1) (stmt_denote s2)))
      (config_denote_match' (seq s1 s2))
      q1 (into (SEQ.RUN _ seq_stB x)).

Lemma branch_mm_seq4 : forall mm s1 s2 q1 q2,
  branch_mm_ind mm (psys (stmt_denote s2)) config_lts (inv (config_denote_match' s2)) q1 q2 ->

  forall dom m env ex k1 x,
    q2 = into (mk_config dom m env k1 ex) ->
    q1 = into x ->

    config_invariants dom m env k1 ->
    config_denote_match s2 dom m env k1 ex x ->

    branch_mm_ind mm
      (SEQ.ctl_lts (seq_choose (stmt_denote s1) (stmt_denote s2)))
      config_lts
      (inv (config_denote_match' (seq s1 s2)))
      (into (SEQ.RUN _ seq_stB x)) q2.

Lemma local_config_step_star : forall mm a b,
  mm_step_star mm config_lts a b ->
  forall q l v vx,
  strict_lift config_lts config_lts
    (config_rel ((v,l)::nil) (kenv v :: nil)) a q ->
  match a with into a' => c_mem a' l = vx | mho => False end ->
  exists q',
    mm_step_star mm config_lts q q' /\
    match q' with into q' => c_mem q' l = vx | mho => True end /\
    strict_lift config_lts config_lts
      (config_rel ((v,l)::nil) (kenv v :: nil)) b q'.

Lemma branch_mm_local1 : forall mm s q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s))
    (config_denote_match' s) q1 q2 ->

   forall v dom m stk ex vx x l env',

  q1 = (into (mk_config dom m env' stk ex)) ->
  q2 = into x ->

  forall q1',
    strict_lift config_lts config_lts
      (config_rel ((v,l)::nil) (kenv v :: nil))
      q1 q1' ->

    m l = vx ->
    config_denote_match s dom m env' stk ex x ->

    branch_mm_ind mm config_lts
     (par_semantics.par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     (config_denote_match' (local v s))
     q1' (into (into vx, into x)).

Lemma branch_mm_local2 : forall mm s q1 q2,
  branch_mm_ind mm (psys (stmt_denote s)) config_lts
    (inv (config_denote_match' s)) q1 q2 ->

   forall v dom m stk ex vx x l env,

  q2 = (into {| c_dom := dom; c_mem := m; c_env := env; c_stack := stk; c_expr := ex |}) ->
  q1 = into x ->

  forall q2',
    strict_lift config_lts config_lts
      (config_rel ((v,l)::nil) (kenv v :: nil))
      q2 q2' ->

  m l = vx ->
  config_denote_match s dom m env stk ex x ->
  branch_mm_ind mm
     (par_semantics.par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     config_lts
     (inv (config_denote_match' (local v s)))
     (into (into vx, into x)) q2'.

Lemma if_expr_mm_branch1 : forall mm e s1 s2 dom m env x,
  config_invariants dom m env (kif s1 s2 :: nil) ->
  branch_mm_ind mm config_lts
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end)) (config_denote_match' (ifte e s1 s2))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := kif s1 s2 :: nil;
        c_expr := x |})
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_expr x)).

Lemma if_expr_mm_branch2 : forall mm e s1 s2 dom m env x,
  config_invariants dom m env (kif s1 s2 :: nil) ->
  branch_mm_ind mm
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end))
        config_lts
        (inv (config_denote_match' (ifte e s1 s2)))
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_expr x))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := kif s1 s2 :: nil;
        c_expr := x |}).

Lemma mm_branch_ifA1 : forall mm e s1 s2 q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s1))
    (config_denote_match' s1)
    q1 q2 ->

    forall dom m env stk ex x,
      q1 = into (mk_config dom m env stk ex) ->
      q2 = into x ->

      config_invariants dom m env stk ->
      config_denote_match s1 dom m env stk ex x ->
   branch_mm_ind mm config_lts
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end)) (config_denote_match' (ifte e s1 s2))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |})
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_A x)).

Lemma mm_branch_ifA2 : forall mm e s1 s2 q1 q2,
  branch_mm_ind mm (psys (stmt_denote s1)) config_lts
    (inv (config_denote_match' s1))
    q1 q2 ->

    forall dom m env stk ex x,
      q1 = into x ->
      q2 = into (mk_config dom m env stk ex) ->

      config_invariants dom m env stk ->
      config_denote_match s1 dom m env stk ex x ->

   branch_mm_ind mm
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end))
     config_lts
     (inv (config_denote_match' (ifte e s1 s2)))
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_A x))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |}).

Lemma mm_branch_ifB1 : forall mm e s1 s2 q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s2))
    (config_denote_match' s2)
    q1 q2 ->

    forall dom m env stk ex x,
      q1 = into (mk_config dom m env stk ex) ->
      q2 = into x ->

      config_invariants dom m env stk ->
      config_denote_match s2 dom m env stk ex x ->
   branch_mm_ind mm config_lts
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end)) (config_denote_match' (ifte e s1 s2))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |})
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_B x)).

Lemma mm_branch_ifB2 : forall mm e s1 s2 q1 q2,
  branch_mm_ind mm (psys (stmt_denote s2)) config_lts
    (inv (config_denote_match' s2))
    q1 q2 ->

    forall dom m env stk ex x,
      q1 = into x ->
      q2 = into (mk_config dom m env stk ex) ->

      config_invariants dom m env stk ->
      config_denote_match s2 dom m env stk ex x ->
   branch_mm_ind mm
     (IFTE.ctl_lts
        (fun x0 : IFTE_INPUT.ctl_st =>
         match x0 with
         | ifte_expr => expr_prog e
         | ifte_A => stmt_denote s1
         | ifte_B => stmt_denote s2
         end))
     config_lts
     (inv (config_denote_match' (ifte e s1 s2)))
     (into
        (IFTE.RUN
           (fun x0 : IFTE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | ifte_expr => expr_prog e
                 | ifte_A => stmt_denote s1
                 | ifte_B => stmt_denote s2
                 end)) ifte_B x))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |}).

Lemma while_expr_mm_branch1 : forall mm e s dom m env x,
  config_invariants dom m env (kwhile e s :: nil) ->
  branch_mm_ind mm config_lts
     (WHILE.ctl_lts
        (fun x0 : WHILE_INPUT.ctl_st =>
         match x0 with
         | while_expr => expr_prog e
         | while_A => stmt_denote s
         end)) (config_denote_match' (while e s))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := kwhile e s :: nil;
        c_expr := x |})
     (into
        (WHILE.RUN
           (fun x0 : WHILE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | while_expr => expr_prog e
                 | while_A => stmt_denote s
                 end)) while_expr x)).

Lemma while_expr_mm_branch2 : forall mm e s dom m env x,
  config_invariants dom m env (kwhile e s :: nil) ->
  branch_mm_ind mm
     (WHILE.ctl_lts
        (fun x0 : WHILE_INPUT.ctl_st =>
         match x0 with
         | while_expr => expr_prog e
         | while_A => stmt_denote s
         end))
     config_lts
     (inv (config_denote_match' (while e s)))
     (into
        (WHILE.RUN
           (fun x0 : WHILE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | while_expr => expr_prog e
                 | while_A => stmt_denote s
                 end)) while_expr x))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := kwhile e s :: nil;
        c_expr := x |}).

Lemma config_invariants_unwhile : forall dom m env k e s,
 config_invariants dom m env (k ++ kwhile e s :: nil) ->
 config_invariants dom m env k.

Lemma mm_branch_whileA1 : forall mm e s q1 q2,
  branch_mm_ind mm config_lts (psys (stmt_denote s))
  (config_denote_match' s)
  q1 q2 ->

  forall dom m env ex x stk',
    q1 = into (mk_config dom m env stk' ex) ->
    q2 = into x ->

    forall q1',
    strict_lift config_lts config_lts
      (config_rel nil (kstmt (expr e) :: kwhile e s::nil)) q1 q1' ->

    config_denote_match s dom m env stk' ex x ->

   branch_mm_ind mm config_lts
     (WHILE.ctl_lts
        (fun x0 : WHILE_INPUT.ctl_st =>
         match x0 with
         | while_expr => expr_prog e
         | while_A => stmt_denote s
         end)) (config_denote_match' (while e s))
     q1'
     (into
        (WHILE.RUN
           (fun x0 : WHILE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | while_expr => expr_prog e
                 | while_A => stmt_denote s
                 end)) while_A x)).

Lemma while_config_step_star : forall mm a b,
  mm_step_star mm config_lts a b ->
  forall q e s,
  strict_lift config_lts config_lts
    (config_rel nil (kstmt (expr e)::kwhile e s ::nil)) a q ->
  exists q',
    mm_step_star mm config_lts q q' /\
    strict_lift config_lts config_lts
      (config_rel nil (kstmt (expr e)::kwhile e s::nil)) b q'.

Lemma mm_branch_whileA2 : forall mm e s q1 q2,
  branch_mm_ind mm (psys (stmt_denote s)) config_lts
  (inv (config_denote_match' s))
  q1 q2 ->

  forall dom m env ex x stk',
    q1 = into x ->
    q2 = into (mk_config dom m env stk' ex) ->

    forall q2',
    strict_lift config_lts config_lts
      (config_rel nil (kstmt (expr e) :: kwhile e s::nil)) q2 q2' ->

    config_denote_match s dom m env stk' ex x ->

   branch_mm_ind mm
     (WHILE.ctl_lts
        (fun x0 : WHILE_INPUT.ctl_st =>
         match x0 with
         | while_expr => expr_prog e
         | while_A => stmt_denote s
         end))
     config_lts
     (inv (config_denote_match' (while e s)))
     (into
        (WHILE.RUN
           (fun x0 : WHILE_INPUT.ctl_st =>
            state
              (psys
                 match x0 with
                 | while_expr => expr_prog e
                 | while_A => stmt_denote s
                 end)) while_A x))
     q2'.

Lemma local_mho_lemma2'' : forall mm v l s dom m env stk ex vx,
  config_invariants dom m (env ++ (v, l) :: nil) (stk ++ kenv v :: nil) ->
  refines branch_ind config_lts void_lts
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env ++ (v, l) :: nil;
        c_stack := stk ++ kenv v :: nil;
        c_expr := ex |}) (mho _) ->
   branch_mm_ind mm config_lts
     (par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     (config_denote_match' (local v s))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env ++ (v, l) :: nil;
        c_stack := stk ++ kenv v :: nil;
        c_expr := ex |}) (into (vx, mho (state (psys (stmt_denote s))))).

Lemma config_denote_match_mm1 : forall mm s dom m env stk ex x,
  config_denote_match s dom m env stk ex x ->
  branch_mm_ind mm config_lts (psys (stmt_denote s)) (config_denote_match' s) (into (mk_config dom m env stk ex)) (into x).

Lemma local_branch_back_cleanup' : forall mm v s q1 q2,
  branch_mm_ind mm (psys (stmt_denote s)) config_lts
    (inv (config_denote_match' s)) q2 q1 ->
    
    forall dom m env ex vx x,
      q1 = into (mk_config dom m env nil ex) ->
      q2 = into x ->
    
        config_invariants dom m env nil ->
        (exists z : Z, ex = expr_select (const z)) \/ ex = expr_finish ->
        config_denote_match s dom m env nil ex x ->

   branch_mm_ind mm
     (par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     config_lts
     (inv (config_denote_match' (local v s)))
     (into (into vx, into x))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := nil;
        c_expr := ex |}) .

Lemma local_mho_lemma1'' : forall mm v s dom m env stk ex vx,
  refines branch_ind config_lts void_lts
         (into
            {|
            c_dom := dom;
            c_mem := m;
            c_env := env;
            c_stack := stk;
            c_expr := ex |}) (mho _) ->
         
   branch_mm_ind mm
     (par_lts (var_gadget_lts v) (psys (stmt_denote s)) v)
     config_lts
     (inv (config_denote_match' (local v s)))
     (into (vx, mho (state (psys (stmt_denote s)))))
     (into
        {|
        c_dom := dom;
        c_mem := m;
        c_env := env;
        c_stack := stk;
        c_expr := ex |}) .

Lemma config_denote_match_mm2 : forall mm s dom m env stk ex x,
  config_denote_match s dom m env stk ex x ->
  branch_mm_ind mm (psys (stmt_denote s)) config_lts (inv (config_denote_match' s)) (into x) (into (mk_config dom m env stk ex)).

Lemma config_denote_match'_refinement : forall s,
  refinement branch_ind_no_stutter config_lts _ (config_denote_match' s).

Lemma config_denote_match'_inv_refinement : forall s,
  refinement branch_ind_no_stutter _ config_lts (inv (config_denote_match' s)).

Theorem config_stmt_peq : forall s,
  peq (config_prog s) (stmt_denote s).