Ltac solve_nptr p A :=
let H := fresh "H" in
match A with
| (?B * ?C) % logic =>
try solve [assert (~ isptr p -> B = FF) as H by solve_nptr p B;
intro; rewrite H by auto ; apply FF_sepcon];
try solve [assert (~ isptr p -> C = FF) as H by solve_nptr p C;
intro; rewrite H by auto; apply sepcon_FF]
| (?B && ?C) % logic =>
try solve [assert (~ isptr p -> B = FF) as H by solve_nptr p B;
intro; rewrite H by auto ; apply FF_andp];
try solve [assert (~ isptr p -> C = FF) as H by solve_nptr p C;
intro; rewrite H by auto; apply andp_FF]
| _ => apply (proj1 (not_ptr_FF A p)); solve_ptr p A
end
with solve_ptr p A :=
let p0 := fresh "p" in
match A with
| (_ * _) % logic => apply (proj2 (not_ptr_FF A p)); solve_nptr p A
| (_ && _) % logic => apply (proj2 (not_ptr_FF A p)); solve_nptr p A
| (!! _ /\ _)%logic => destruct A as [_ A]; solve_ptr p A
| (!! field_compatible _ _ ?q) => apply (derives_trans _ _ _ (prop_derives _ _ (field_compatible_isptr _ _ _))); solve_ptr_derives
| (!! field_compatible0 _ _ ?q) => apply (derives_trans _ _ _ (prop_derives _ _ (field_compatible0_isptr _ _ _))); solve_ptr_derives
| (memory_block _ _ ?q) => apply (derives_trans _ _ _ (memory_block_local_facts _ _ _)); solve_ptr_derives
| (withspacer _ _ _ ?P p) => apply withspacer_preserve_local_facts;
intro p0; solve_ptr p0 (P p0)
| (at_offset ?P _ ?q) => apply (derives_trans _ (!! isptr q));
[apply at_offset_preserve_local_facts; intro p0; solve_ptr p0 (P p0) |
solve_ptr_derives]
| (field_at _ _ _ _ p) => apply field_at_isptr'
end.
Ltac destruct_ptr p :=
let b := fresh "b" in
let ofs := fresh "OFS" in
match goal with
| |- (@eq mpred) ?A ?B =>
let H := fresh "H" in
let H0 := fresh "H" in
assert (~ isptr p -> A = FF) as H by solve_nptr p A;
assert (~ isptr p -> B = FF) as H0 by solve_nptr p B;
destruct p as [| | | | | b ofs]; try (rewrite H, H0 by (simpl; congruence); reflexivity);
clear H H0;
inv_int ofs
| |- (?A |-- _) =>
let H := fresh "H" in
assert (~ isptr p -> A = FF) as H by solve_nptr p A;
destruct p as [| | | | | b ofs]; try (rewrite H by (simpl; congruence); apply FF_left);
clear H;
inv_int ofs
end.

(* Specifications: *)
Lemma field_at_Tstruct: forall sh t gfs id a v1 v2 p,
nested_field_type t gfs = Tstruct id a ->
JMeq v1 v2 ->
field_at sh t gfs v1 p = nested_sfieldlist_at sh t gfs (co_members (get_co id)) v2 p.
Lemma field_at_Tunion: forall sh t gfs id a v1 v2 p,
nested_field_type t gfs = Tunion id a ->
JMeq v1 v2 ->
field_at sh t gfs v1 p = nested_ufieldlist_at sh t gfs (co_members (get_co id)) v2 p.
Lemma array_at_len_0: forall sh t gfs i p,
array_at sh t gfs i i nil p = !! (field_compatible0 t (ArraySubsc i :: gfs) p) && emp.
Lemma array_at_len_1: forall sh t gfs i v v' p,
JMeq v v' ->
array_at sh t gfs i (i + 1) (v :: nil) p = field_at sh t (ArraySubsc i :: gfs) v' p.
Lemma split2_array_at: forall sh t gfs lo mid hi v p,
lo <= mid <= hi ->
Zlength v = hi - lo ->
array_at sh t gfs lo hi v p =
array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p *
array_at sh t gfs mid hi (sublist (mid-lo) (Zlength v) v) p.
Lemma split3seg_array_at: forall sh t gfs lo ml mr hi v p,
lo <= ml ->
ml <= mr ->
mr <= hi ->
Zlength v = hi-lo ->
array_at sh t gfs lo hi v p =
array_at sh t gfs lo ml (sublist 0 (ml-lo) v) p*
array_at sh t gfs ml mr (sublist (ml-lo) (mr-lo) v) p *
array_at sh t gfs mr hi (sublist (mr-lo) (hi-lo) v) p.
Lemma split3_array_at: forall sh t gfs lo mid hi v v0 p,
lo <= mid < hi ->
Zlength v = hi-lo ->
JMeq v0 (Znth (mid-lo) v) ->
array_at sh t gfs lo hi v p =
array_at sh t gfs lo mid (sublist 0 (mid-lo) v) p *
field_at sh t (ArraySubsc mid :: gfs) v0 p *
array_at sh t gfs (mid + 1) hi (sublist (mid+1-lo) (hi-lo) v) p.