(* rewrite <- !gather_prop_left. rewrite !(prop_true_andp _ _ f). rewrite (prop_true_andp (field_compatible list_struct (StructField list_link :: nil) p)) by admit. normalize. apply andp_prop_ext. admit. intro HV. clear HV. change  (nested_field_type list_struct nil) with list_struct. rewrite (data_at_rec_ind sh list_struct (@fold_reptype cs (Tstruct list_structid noattr) (@eq_rect members (@list_fields cs list_structid list_link LS) (fun m : members => @reptype_structlist cs m) (@add_link_back (@list_fields cs list_structid list_link LS) (@list_fields cs list_structid list_link LS) v) (co_members (@get_co cs list_structid)) (@list_members_eq cs list_structid list_link LS)))). simpl. forget (co_sizeof (get_co list_structid)) as sz. assert (FT: field_type list_link list_fields = tptr list_struct). admit. pose (P m := fun (it : ident * type) (v0 : reptype (field_type (fst it) m)) => withspacer sh (field_offset cenv_cs (fst it) m + sizeof (field_type (fst it) m)) (field_offset_next cenv_cs (fst it) m sz) (at_offset (data_at_rec sh (field_type (fst it) m) v0) (field_offset cenv_cs (fst it) m))). fold (P list_fields). fold (P (co_members (get_co list_structid))). transitivity (at_offset (struct_pred (co_members (get_co list_structid)) (P (co_members (get_co list_structid))) ( (eq_rect list_fields (fun m : members => reptype_structlist m) (add_link_back _ _ v) (co_members (get_co list_structid)) list_members_eq))) (nested_field_offset list_struct nil) p); [ | f_equal; f_equal; rewrite unfold_fold_reptype; reflexivity ]. unfold at_offset. rewrite (data_at_rec_type_changable sh (nested_field_type list_struct (StructField list_link :: nil)) (tptr list_struct) (default_val _) Vundef list_link_type) by (rewrite by_value_default_val; try reflexivity; rewrite list_link_type; reflexivity). set (ofs := Int.repr (nested_field_offset list_struct (StructField list_link :: nil))). assert (Hofs: ofs = Int.repr (field_offset cenv_cs list_link list_fields)). { unfold ofs. clear. f_equal. unfold list_struct. pose proof list_link_type. unfold nested_field_offset. simpl. rewrite list_members_eq. unfold list_struct, nested_field_type in H; simpl in H. destruct (compute_in_members list_link (co_members (get_co list_structid))); inv H. reflexivity. } revert v; unfold elemtype. fold (field_type' list_fields). pose (m := list_fields). pose (m' := co_members (get_co list_structid)). set (H := list_members_eq). clearbody H. revert H. change (forall (H: m=m') (v : compact_prod (map (field_type' list_fields) (all_but_link m))), struct_pred (all_but_link m) (P list_fields) v p  * spacer sh (field_offset cenv_cs list_link list_fields + sizeof (field_type list_link list_fields)) (field_offset_next cenv_cs list_link list_fields sz) p* data_at_rec sh (tptr list_struct) Vundef (offset_val ofs p) = struct_pred m' (P m') (eq_rect m reptype_structlist (add_link_back list_fields m v) m' H) (offset_val (Int.repr 0) p)). assert  (MNR := get_co_members_no_replicate list_structid). fold m' in MNR. revert MNR. clearbody m'. intros. subst m'. rewrite <- eq_rect_eq. assert (In list_link (map fst m)). { unfold m. rewrite list_members_eq. pose proof list_link_type. unfold nested_field_type in H. unfold list_struct in H. unfold nested_field_rec in H. destruct (compute_in_members list_link (co_members (get_co list_structid))) eqn:?; inv H. apply compute_in_members_true_iff; auto. } change (struct_pred (all_but_link m) (P list_fields) v p  * spacer sh (field_offset cenv_cs list_link list_fields + sizeof (field_type list_link list_fields)) (field_offset_next cenv_cs list_link list_fields sz) p* data_at_rec sh (tptr list_struct) Vundef (offset_val ofs p) = struct_pred m (P list_fields) (add_link_back list_fields m v) (offset_val (Int.repr 0) p)). revert MNR H v; clearbody m. induction m; intros; [inv H | ]. simpl in H. assert (H': In list_link (map fst m) -> fst a <> list_link). clear - MNR. unfold members_no_replicate in MNR. intros; simpl in *.  destruct (id_in_list (fst a) (map fst m)) eqn:?. inv MNR. apply id_in_list_false in Heqb. intro. congruence. destruct H. * (* list_link is the first field *)
clear H'.
destruct a. simpl in H. subst i.
destruct m.
Opaque field_offset. Opaque field_type. simpl.
Transparent field_offset. Transparent field_type.
assert ((if ident_eq list_link list_link then nil else (list_link, t) :: nil) = nil)
by (rewrite if_true; auto).
simpl in v.
assert (exists v' : compact_prod (map (field_type' list_fields) nil), JMeq v' v).  {
revert H v.
clear.
pose (j := if ident_eq list_link list_link
then @nil (ident * type) else (list_link, t) :: @nil (ident * type)).
change (j = nil ->
forall
v : compact_prod (map (field_type' list_fields) j),
exists v' : compact_prod (map (field_type' list_fields) nil), JMeq v' v).
clearbody j.
intros; subst. exists v; reflexivity.
}
destruct H0 as [v' ?].
replace (struct_pred
(if ident_eq list_link list_link then nil else (list_link, t) :: nil)
(P list_fields) v p) with
(struct_pred nil (P list_fields) v' p).
Focus 2.
if_tac; [ | congruence]. reflexivity.
Opaque field_offset. Opaque field_type. simpl.
Transparent field_offset. Transparent field_type.
rewrite emp_sepcon.
clear v' H0 H v IHm.
unfold P.
rewrite withspacer_spacer.
unfold at_offset. simpl @fst.
f_equal.
rewrite isptr_offset_val_zero by auto.
auto.
rewrite offset_offset_val, Int.add_zero_l.
rewrite Hofs.
apply equal_f.
apply data_at_rec_type_changable; auto.
rewrite FT. reflexivity.
assert (all_but_link ((list_link,t)::p0::m) = p0::m).
simpl. rewrite if_true by auto; reflexivity.
assert (all_but_link (p0::m) = p0::m). {
clear - MNR H.
admit. (* easy enough *)
}
rewrite struct_pred_cons2.
unfold P at 2.
rewrite withspacer_spacer.
rewrite Hofs. unfold at_offset.
rewrite offset_offset_val, Int.add_zero_l.
change (fst (list_link, t)) with list_link.
rewrite isptr_offset_val_zero by auto.
pull_right (spacer sh
(field_offset cenv_cs list_link list_fields +
sizeof (field_type list_link list_fields))
(field_offset_next cenv_cs list_link list_fields sz) p).
f_equal.
rewrite sepcon_comm.
f_equal.
apply equal_f.
apply data_at_rec_type_changable; auto.
apply JMeq_trans with (B:= reptype (field_type list_link list_fields)) (y:= default_val (field_type list_link list_fields)).
rewrite FT. reflexivity.
match goal with |- JMeq ?A ?B => replace A with B end.
apply JMeq_refl.
clear.
revert v.
unfold all_but_link.
unfold add_link_back.
unfold list_rect at 1.
simpl @fst.
destruct (ident_eq list_link list_link); [ | elimtype False; congruence]; intro.
simpl. reflexivity.
apply struct_pred_type_changable; auto.
clear.
revert v.
simpl.
destruct (ident_eq list_link list_link); [ | elimtype False; congruence]; intro.
simpl. reflexivity.
* (* list link is not the first field *)
specialize (H' H).
destruct m; [inv H | ].
rewrite struct_pred_cons2.
assert (all_but_link (a :: p0 :: m) = a :: all_but_link (p0::m)). {
clear - MNR H. forget (p0::m) as m'. clear p0 m.
induction m'. inv H.
unfold all_but_link; fold all_but_link.
unfold members_no_replicate in *.
rewrite map_cons in MNR.
unfold compute_list_norepet in MNR.
fold compute_list_norepet in MNR.
destruct (id_in_list (fst a) (map fst (a0 :: m'))) eqn:?; [discriminate | ].
simpl in Heqb. rewrite orb_false_iff in Heqb. destruct Heqb.
apply Pos.eqb_neq in H0.
apply id_in_list_false in H1.
simpl in H. destruct H.
rewrite H in *. rewrite if_false by auto. auto.
rewrite if_false by congruence. auto.
}
unfold members_no_replicate in *.
simpl in MNR.
destruct ((fst a =? fst p0)%positive || id_in_list (fst a) (map fst m))%bool eqn:?; try discriminate.
rewrite orb_false_iff in Heqb. destruct Heqb.
apply Pos.eqb_neq in H1.
apply id_in_list_false in H2.
specialize (IHm MNR H).
destruct p0 as [i t].
(* simpl in v'. *)
simpl in H1. clear MNR H.
destruct (ident_eq i list_link).
+ subst i.
assert (exists v' : compact_prod (map (field_type' list_fields) (a :: m)),
JMeq v v'). {
revert v; clear - H0.
replace (all_but_link ((list_link, t) :: m)) with m in H0
by (simpl; rewrite if_true by auto; auto).
rewrite H0. eexists; eauto.
}
destruct H as [v' H3].
simpl in v'.
destruct m.
-
simpl in v'.
assert (exists v'': compact_prod
(map (field_type' list_fields)
(all_but_link ((list_link, t) :: nil))), JMeq v'' tt). {
clear. simpl. rewrite if_true by auto. exists tt; reflexivity.
}
destruct H as [v'' H4].
specialize (IHm v'').
replace (struct_pred (all_but_link ((list_link, t) :: nil)) (P list_fields) v'' p) with
(struct_pred nil (P list_fields) tt p) in IHm
by (apply struct_pred_type_changable; auto; simpl; rewrite if_true; auto).
change (struct_pred nil (P list_fields) tt p) with emp in IHm.
rewrite emp_sepcon in IHm.
rewrite sepcon_assoc. rewrite IHm; clear IHm.
f_equal.
assert (exists v4: compact_prod
(map (field_type' list_fields) (a::nil)), JMeq v4 v). {
clear - H1. revert v. simpl. rewrite if_false by auto. rewrite if_true by auto.
eexists; eauto.
}
destruct H as [v4 H5].
transitivity (struct_pred (a :: nil) (P list_fields) v4 (offset_val (Int.repr 0) p)).
apply struct_pred_type_changable; auto.
simpl. rewrite if_false by auto; rewrite if_true by auto. auto.
admit. (* see proof above *)
destruct a as [i' t'].
unfold struct_pred at 1.
unfold list_rect.
f_equal.
clear - H1 H5. simpl in H1.
admit.  (* tedious *)
apply struct_pred_type_changable; auto.
clear - H1 H4 H3.
simpl in v'.
admit.  (* tedious *)
-
simpl map at 1 in v'. cbv beta iota in v'.
destruct v' as [va vr].
assert (exists vr' : compact_prod
(map (field_type' list_fields)
(all_but_link ((list_link, t) :: p0 :: m))),
JMeq vr vr'). {
clear - H1; simpl in H1.
simpl. rewrite if_true by auto. exists vr; eauto.
} destruct H as [vr' H4].
specialize (IHm vr').
replace (struct_pred (all_but_link (a :: (list_link, t) :: p0 :: m)) (P list_fields) v p)
with (P list_fields a
(fst (add_link_back list_fields (a :: (list_link, t) :: p0 :: m) v))
(offset_val (Int.repr 0) p) *
struct_pred (all_but_link ((list_link, t) :: p0 :: m)) (P list_fields) vr' p).
rewrite !sepcon_assoc. f_equal.
rewrite <- sepcon_assoc.
rewrite IHm.
apply struct_pred_type_changable; auto.
clear - H3 H4 H1.
admit.  (* tedious *)
clear - H3 H4 H1 H0.
transitivity (P list_fields a va p *
struct_pred (all_but_link ((list_link, t) :: p0 :: m)) (P list_fields) vr' p).
f_equal.
unfold P; rewrite !withspacer_spacer; f_equal. rewrite <- spacer_offset_zero. auto.
unfold at_offset. rewrite offset_offset_val. rewrite Int.add_zero_l.
f_equal.
admit.  (* tedious *)
assert (exists v6: compact_prod (map (field_type' list_fields) (a :: p0 :: m)),
JMeq v v6). {
clear - H1 H0.
simpl all_but_link at 2 in H0. rewrite if_true in H0 by auto.
revert v; rewrite H0. intros. exists v; auto.
} destruct H as [v6 H].
transitivity (struct_pred (a :: p0 :: m) (P list_fields) v6 p).
rewrite struct_pred_cons2. f_equal.
unfold P; rewrite !withspacer_spacer; f_equal.
unfold at_offset.
f_equal. rewrite H in H3. clear - H3. apply JMeq_eq in H3. subst; reflexivity.
apply struct_pred_type_changable; auto.
simpl. rewrite if_true by auto. auto.
rewrite H in H3.
clear - H3 H4.
eapply JMeq_trans. apply JMeq_sym. apply H4.
destruct v6.
clear - H3. simpl.
apply JMeq_eq in H3. inv H3; auto.
apply struct_pred_type_changable; auto.
simpl. rewrite if_false by auto. rewrite if_true by auto. auto.
+
assert (all_but_link ((i,t)::m) = (i,t)::all_but_link m).
simpl. rewrite if_false by auto; auto.
assert (exists v' :
(field_type' list_fields a * compact_prod (map (field_type' list_fields) (all_but_link ((i, t) :: m)))), JMeq v v'). {
clear - H H0 v. revert v; rewrite H0. rewrite H.
simpl. intros. exists v; reflexivity.
} destruct H3 as [v' Hv'].
destruct v' as [v1 vr].
specialize (IHm vr).
replace (struct_pred (all_but_link (a :: (i, t) :: m)) (P list_fields) v p)
with (P list_fields a (fst (add_link_back list_fields (a :: (i, t) :: m) v))
(offset_val (Int.repr 0) p) *
struct_pred (all_but_link ((i, t) :: m)) (P list_fields) vr p).
rewrite !sepcon_assoc. f_equal.
rewrite <- sepcon_assoc.
rewrite IHm. clear IHm.
apply struct_pred_type_changable; auto.
admit.  (* tedious *)
assert (exists v'': compact_prod
(field_type' list_fields a :: field_type' list_fields (i,t) :: map (field_type' list_fields) (all_but_link m)),
JMeq v v''). {
clear - H H0. revert v; rewrite H0. rewrite H. intros; exists v. reflexivity.
} destruct H3 as [v'' Hv''].
transitivity (struct_pred (a :: (i,t) :: all_but_link m) (P list_fields) v'' p).
rewrite struct_pred_cons2.
f_equal.
admit.  (* tedious *)
apply struct_pred_type_changable; auto.
clear - Hv' Hv''. rewrite Hv'' in Hv'. simpl in v''. destruct v''.
clear - Hv'.
admit.  (* tedious *)
apply struct_pred_type_changable; auto.
rewrite H0. rewrite H. auto.
Qed.
*)

(* Specifications: *)
Lemma list_cell_link_join_nospacer:
forall (LS: listspec list_structid list_link list_token) sh v p,
field_offset cenv_cs list_link list_fields +
sizeof (field_type list_link list_fields) =
field_offset_next cenv_cs list_link list_fields
(co_sizeof (get_co list_structid)) ->
list_cell LS sh v p * field_at_ sh list_struct (StructField list_link :: nil) p
= data_at sh list_struct (list_data v) p.