Section CLOSURES.
Variable genv: Type.
Variable state: Type.
(** A one-step transition relation has the following signature. It is parameterized by a global environment, which does not change during the transition.  It relates the initial state of the transition with its final state.  The [trace] parameter captures the observable events possibly generated during the transition. *)
Variable step: genv -> state -> trace -> state -> Prop.
(** No transitions: stuck state *)
Definition nostep (ge: genv) (s: state) : Prop :=
forall t s', ~(step ge s t s').
(** Zero, one or several transitions.  Also known as Kleene closure, or reflexive transitive closure. *)
Inductive star (ge: genv): state -> trace -> state -> Prop :=
| star_refl: forall s,
star ge s E0 s
| star_step: forall s1 t1 s2 t2 s3 t,
step ge s1 t1 s2 -> star ge s2 t2 s3 -> t = t1 ** t2 ->
star ge s1 t s3.
Proof star_step.
(** One or several transitions.  Also known as the transitive closure. *)
Inductive plus (ge: genv): state -> trace -> state -> Prop :=
| plus_left: forall s1 t1 s2 t2 s3 t,
step ge s1 t1 s2 -> star ge s2 t2 s3 -> t = t1 ** t2 ->
plus ge s1 t s3.
(** Counted sequences of transitions *)
Inductive starN (ge: genv): nat -> state -> trace -> state -> Prop :=
| starN_refl: forall s,
starN ge O s E0 s
| starN_step: forall n s t t1 s' t2 s'',
step ge s t1 s' -> starN ge n s' t2 s'' -> t = t1 ** t2 ->
starN ge (S n) s t s''.
Remark starN_star:
forall ge n s t s', starN ge n s t s' -> star ge s t s'.
Remark star_starN:
forall ge s t s', star ge s t s' -> exists n, starN ge n s t s'.
(** Infinitely many transitions *)
CoInductive forever (ge: genv): state -> traceinf -> Prop :=
| forever_intro: forall s1 t s2 T,
step ge s1 t s2 -> forever ge s2 T ->
forever ge s1 (t *** T).
(** An alternate, equivalent definition of [forever] that is useful for coinductive reasoning. *)
Variable A: Type.
Variable order: A -> A -> Prop.
CoInductive forever_N (ge: genv) : A -> state -> traceinf -> Prop :=
| forever_N_star: forall s1 t s2 a1 a2 T1 T2,
star ge s1 t s2 ->
order a2 a1 ->
forever_N ge a2 s2 T2 ->
T1 = t *** T2 ->
forever_N ge a1 s1 T1
| forever_N_plus: forall s1 t s2 a1 a2 T1 T2,
plus ge s1 t s2 ->
forever_N ge a2 s2 T2 ->
T1 = t *** T2 ->
forever_N ge a1 s1 T1.
Hypothesis order_wf: well_founded order.
(** Yet another alternative definition of [forever]. *)
CoInductive forever_plus (ge: genv) : state -> traceinf -> Prop :=
| forever_plus_intro: forall s1 t s2 T1 T2,
plus ge s1 t s2 ->
forever_plus ge s2 T2 ->
T1 = t *** T2 ->
forever_plus ge s1 T1.
(** Infinitely many silent transitions *)
CoInductive forever_silent (ge: genv): state -> Prop :=
| forever_silent_intro: forall s1 s2,
step ge s1 E0 s2 -> forever_silent ge s2 ->
forever_silent ge s1.
(** An alternate definition. *)
CoInductive forever_silent_N (ge: genv) : A -> state -> Prop :=
| forever_silent_N_star: forall s1 s2 a1 a2,
star ge s1 E0 s2 ->
order a2 a1 ->
forever_silent_N ge a2 s2 ->
forever_silent_N ge a1 s1
| forever_silent_N_plus: forall s1 s2 a1 a2,
plus ge s1 E0 s2 ->
forever_silent_N ge a2 s2 ->
forever_silent_N ge a1 s1.
(** Infinitely many non-silent transitions *)
CoInductive forever_reactive (ge: genv): state -> traceinf -> Prop :=
| forever_reactive_intro: forall s1 s2 t T,
star ge s1 t s2 -> t <> E0 -> forever_reactive ge s2 T ->
forever_reactive ge s1 (t *** T).
End CLOSURES.
(** * Transition semantics *)
(** The general form of a transition semantics. *)
Record semantics : Type := Semantics_gen {
state: Type;
genvtype: Type;
step : genvtype -> state -> trace -> state -> Prop;
initial_state: state -> Prop;
final_state: state -> int -> Prop;
globalenv: genvtype;
symbolenv: Senv.t
}.
(** The form used in earlier CompCert versions, for backward compatibility. *)
Definition Semantics {state funtype vartype: Type}
(step: Genv.t funtype vartype -> state -> trace -> state -> Prop)
(initial_state: state -> Prop)
(final_state: state -> int -> Prop)
(globalenv: Genv.t funtype vartype) :=
{| state := state;
genvtype := Genv.t funtype vartype;
step := step;
initial_state := initial_state;
final_state := final_state;
globalenv := globalenv;
symbolenv := Genv.to_senv globalenv |}.
(** Handy notations. *)
Notation " 'Step' L " := (step L (globalenv L)) (at level 1) : smallstep_scope.
Notation " 'Star' L " := (star (step L) (globalenv L)) (at level 1) : smallstep_scope.
Notation " 'Plus' L " := (plus (step L) (globalenv L)) (at level 1) : smallstep_scope.
Notation " 'Forever_silent' L " := (forever_silent (step L) (globalenv L)) (at level 1) : smallstep_scope.
Notation " 'Forever_reactive' L " := (forever_reactive (step L) (globalenv L)) (at level 1) : smallstep_scope.
Notation " 'Nostep' L " := (nostep (step L) (globalenv L)) (at level 1) : smallstep_scope.
Open Scope smallstep_scope.
(** * Forward simulations between two transition semantics. *)
(** The general form of a forward simulation. *)
Record fsim_properties (L1 L2: semantics) (index: Type)
(order: index -> index -> Prop)
(match_states: index -> state L1 -> state L2 -> Prop) : Prop := {
fsim_order_wf: well_founded order;
fsim_match_initial_states:
forall s1, initial_state L1 s1 ->
exists i, exists s2, initial_state L2 s2 /\ match_states i s1 s2;
fsim_match_final_states:
forall i s1 s2 r,
match_states i s1 s2 -> final_state L1 s1 r -> final_state L2 s2 r;
fsim_simulation:
forall s1 t s1', Step L1 s1 t s1' ->
forall i s2, match_states i s1 s2 ->
exists i', exists s2',
(Plus L2 s2 t s2' \/ (Star L2 s2 t s2' /\ order i' i))
/\ match_states i' s1' s2';
fsim_public_preserved:
forall id, Senv.public_symbol (symbolenv L2) id = Senv.public_symbol (symbolenv L1) id
}.
Arguments fsim_properties: clear implicits.
Inductive forward_simulation (L1 L2: semantics) : Prop :=
Forward_simulation (index: Type)
(order: index -> index -> Prop)
(match_states: index -> state L1 -> state L2 -> Prop)
(props: fsim_properties L1 L2 index order match_states).
Arguments Forward_simulation {L1 L2 index} order match_states props.
(** An alternate form of the simulation diagram *)

Lemma fsim_simulation':
forall L1 L2 index order match_states, fsim_properties L1 L2 index order match_states ->
forall i s1 t s1', Step L1 s1 t s1' ->
forall s2, match_states i s1 s2 ->
(exists i', exists s2', Plus L2 s2 t s2' /\ match_states i' s1' s2')
\/ (exists i', order i' i /\ t = E0 /\ match_states i' s1' s2).