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;
start_stack: 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 start_stack *)
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 ->
start_stack 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)
(start_stack: 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;
start_stack := start_stack;
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)
(start_stack: 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;
start_stack := start_stack;
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.