Section CENV.
Context {cs: compspecs}.
Definition union_default_filter m :=
match m with
| nil => fun _ => false
| hd :: _ => fun m => if member_dec hd m then true else false
end.
Definition is_default_filter {A} f (l: list A) :=
match l with
| nil => True
| hd :: _ => f hd = true
end.
(* Lemma union_default_filter_legal: forall m, m <> nil -> legal_compact_sum_filter (union_default_filter m) m = true. *)
Definition struct_default_val (m : members) := compact_prod_gen (fun it => default_val (field_type (fst it) m)) m.
Definition union_default_val (m : members) := compact_sum_gen (fun it => true) (fun it => default_val (field_type (fst it) m)) m.
Inductive pointer_val : Type :=
| ValidPointer: block -> Ptrofs.int -> pointer_val
| NullPointer.
compute; split; auto.
Defined.
Definition Int_zero := Int.mkint 0 zero_in_range.
Definition pointer_val_val (pv: pointer_val): val :=
match pv with
| ValidPointer b i => Vptr b i
| NullPointer => Vint Int.zero (* Vint Int_zero *)
end.
Definition reptype': type -> Type :=
type_func (fun _ => Type)
(fun t =>
if (type_is_by_value t)
then match t with
| Tint _ _ _ => int
| Tlong _ _ => Int64.int
| Tfloat _ _ => float
| Tpointer _ _ => pointer_val
| _ => val
end
else unit)
(fun t n a T => list T)
(fun id a T => compact_prod (decay T))
(fun id a T => compact_sum (decay T)).
Notation REPTYPE' t :=
match t return Type with
| Tvoid
| Tfunction _ _ _ => unit
| Tint _ _ a => int
| Tlong _ a => Int64.int
| Tfloat _ a => float
| Tpointer _ a => pointer_val
| Tarray t0 _ _ => list (reptype' t0)
| Tstruct id _ => compact_prod (map (fun it => reptype' (field_type (fst it) (co_members (get_co id)))) (co_members (get_co id)))
| Tunion id _ => compact_sum (map (fun it => reptype' (field_type (fst it) (co_members (get_co id)))) (co_members (get_co id)))
end.
End CENV.
Arguments reptype' {cs} t / .
Global Notation REPTYPE t :=
match t return Type with
| Tvoid
| Tfunction _ _ _ => unit
| Tint _ _ _
| Tlong _ _
| Tfloat _ _
| Tpointer _ _ => val
| Tarray t0 _ _ => list (reptype t0)
| Tstruct id _ => reptype_structlist (co_members (get_co id))
| Tunion id _ => reptype_unionlist (co_members (get_co id))
end.
Tactic Notation "unfold_repinj" :=
repeat match goal with |- context [repinj ?T] =>
let x := fresh "x" in set (x := repinj T);
lazy beta iota zeta delta in x; subst x; lazy beta
end.
Tactic Notation "unfold_repinj" constr(T) :=
match goal with |- context [repinj T] =>
let x := fresh "x" in set (x := repinj T);
lazy beta iota zeta delta in x; subst x; lazy beta
end.
(* Too expensive to do "pattern (repinj T V)", this can blow up. Tactic Notation "unfold_repinj" constr(T) constr(V) := pattern (repinj T V); unfold_repinj' T. *)
Fixpoint force_lengthn {A} n (xs: list A) (default: A) :=
match n, xs with
| O, _ => nil
| S n0, nil => default :: force_lengthn n0 nil default
| S n0, hd :: tl => hd :: force_lengthn n0 tl default
end.
(* "replist" is an alternative to zlist, avoids mysterious typeclass *)
Open Scope Z.
Fixpoint replist' {A: Type} {d: Inhabitant A} (lo: Z) (n: nat) (al: list A) :=
match n with
| O => nil
| S n' =>  Znth lo al :: replist' (Z.succ lo) n' al
end.
Definition replist {cs: compspecs} (t: type)  (lo hi: Z) (al: list (reptype t)) :=
replist'  lo (Z.to_nat (hi-lo)) al.
(* replist t lo hi al *)

Lemma replist_replist {cs: compspecs}:
forall t (lo hi lo' hi': Z) al,
0 <= lo <= hi ->
0 <= lo' <= hi' ->
lo'+hi <= hi'  ->
replist t lo hi (replist t lo' hi' al) =
replist t (lo+lo') (hi+lo') al.