End GenericSemanticsElaboration.
(* Stratified Semantics -- the "product" of two generic semantics. *)
(* We use S' instead of S to avoid problems with Datatypes.S. *)
Class StratifiedSemantics {W V G S' U F}
`{WVG : GenericSemantics W V G}
(* The abstract semantics *)
`{S'UF : GenericSemantics S' U F}
(* The concrete semantics *)
(world_erase : W -> S')
(* An erasure function mapping worlds to states *)
(VU : relation W -> relation S' -> Prop)
(* Acceptable primitive command pairs *)
(GF : pfunc W val -> pfunc S' val -> Prop)
(* Acceptable primitive expression pairs *)
: Type := mkStratifiedSemantics {
(* These axioms just enforce that VU and GF are subsets of the products V x U and G x F. *)
ss_VU_wellformed : forall v u,
VU v u
-> V v /\ U u;
ss_GF_wellformed : forall g f,
GF g f
-> G g /\ F f;
(* Erasure and safety of primitive commands *)
ss_primcom_erasure : forall v u w w' s s',
VU v u
-> world_erase w = s
-> v w w'
-> u s s'
-> world_erase w' = s';
ss_primcom_safety : forall v u w w' s,
VU v u
-> world_erase w = s
-> v w w'
-> exists s', u s s';
(* Ditto for primitive expressions *)
ss_primexpr_erasure : forall g f b1 b2 w s (Hgf : GF g f),
world_erase w = s
-> exprEval G (EPrim g) w b1
-> exprEval F (EPrim f) s b2
-> b1=b2;
ss_primexpr_saftey : forall g f b1 w s,
GF g f
-> world_erase w = s
-> exprEval G (EPrim g) w b1
-> exists b2, exprEval F (EPrim f) s b2
}.
Section UnpackStratifiedSemantics.
Context {W V G S' U F world_erase VU GF}
`{SS : StratifiedSemantics W V G S' U F world_erase VU GF}.

(* Specifications: *)
Lemma VU_wellformed : forall v u,
VU v u
-> V v /\ U u.
Lemma stratified_expr_safety : forall e e' w b1,
expr_erase GF e e'
-> exprEval G e w b1
-> exists b2, exprEval F e' (world_erase w) b2.
Lemma step_erasure : forall (w w': W) (s s': S') k_w k_w' k_s k_s',
world_erase w = s
-> ctl_erase k_w k_s
-> @step _ V G w k_w w' k_w'
-> @step _ U F s k_s s' k_s'
-> world_erase w' = s' /\ ctl_erase k_w' k_s'.
Lemma step_safety : forall w w' s k_w k_w' k_s,
world_erase w = s
-> ctl_erase k_w k_s
-> @step _ V G w k_w w' k_w'
-> exists s', exists k_s', @step _ U F s k_s s' k_s'.
Lemma step_star_erasure : forall w w' s k_w k_w' k_s,
world_erase w = s
-> ctl_erase k_w k_s
-> @step_star _ V G w k_w w' k_w'
-> exists s', exists k_s',
@step_star _ U F s k_s s' k_s'
/\ world_erase w' = s' /\ ctl_erase k_w' k_s'.