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: state -> trace -> state -> Prop.
(** No transitions: stuck state *)
Definition nostep (s: state) : Prop :=
forall t s', ~(step s t s').
(** Zero, one or several transitions.  Also known as Kleene closure, or reflexive transitive closure. *)
Inductive star : state -> trace -> state -> Prop :=
| star_refl: forall s,
star s E0 s
| star_step: forall s1 t1 s2 t2 s3 t,
step s1 t1 s2 -> star s2 t2 s3 -> t = t1 ** t2 ->
star s1 t s3.
Proof star_step.
(** One or several transitions.  Also known as the transitive closure. *)
Inductive plus : state -> trace -> state -> Prop :=
| plus_left: forall s1 t1 s2 t2 s3 t,
step s1 t1 s2 -> star s2 t2 s3 -> t = t1 ** t2 ->
plus s1 t s3.
(** Counted sequences of transitions *)
Inductive starN : nat -> state -> trace -> state -> Prop :=
| starN_refl: forall s,
starN O s E0 s
| starN_step: forall n s t t1 s' t2 s'',
step s t1 s' -> starN n s' t2 s'' -> t = t1 ** t2 ->
starN (S n) s t s''.
Remark starN_star:
forall n s t s', starN n s t s' -> star s t s'.
Remark star_starN:
forall s t s', star s t s' -> exists n, starN n s t s'.
(** Infinitely many transitions *)
CoInductive forever : state -> traceinf -> Prop :=
| forever_intro: forall s1 t s2 T,
step s1 t s2 -> forever s2 T ->
forever 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 : A -> state -> traceinf -> Prop :=
| forever_N_star: forall s1 t s2 a1 a2 T1 T2,
star s1 t s2 ->
order a2 a1 ->
forever_N a2 s2 T2 ->
T1 = t *** T2 ->
forever_N a1 s1 T1
| forever_N_plus: forall s1 t s2 a1 a2 T1 T2,
plus s1 t s2 ->
forever_N a2 s2 T2 ->
T1 = t *** T2 ->
forever_N a1 s1 T1.
Hypothesis order_wf: well_founded order.
(** Yet another alternative definition of [forever]. *)
CoInductive forever_plus : state -> traceinf -> Prop :=
| forever_plus_intro: forall s1 t s2 T1 T2,
plus s1 t s2 ->
forever_plus s2 T2 ->
T1 = t *** T2 ->
forever_plus s1 T1.
(** Infinitely many silent transitions *)
CoInductive forever_silent : state -> Prop :=
| forever_silent_intro: forall s1 s2,
step s1 E0 s2 -> forever_silent s2 ->
forever_silent s1.
(** An alternate definition. *)
CoInductive forever_silent_N : A -> state -> Prop :=
| forever_silent_N_star: forall s1 s2 a1 a2,
star s1 E0 s2 ->
order a2 a1 ->
forever_silent_N a2 s2 ->
forever_silent_N a1 s1
| forever_silent_N_plus: forall s1 s2 a1 a2,
plus s1 E0 s2 ->
forever_silent_N a2 s2 ->
forever_silent_N a1 s1.
(** Infinitely many non-silent transitions *)
CoInductive forever_reactive : state -> traceinf -> Prop :=
| forever_reactive_intro: forall s1 s2 t T,
star s1 t s2 -> t <> E0 -> forever_reactive s2 T ->
forever_reactive s1 (t *** T).
End CLOSURES.
(** * Transition semantics *)
(** The general form of a transition semantics. *)
Record part_semantics : Type :=
{
state: Type;
genvtype: Type;
get_mem: state -> Memory.mem;
set_mem: state -> Memory.mem -> state;
step : state -> trace -> state -> Prop;
entry_point: Memory.mem -> state -> val -> list val -> Prop;
at_external : state ->  option (external_function * list val);
after_external : option val -> state -> Memory.mem -> option state;
final_state: state -> int -> Prop;
globalenv: genvtype;
symbolenv: Senv.t
(*TODO: External call states must exectue the function in one step*)
(* Need to see what the hybrid machine needs. *)
(*external_step_lemma: forall g s1 ef args t s2, at_external g s1 = Some (ef, args) -> step sem g s1 t s2 -> exists vr, external_call ef (symbolenv sem) args (get_mem s1) t (Val.maketotal vr) (get_mem s2) /\ after_external g vr (set_mem s1 (get_mem s2)) = Some s2  *)
}.
Arguments get_mem {_} _.
Arguments set_mem {_} _ _.
(* Full semantics are for closed, complete programs. *)
(* It contains a main function and an inital_mem     *)
Record semantics : Type := {
part_sem:> part_semantics;
main_block: option block; (*location of main.*)
init_mem: option Memory.mem
}.
(*We can recover initial_states from entry_point *)
Inductive initial_state (sem:semantics): state sem -> Prop :=
| initial_state_derived_intro': forall st0 m0 b,
init_mem sem = Some m0 ->
(main_block sem) = Some b ->
entry_point sem m0 st0 (Vptr b (Ptrofs.zero)) nil ->
initial_state sem st0.
(** The form used in earlier CompCert versions, for backward compatibility. *)
Definition Semantics {state funtype vartype: Type}
(get_mem: state -> Memory.mem)
(set_mem: state -> Memory.mem -> state)
(step: state -> trace -> state -> Prop)
(entry_point: Memory.mem -> state -> val -> list val  -> Prop)
(at_external : state -> option (external_function * list val))
(after_external : option val -> state -> Memory.mem -> option state)
(final_state: state -> int -> Prop)
(globalenv: Genv.t funtype vartype)
(main_block: option block)
(init_mem: option Memory.mem):=
Build_semantics
{| state := state;
genvtype := Genv.t funtype vartype;
get_mem:= get_mem;
set_mem:= set_mem;
step := step;
entry_point := entry_point;
at_external := at_external;
after_external := after_external;
final_state := final_state;
globalenv := globalenv;
symbolenv := Genv.to_senv globalenv |}
main_block init_mem.
Definition Semantics_gen (state genvtype: Type)
(get_mem: state -> Memory.mem)
(set_mem: state -> Memory.mem -> state)
(step: state -> trace -> state -> Prop)
(entry_point: Memory.mem -> state -> val -> list val  -> Prop)
(at_external : state ->  option (external_function * list val))
(after_external : option val -> state -> Memory.mem -> option state)
(final_state: state -> int -> Prop)
(globalenv: genvtype)
(main_block: option block)
(init_mem: option Memory.mem)
(symbolenv: Senv.t):=
Build_semantics
{| state := state;
genvtype := genvtype;
get_mem:= get_mem;
set_mem:= set_mem;
step := step;
entry_point := entry_point;
at_external := at_external;
after_external := after_external;
final_state := final_state;
globalenv := globalenv;
symbolenv := symbolenv |}
main_block init_mem.
(** Handy notations. *)
Notation " 'Step' L " := (step L) (at level 1) : smallstep_scope.
Notation " 'Star' L " := (star (step L)) (at level 1) : smallstep_scope.
Notation " 'Plus' L " := (plus (step L)) (at level 1) : smallstep_scope.
Notation " 'Forever_silent' L " := (forever_silent (step L)) (at level 1) : smallstep_scope.
Notation " 'Forever_reactive' L " := (forever_reactive (step L)) (at level 1) : smallstep_scope.
Notation " 'Nostep' L " := (nostep (step L)) (at level 1) : smallstep_scope.
Open Scope smallstep_scope.
(** * Forward simulations between two transition semantics. *)
(*Following definition mimics *_not_fresh lemmas from common/Globalenvs.v*)
(* genv_next bounds all global blocks *)
(* This should be part of GENV file?   *)
Definition globals_not_fresh {F V} (ge:Genv.t F V) m:=
Ple (Genv.genv_next ge) (Mem.nextblock m).

Lemma globals_not_fresh_preserve:
forall {F1 V1 F2 V2} (p1:AST.program F1 V1) (p2:AST.program F2 V2),
length (AST.prog_defs p1) = length (AST.prog_defs p2) ->
forall m0, globals_not_fresh (Genv.globalenv p1) m0 ->
globals_not_fresh (Genv.globalenv p2) m0.