Require Export VST.veric.lift.
Require Export VST.veric.Cop2.
Inductive rel_expr' {CS: compspecs} (rho: environ) (phi: rmap): expr -> val -> Prop :=
| rel_expr'_const_int: forall i ty,
rel_expr' rho phi (Econst_int i ty) (Vint i)
| rel_expr'_const_float: forall f ty,
rel_expr' rho phi (Econst_float f ty) (Vfloat f)
| rel_expr'_const_single: forall f ty,
rel_expr' rho phi (Econst_single f ty) (Vsingle f)
| rel_expr'_const_long: forall i ty,
rel_expr' rho phi (Econst_long i ty) (Vlong i)
| rel_expr'_tempvar: forall id ty v,
Map.get (te_of rho) id = Some v ->
rel_expr' rho phi (Etempvar id ty) v
| rel_expr'_addrof: forall a ty v,
rel_lvalue' rho phi a v ->
rel_expr' rho phi (Eaddrof a ty) v
| rel_expr'_unop: forall a v1 v ty op,
rel_expr' rho phi a v1 ->
(forall m, Cop.sem_unary_operation op v1 (typeof a) m = Some v) ->
rel_expr' rho phi (Eunop op a ty) v
| rel_expr'_binop: forall a1 a2 v1 v2 v ty op,
rel_expr' rho phi a1 v1 ->
rel_expr' rho phi a2 v2 ->
binop_stable cenv_cs op a1 a2 = true ->
(forall m, Cop.sem_binary_operation cenv_cs op v1 (typeof a1) v2 (typeof a2) m = Some v) ->
rel_expr' rho phi (Ebinop op a1 a2 ty) v
| rel_expr'_cast: forall a v1 v ty,
rel_expr' rho phi a v1 ->
(forall m, Cop.sem_cast v1 (typeof a) ty m = Some v) ->
rel_expr' rho phi (Ecast a ty) v
| rel_expr'_sizeof: forall t ty,
complete_type cenv_cs t = true ->
rel_expr' rho phi (Esizeof t ty) (Vptrofs (Ptrofs.repr (sizeof t)))
| rel_expr'_alignof: forall t ty,
complete_type cenv_cs t = true ->
rel_expr' rho phi (Ealignof t ty) (Vptrofs (Ptrofs.repr (alignof t)))
| rel_expr'_lvalue_By_value: forall a ch sh v1 v2,
access_mode (typeof a) = By_value ch ->
rel_lvalue' rho phi a v1 ->
app_pred (mapsto sh (typeof a) v1 v2 * TT ) phi ->
v2 <> Vundef ->
readable_share sh ->
rel_expr' rho phi a v2
| rel_expr'_lvalue_By_reference: forall a v1,
access_mode (typeof a) = By_reference ->
rel_lvalue' rho phi a v1 ->
rel_expr' rho phi a v1
with rel_lvalue' {CS: compspecs} (rho: environ) (phi: rmap): expr -> val -> Prop :=
| rel_expr'_local: forall id ty b,
Map.get (ve_of rho) id = Some (b,ty) ->
rel_lvalue' rho phi (Evar id ty) (Vptr  b Ptrofs.zero)
| rel_expr'_global: forall id ty b,
Map.get (ve_of rho) id = None ->
Map.get (ge_of rho) id = Some b ->
rel_lvalue' rho phi (Evar id ty) (Vptr b Ptrofs.zero)
| rel_lvalue'_deref: forall a b z ty,
rel_expr' rho phi a (Vptr b z) ->
rel_lvalue' rho phi (Ederef a ty) (Vptr b z)
| rel_lvalue'_field_struct: forall i ty a b z id co att delta,
rel_lvalue' rho phi a (Vptr b z) ->
typeof a = Tstruct id att ->
cenv_cs ! id = Some co ->
field_offset cenv_cs i (co_members co) = Errors.OK delta ->
rel_lvalue' rho phi (Efield a i ty) (Vptr b (Ptrofs.add z (Ptrofs.repr delta))).
Scheme rel_expr'_sch := Minimality for rel_expr' Sort Prop
with rel_lvalue'_sch := Minimality for  rel_lvalue' Sort Prop.
Definition rel_LR'_sch := fun CS rho phi P P0 H H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 e v => conj (rel_expr'_sch CS rho phi P P0 H H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 e v) (rel_lvalue'_sch CS rho phi P P0 H H0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 e v).
Program Definition rel_expr {CS: compspecs} (e: expr) (v: val) (rho: environ) : pred rmap :=
fun phi => rel_expr' rho phi e v.
Next Obligation. intros. apply rel_expr'_hered. Defined.
Program Definition rel_lvalue {CS: compspecs}  (e: expr) (v: val) (rho: environ) : pred rmap :=
fun phi => rel_lvalue' rho phi e v.
Next Obligation. intros. apply rel_lvalue'_hered. Defined.
Definition rel_lvalue'_expr'_sch CS rho phi P P0 :=
fun H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17 =>
conj (rel_expr'_sch CS rho phi P P0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17)
(rel_lvalue'_sch CS rho phi P P0 H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11 H12 H13 H14 H15 H16 H17).
(*genv_cenv ge = cenv_cs ->*) (cenv_sub cenv_cs (genv_cenv ge)) -> rho = construct_rho (filter_genv ge) ve te -> rel_expr e v rho (m_phi jm) -> Clight.eval_expr ge ve te (m_dry jm) e v.  Lemma rel_lvalue_relate: forall {CS: compspecs}  ge te ve rho e jm b z, (*genv_cenv ge = cenv_cs ->*) (cenv_sub cenv_cs (genv_cenv ge)) -> rho = construct_rho (filter_genv ge) ve te -> rel_lvalue e (Vptr b z) rho (m_phi jm) -> Clight.eval_lvalue ge ve te (m_dry jm) e b z.  Lemma sem_cast_load_result: forall v1 t1 t2 v2 ch m, access_mode t1 = By_value ch -> (*  Clight.eval_expr ge ve te m e2 v1 -> *)
intros.
apply (rel_LR'_sch _ rho phi
(fun e v => forall v', rel_expr' rho phi e v' -> v=v')
(fun e v => forall v', rel_lvalue' rho phi e v' -> v=v'));
auto; intros;
try match goal with H : _ |- _ => inv H; auto; try congruence end;
try match goal with H: rel_lvalue' _ _ _ _ |- _ => solve [inv H] end.
* (* Eunop *)
specialize (H0 _ H7). specialize (H8 Mem.empty). congruence.
* (* Ebinop *)
specialize (H0 _ H10). specialize (H2 _ H12).
specialize (H4 Mem.empty). specialize (H14 Mem.empty).
congruence.
* (* Ecast *)
specialize (H0 _ H5). specialize (H1 Mem.empty). congruence.
*  inversion2 H H6.
specialize (H1 _ H7).
subst v0.   clear H0 H7.
generalize H2; intros [wx [wy [_ [? _]]]].
unfold mapsto in *.
destruct (access_mode (typeof a)); try contradiction.
destruct (type_is_volatile (typeof a)); try contradiction.
destruct v1; try contradiction.
rewrite if_true in H0, H2, H8 by auto.
destruct H0 as [[? ?]|[? ?]]; [ |  hnf in H0; contradiction].
clear H1.
rewrite distrib_orp_sepcon in H2, H8.
destruct H2 as [H2 |[? [? [? [[Hx _] _]]]]]; [ | hnf in Hx; contradiction].
destruct H8 as [H8 |[? [? [? [[Hx _] _]]]]]; [ | hnf in Hx; contradiction].
autorewrite with normalize in H2, H8; auto with typeclass_instances.
destruct H8.
eapply res_predicates.address_mapsto_fun; split; eauto.
*
specialize (H0 _ H8). congruence.
Qed.

Lemma rel_LR_extend:
forall {CS: compspecs} e v rho w,
(rel_expr' rho w e v -> forall w', extendM w w' -> rel_expr' rho w' e v) /\
(rel_lvalue' rho w e v -> forall w', extendM w w' -> rel_lvalue' rho w' e v).