(** Anti-stuttering measure *)

(** There are some stuttering steps in the translation:
- The execution of [Sdo a] where [a] is side-effect free,
  which is three transitions in the source:
<<
    Sdo a, k  --->  a, Kdo k ---> rval v, Kdo k ---> Sskip, k
>>
  but the translation, which is [Sskip], makes no transitions.
- The reduction [Ecomma (Eval v) r2 --> r2].
- The reduction [Eparen (Eval v) --> Eval v] in a [For_effects] context.

The following measure decreases for these stuttering steps. *)

Fixpoint esize (a: Csyntax.expr) : nat :=
  match a with
  | Csyntax.Eloc _ _ _ => 1%nat
  | Csyntax.Evar _ _ => 1%nat
  | Csyntax.Ederef r1 _ => S(esize r1)
  | Csyntax.Efield l1 _ _ => S(esize l1)
  | Csyntax.Eval _ _ => O
  | Csyntax.Evalof l1 _ => S(esize l1)
  | Csyntax.Eaddrof l1 _ => S(esize l1)
  | Csyntax.Eunop _ r1 _ => S(esize r1)
  | Csyntax.Ebinop _ r1 r2 _ => S(esize r1 + esize r2)%nat
  | Csyntax.Ecast r1 _ => S(esize r1)
  | Csyntax.Eseqand r1 _ _ => S(esize r1)
  | Csyntax.Eseqor r1 _ _ => S(esize r1)
  | Csyntax.Econdition r1 _ _ _ => S(esize r1)
  | Csyntax.Esizeof _ _ => 1%nat
  | Csyntax.Ealignof _ _ => 1%nat
  | Csyntax.Eassign l1 r2 _ => S(esize l1 + esize r2)%nat
  | Csyntax.Eassignop _ l1 r2 _ _ => S(esize l1 + esize r2)%nat
  | Csyntax.Epostincr _ l1 _ => S(esize l1)
  | Csyntax.Ecomma r1 r2 _ => S(esize r1 + esize r2)%nat
  | Csyntax.Ecall r1 rl2 _ => S(esize r1 + esizelist rl2)%nat
  | Csyntax.Ebuiltin ef _ rl _ => S(esizelist rl)%nat
  | Csyntax.Eparen r1 _ _ => S(esize r1)
  end

with esizelist (el: Csyntax.exprlist) : nat :=
  match el with
  | Csyntax.Enil => O
  | Csyntax.Econs r1 rl2 => (esize r1 + esizelist rl2)%nat
  end.Definition measure (st: Csem.state) : nat :=
  match st with
  | Csem.ExprState _ r _ _ _ => (esize r + 1)%nat
  | Csem.State _ Csyntax.Sskip _ _ _ => 0%nat
  | Csem.State _ (Csyntax.Sdo r) _ _ _ => (esize r + 2)%nat
  | Csem.State _ (Csyntax.Sifthenelse r _ _) _ _ _ => (esize r + 2)%nat
  | _ => 0%nat
  end.

(* Specifications: *)
Lemma leftcontext_size: forall from to C, leftcontext from to C -> forall e1 e2, (esize e1 < esize e2)%nat -> (esize (C e1) < esize (C e2))%nat with leftcontextlist_size: forall from C, leftcontextlist from C -> forall e1 e2, (esize e1 < esize e2)%nat -> (esizelist (C e1) < esizelist (C e2))%nat.
Lemma estep_simulation: forall S1 t S2, Cstrategy.estep ge S1 t S2 -> forall S1' (MS: match_states S1 S1'), exists S2', (plus step1 tge S1' t S2' \/ (star step1 tge S1' t S2' /\ measure S2 < measure S1)%nat) /\ match_states S2 S2'.
Lemma tr_top_val_for_val_inv: forall e le m v ty sl a tmps, tr_top tge e le m For_val (Csyntax.Eval v ty) sl a tmps -> sl = nil /\ typeof a = ty /\ eval_expr tge e le m a v.
Lemma alloc_variables_preserved: forall e m params e' m', Csem.alloc_variables ge e m params e' m' -> alloc_variables tge e m params e' m'.
Lemma bind_parameters_preserved: forall e m params args m', Csem.bind_parameters ge e m params args m' -> bind_parameters tge e m params args m'.
Lemma blocks_of_env_preserved: forall e, blocks_of_env tge e = Csem.blocks_of_env ge e.
Lemma sstep_simulation: forall S1 t S2, Csem.sstep ge S1 t S2 -> forall S1' (MS: match_states S1 S1'), exists S2', (plus step1 tge S1' t S2' \/ (star step1 tge S1' t S2' /\ measure S2 < measure S1)%nat) /\ match_states S2 S2'.
Theorem simulation: forall S1 t S2, Cstrategy.step ge S1 t S2 -> forall S1' (MS: match_states S1 S1'), exists S2', (plus step1 tge S1' t S2' \/ (star step1 tge S1' t S2' /\ measure S2 < measure S1)%nat) /\ match_states S2 S2'.
Lemma transl_initial_states: forall S, Csem.initial_state prog S -> exists S', Clight.initial_state tprog S' /\ match_states S S'.
Lemma transl_final_states: forall S S' r, match_states S S' -> Csem.final_state S r -> Clight.final_state S' r.
Theorem transl_program_correct: forward_simulation (Cstrategy.semantics prog) (Clight.semantics1 tprog).