(* Stratified Semantics with Separation -- this is where put everything together. *)
Class StratifiedSemanticsWithSeparation
  {W V G S' U F world_erase VU GF}
  `{StratifiedSemantics W V G S' U F world_erase VU GF}
  {A}
  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
   (* NOTE: Perhaps we also want   CA: Canc_alg A   *)
  (projA : W -> A)
  (* Projection function mapping worlds to elements of A *)
  (H : pfunc A val -> Prop)
  (* Set of primitive expressions on A -- we need these in order
     to use [assert_expr]-style predicates in our separation
     logic. *)
  (HG : pfunc A val -> pfunc W val -> Prop)
  (* Acceptable primitive expression pairs on A and W *)
  : Type := {

   sss_HG_wellformed : forall h g,
     HG h g
     -> H h /\ G g;

   sss_primexpr_erasure : forall w a g h b1 b2,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exprEval G (EPrim g) w b2
    -> b1=b2;

   sss_primexpr_safety : forall w a g h b1,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exists b2, exprEval G (EPrim g) w b2
}.(* Stratified Semantics with Separation -- this is where put everything together. *)
Class StratifiedSemanticsWithSeparation
  {W V G S' U F world_erase VU GF}
  `{StratifiedSemantics W V G S' U F world_erase VU GF}
  {A}
  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
   (* NOTE: Perhaps we also want   CA: Canc_alg A   *)
  (projA : W -> A)
  (* Projection function mapping worlds to elements of A *)
  (H : pfunc A val -> Prop)
  (* Set of primitive expressions on A -- we need these in order
     to use [assert_expr]-style predicates in our separation
     logic. *)
  (HG : pfunc A val -> pfunc W val -> Prop)
  (* Acceptable primitive expression pairs on A and W *)
  : Type := {

   sss_HG_wellformed : forall h g,
     HG h g
     -> H h /\ G g;

   sss_primexpr_erasure : forall w a g h b1 b2,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exprEval G (EPrim g) w b2
    -> b1=b2;

   sss_primexpr_safety : forall w a g h b1,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exists b2, exprEval G (EPrim g) w b2
}.(* Stratified Semantics with Separation -- this is where put everything together. *)
Class StratifiedSemanticsWithSeparation
  {W V G S' U F world_erase VU GF}
  `{StratifiedSemantics W V G S' U F world_erase VU GF}
  {A}
  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
   (* NOTE: Perhaps we also want   CA: Canc_alg A   *)
  (projA : W -> A)
  (* Projection function mapping worlds to elements of A *)
  (H : pfunc A val -> Prop)
  (* Set of primitive expressions on A -- we need these in order
     to use [assert_expr]-style predicates in our separation
     logic. *)
  (HG : pfunc A val -> pfunc W val -> Prop)
  (* Acceptable primitive expression pairs on A and W *)
  : Type := {

   sss_HG_wellformed : forall h g,
     HG h g
     -> H h /\ G g;

   sss_primexpr_erasure : forall w a g h b1 b2,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exprEval G (EPrim g) w b2
    -> b1=b2;

   sss_primexpr_safety : forall w a g h b1,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exists b2, exprEval G (EPrim g) w b2
}.(* Stratified Semantics with Separation -- this is where put everything together. *)
Class StratifiedSemanticsWithSeparation
  {W V G S' U F world_erase VU GF}
  `{StratifiedSemantics W V G S' U F world_erase VU GF}
  {A}
  {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}
   (* NOTE: Perhaps we also want   CA: Canc_alg A   *)
  (projA : W -> A)
  (* Projection function mapping worlds to elements of A *)
  (H : pfunc A val -> Prop)
  (* Set of primitive expressions on A -- we need these in order
     to use [assert_expr]-style predicates in our separation
     logic. *)
  (HG : pfunc A val -> pfunc W val -> Prop)
  (* Acceptable primitive expression pairs on A and W *)
  : Type := {

   sss_HG_wellformed : forall h g,
     HG h g
     -> H h /\ G g;

   sss_primexpr_erasure : forall w a g h b1 b2,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exprEval G (EPrim g) w b2
    -> b1=b2;

   sss_primexpr_safety : forall w a g h b1,
    HG h g
    -> projA w = a
    -> exprEval H (EPrim h) a b1
    -> exists b2, exprEval G (EPrim g) w b2
}.

Lemma sep_expr_erasure : forall e e' w b1 b2, expr_erase HG e e' -> exprEval H e (projA w) b1 -> exprEval G e' w b2 -> b1=b2.