Section LIST1.
Context {cs: compspecs}.
Context  {list_structid: ident} {list_link: ident} {list_token: share -> val -> mpred}.
Fixpoint all_but_link (f: members) : members :=
match f with
| nil => nil
| cons it f' => if ident_eq (fst it) list_link
then f'
else cons it (all_but_link f')
end.
Definition elemtype (ls: listspec list_structid list_link list_token) :=
compact_prod
(map (fun it => reptype (field_type (fst it) list_fields)) (all_but_link list_fields)).
Definition field_type'  (F: members) (it: ident * type) :=
reptype (field_type (fst it) F).
Definition add_link_back' {F f: members}
(v: compact_prod (map (field_type' F) (all_but_link f))) :
compact_prod (map (field_type' F) f).
induction f as [| it0 f].
+ exact tt.
+  destruct f as [| it1 f0].
- exact (default_val _).
- change (all_but_link (it0 :: it1 :: f0))
with (if ident_eq (fst it0) list_link
then it1::f0
else cons it0 (all_but_link (it1::f0)))
in v.
change (reptype (field_type (fst it0) F) * compact_prod (map (field_type' F) (it1::f0)))%type.
destruct (ident_eq (fst it0) list_link).
exact (default_val _, v).
destruct (all_but_link (it1 :: f0)) eqn:?.
simpl in Heqm.
destruct (ident_eq (fst it1) list_link); [ | discriminate Heqm].
subst f0.
exact (v, default_val _).
exact (fst v, IHf (snd v)).
Defined.
Definition add_link_back
(F f : members)
(v : compact_prod
(map (fun it : ident * type => reptype (field_type (fst it) F))
(all_but_link f)))
: compact_prod (map (fun it => reptype (field_type (fst it) F)) f)
:=
list_rect
(fun f0 : list (ident * type) =>
compact_prod (map (field_type' F) (all_but_link f0)) ->
compact_prod (map (field_type' F) f0))
(fun _ : compact_prod (map (field_type' F) (all_but_link nil)) => tt)
(fun (it0 : ident * type) (f0 : list (ident * type))
(IHf : compact_prod (map (field_type' F) (all_but_link f0)) ->
compact_prod (map (field_type' F) f0))
(v0 : compact_prod (map (field_type' F) (all_but_link (it0 :: f0)))) =>
match
f0 as l
return
(compact_prod (map (field_type' F) (all_but_link (it0 :: l))) ->
(compact_prod (map (field_type' F) (all_but_link l)) ->
compact_prod (map (field_type' F) l)) ->
compact_prod (map (field_type' F) (it0 :: l)))
with
| nil =>
fun
(_ : compact_prod (map (field_type' F) (all_but_link (it0 :: nil))))
(_ : compact_prod (map (field_type' F) (all_but_link nil)) ->
compact_prod (map (field_type' F) nil)) =>
default_val (field_type (fst it0) F)
| it1 :: f1 =>
fun
(v1 : compact_prod
(map (field_type' F) (all_but_link (it0 :: it1 :: f1))))
(IHf0 : compact_prod
(map (field_type' F) (all_but_link (it1 :: f1))) ->
compact_prod (map (field_type' F) (it1 :: f1))) =>
(if ident_eq (fst it0) list_link as s0
return
(compact_prod
(map (field_type' F)
(if s0 then it1 :: f1 else it0 :: all_but_link (it1 :: f1))) ->
reptype (field_type (fst it0) F) *
compact_prod (map (field_type' F) (it1 :: f1)))
then
fun v2 : compact_prod (map (field_type' F) (it1 :: f1)) =>
(default_val (field_type (fst it0) F), v2)
else
fun
v2 : compact_prod
(map (field_type' F) (it0 :: all_but_link (it1 :: f1))) =>
match
all_but_link (it1 :: f1) as l
return
(all_but_link (it1 :: f1) = l ->
compact_prod (map (field_type' F) (it0 :: l)) ->
(compact_prod (map (field_type' F) l) ->
compact_prod (map (field_type' F) (it1 :: f1))) ->
reptype (field_type (fst it0) F) *
compact_prod (map (field_type' F) (it1 :: f1)))
with
| nil =>
fun (Heqm0 : all_but_link (it1 :: f1) = nil)
(v3 : compact_prod (map (field_type' F) (it0 :: nil)))
(IHf1 : compact_prod (map (field_type' F) nil) ->
compact_prod (map (field_type' F) (it1 :: f1))) =>
let s0 := ident_eq (fst it1) list_link in
(if s0
return
((if s0 then f1 else it1 :: all_but_link f1) = nil ->
reptype (field_type (fst it0) F) *
compact_prod (map (field_type' F) (it1 :: f1)))
then
fun Heqm1 : f1 = nil =>
eq_rect_r
(fun f2 : members =>
(compact_prod (map (field_type' F) nil) ->
compact_prod (map (field_type' F) (it1 :: f2))) ->
reptype (field_type (fst it0) F) *
compact_prod (map (field_type' F) (it1 :: f2)))
(fun
_ : compact_prod (map (field_type' F) nil) ->
compact_prod (map (field_type' F) (it1 :: nil)) =>
(v3, default_val (field_type (fst it1) F)))
Heqm1 IHf1
else
fun Heqm1 : it1 :: all_but_link f1 = nil =>
False_rect
(reptype (field_type (fst it0) F) *
compact_prod (map (field_type' F) (it1 :: f1)))
(eq_rect (it1 :: all_but_link f1)
(fun e : members =>
match e with
| nil => False
| _ :: _ => True
end) I nil Heqm1)) Heqm0
| p :: m0 =>
fun (_ : all_but_link (it1 :: f1) = p :: m0)
(v3 : compact_prod (map (field_type' F) (it0 :: p :: m0)))
(IHf1 : compact_prod (map (field_type' F) (p :: m0)) ->
compact_prod (map (field_type' F) (it1 :: f1))) =>
(fst v3, IHf1 (snd v3))
end eq_refl v2 IHf0) v1
end v0 IHf) f v.
(* Definition add_link_back {ls: listspec list_structid list_link} {f F: members} (v: compact_prod (map (fun it => reptype (field_type (fst it) F)) (all_but_link f))) : compact_prod (map (fun it => reptype (field_type (fst it) F)) f). unfold all_but_link in v. induction f as [| [i0 t0] f]. + exact tt. + simpl in *; destruct f as [| [i1 t1] f0] eqn:?; [| destruct (ident_eq i0 list_link)]. - exact (default_val _). - exact (default_val _, v). - fold (all_but_link ((i1, t1) :: f0)) in IHf, v. destruct (all_but_link ((i1, t1) :: f0)) eqn:?. * simpl in Heqm. if_tac in Heqm; [| congruence]. subst f0. exact (v, default_val _). * exact (fst v, IHf (snd v)). Defined. *)
Definition list_data {ls: listspec list_structid list_link list_token} (v: elemtype ls): reptype list_struct.
unfold list_struct.
pose (add_link_back _ _ v: reptype_structlist _).
rewrite list_members_eq in r.
exact (@fold_reptype _ (Tstruct _ _) r).
Defined.
Definition list_cell' (ls: listspec list_structid list_link list_token) sh v p :=
(field_at_ sh list_struct (StructField list_link :: nil) p) -* (data_at sh list_struct (list_data v) p).
Definition list_cell (ls: listspec list_structid list_link list_token) (sh: Share.t)
(v: elemtype ls) (p: val) : mpred :=
!! field_compatible list_struct nil p &&
struct_pred (all_but_link list_fields)
(fun it v => withspacer sh
(field_offset cenv_cs (fst it) list_fields + sizeof (field_type (fst it) list_fields))
(field_offset_next cenv_cs (fst it) list_fields (co_sizeof (get_co list_structid)))
(at_offset (data_at_rec sh (field_type (fst it) list_fields) v) (field_offset cenv_cs (fst it) list_fields)))
v p.

Lemma list_cell_link_join:
forall (LS: listspec list_structid list_link list_token) sh v p,
list_cell LS sh 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
(co_sizeof (get_co list_structid)))
(offset_val 0 p)
* field_at_ sh list_struct (StructField list_link :: nil) p
= data_at sh list_struct (list_data v) p.