Section SEMAX_SC.
Context {cs: compspecs}.
End SEMAX_SC.
(************************************************  The set, load, cast-load and store rules will be used in the future.  ************************************************)
Inductive Ptrofs_eqm_unsigned: ptrofs -> Z -> Prop :=
| Ptrofs_eqm_unsigned_repr: forall z, Ptrofs_eqm_unsigned (Ptrofs.repr z) z.
Ltac solve_Ptrofs_eqm_unsigned :=
solve
[ autorewrite with norm;
rewrite ?Ptrofs_repr_Int_unsigned_special by reflexivity;
rewrite ?Ptrofs_repr_Int64_unsigned_special by reflexivity;
match goal with
| |- Ptrofs_eqm_unsigned ?V _ =>
match V with
| Ptrofs.repr _ => idtac
| Ptrofs.sub _ _ => unfold Ptrofs.sub at 1
| Ptrofs.add _ _ => unfold Ptrofs.add at 1
| Ptrofs.mul _ _ => unfold Ptrofs.mul at 1
| Ptrofs.and _ _ => unfold Ptrofs.and at 1
| Ptrofs.or _ _ => unfold Ptrofs.or at 1
(*      | Int.shl _ _ => unfold Int.shl at 1 | Int.shr _ _ => unfold Int.shr at 1*)
| _ => rewrite <- (Ptrofs.repr_unsigned V) at 1
end
end;
rewrite ?ptrofs_unsigned_ofint64_repr by reflexivity;
apply Ptrofs_eqm_unsigned_repr
].
Inductive msubst_efield_denote {cs: compspecs} (Delta: tycontext) (T1: PTree.t val) (T2: PTree.t (type * val)) (GV: option globals): list efield -> list gfield -> Prop :=
| msubst_efield_denote_nil: msubst_efield_denote Delta T1 T2 GV nil nil
| msubst_efield_denote_cons_array: forall ei i i' efs gfs,
is_int_type (typeof ei) = true ->
msubst_eval_expr Delta T1 T2 GV  ei = Some (Vint i) ->
int_signed_or_unsigned (typeof ei) i = i' ->
msubst_efield_denote Delta T1 T2 GV efs gfs ->
msubst_efield_denote Delta T1 T2 GV (eArraySubsc ei :: efs) (ArraySubsc i' :: gfs)
| msubst_efield_denote_cons_array_ptrofs: forall ei i i' efs gfs,
is_ptrofs_type (typeof ei) = true ->
msubst_eval_expr Delta T1 T2 GV  ei = Some (Vptrofs i) ->
Ptrofs_eqm_unsigned i i' ->
msubst_efield_denote Delta T1 T2 GV efs gfs ->
msubst_efield_denote Delta T1 T2 GV (eArraySubsc ei :: efs) (ArraySubsc i' :: gfs)
| msubst_efield_denote_cons_struct: forall i efs gfs,
msubst_efield_denote Delta T1 T2 GV efs gfs ->
msubst_efield_denote Delta T1 T2 GV (eStructField i :: efs) (StructField i :: gfs)
| msubst_efield_denote_cons_union: forall i efs gfs,
msubst_efield_denote Delta T1 T2 GV efs gfs ->
msubst_efield_denote Delta T1 T2 GV (eUnionField i :: efs) (UnionField i :: gfs).
Ltac insist_rep_omega :=
(auto; rep_omega) ||
match goal with |- ?A =>
fail 1000 "load or store subscript failure: rep_omega cannot prove "A
end.
Ltac solve_msubst_efield_denote :=
solve
[ repeat first
[ eapply msubst_efield_denote_cons_array_ptrofs;
[ reflexivity
| etransitivity;
[solve_msubst_eval_expr
| apply f_equal_Some;
match goal with
| |- Vint ?a = Vptrofs ?b =>
is_evar b;
unify b (Ptrofs.of_int a);
unfold Vptrofs; change Archi.ptr64 with false; cbv iota;
rewrite (Ptrofs.to_int_of_int (eq_refl _));
reflexivity
| |- Vlong ?a = Vptrofs ?b =>
is_evar b;
unify b (Ptrofs.of_int64 a);
unfold Vptrofs; change Archi.ptr64 with true; cbv iota;
rewrite (Ptrofs.to_int64_of_int64 (eq_refl _));
reflexivity
| |- Vptrofs _ = Vptrofs _ => reflexivity
end
]
| solve_Ptrofs_eqm_unsigned
| ]
| eapply msubst_efield_denote_cons_array;
[ reflexivity
| solve_msubst_eval_expr
| rewrite ?ptrofs_to_int_repr; autorewrite with norm;
(* Maybe this lazymatch...end is not needed because the autorewrite with norm takes care of it? *)
lazymatch goal with
| |- int_signed_or_unsigned _ (Int.repr ?i) = ?j =>
let x := fresh "x" in set (x:=i);
let y := fresh "y" in set (y:=j);
unfold int_signed_or_unsigned; simpl;
subst x;
rewrite ?(Int.signed_repr i) by insist_rep_omega;
rewrite ?(Int.unsigned_repr i) by insist_rep_omega;
subst y
| |- int_signed_or_unsigned ?t _ = _ =>
try change (int_signed_or_unsigned t) with Int.signed;
try change (int_signed_or_unsigned t) with Int.unsigned
| |- _ => idtac
end;
reflexivity
(*      | solve_Ptrofs_eqm_unsigned *)
| ]
| apply msubst_efield_denote_cons_struct
| apply msubst_efield_denote_cons_union
| apply msubst_efield_denote_nil
]
].
Inductive field_address_gen {cs: compspecs}: type * list gfield * val -> type * list gfield * val -> Prop :=
| field_address_gen_nil: forall t1 t2 gfs p tgp,
nested_field_type t2 gfs = t1 ->
field_address_gen (t2, gfs, p) tgp ->
field_address_gen (t1, nil, (field_address t2 gfs p)) tgp
| field_address_gen_app: forall t1 t2 gfs1 gfs2 p tgp,
nested_field_type t2 gfs2 = t1 ->
field_address_gen (t2, gfs1 ++ gfs2, p) tgp ->
field_address_gen (t1, gfs1, (field_address t2 gfs2 p)) tgp
| field_address_gen_assu: forall t gfs p1 p2 tgp,
p1 = p2 ->
field_address_gen (t, gfs, p2) tgp ->
field_address_gen (t, gfs, p1) tgp
| field_address_gen_refl: forall tgp, field_address_gen tgp tgp.

Lemma field_address_gen_fact: forall {cs: compspecs} t1 gfs1 p1 t2 gfs2 p2,
field_address_gen (t1, gfs1, p1) (t2, gfs2, p2) ->
field_address t1 gfs1 p1 = field_address t2 gfs2 p2 /\
nested_field_type t1 gfs1 = nested_field_type t2 gfs2 /\
(field_compatible t2 gfs2 p2 -> field_compatible t1 gfs1 p1).