Fixpoint hlist_get ls a (m : member a ls) : hlist ls -> F a :=
match m in member _ ls return hlist ls -> F a with
| MZ _ => hlist_hd
| MN _ _ r => fun hl => hlist_get r (hlist_tl hl)
end.
Fixpoint hlist_nth_error {ls} (hs : hlist ls) (n : nat)
: option (match nth_error ls n with
| None => unit
| Some x => F x
end) :=
match hs in hlist ls return option (match nth_error ls n with
| None => unit
| Some x => F x
end)
with
| Hnil => None
| Hcons l ls h hs =>
match n as n return option (match nth_error (l :: ls) n with
| None => unit
| Some x => F x
end)
with
| 0 => Some h
| S n => hlist_nth_error hs n
end
end.
Polymorphic Fixpoint hlist_nth ls (h : hlist ls) (n : nat) :
match nth_error ls n return Type with
| None => unit
| Some t => F t
end :=
match h in hlist ls , n as n
return match nth_error ls n with
| None => unit
| Some t => F t
end
with
| Hnil , 0 => tt
| Hnil , S _ => tt
| Hcons _ _ x _ , 0 => x
| Hcons _ _ _ h , S n => hlist_nth h n
end.
Fixpoint nth_error_hlist_nth ls (n : nat)
: option (hlist ls -> match nth_error ls n with
| None => Empty_set
| Some x => F x
end) :=
match ls as ls
return option (hlist ls -> match nth_error ls n with
| None => Empty_set
| Some x => F x
end)
with
| nil => None
| l :: ls =>
match n as n
return option (hlist (l :: ls) -> match nth_error (l :: ls) n with
| None => Empty_set
| Some x => F x
end)
with
| 0 => Some hlist_hd
| S n =>
match nth_error_hlist_nth ls n with
| None => None
| Some f => Some (fun h => f (hlist_tl h))
end
end
end.
Definition cast1 T l
: forall (l' : list T) n v,
nth_error l n = Some v -> Some v = nth_error (l ++ l') n.
Section type.
Variable eqv : forall x, type (F x).
Global Instance type_hlist (ls : list iT): type (hlist ls) :=
{ equal := @equiv_hlist (fun x => @equal _ (eqv x)) ls
; proper :=
(fix recur ls (h : hlist ls) : Prop :=
match h with
| Hnil => True
| Hcons _ _ x y => proper x /\ recur _ y
end) ls
}.
Variable eqvOk : forall x, typeOk (eqv x).
Global Instance typeOk_hlist (ls : list iT): typeOk (type_hlist ls).
Global Instance proper_hlist_app l l' : proper (@hlist_app l l').

(* Specifications: *)
Lemma hlist_app_assoc : forall ls ls' ls''
(a : hlist ls) (b : hlist ls') (c : hlist ls''),
hlist_app (hlist_app a b) c =
match eq_sym (app_ass_trans ls ls' ls'') in _ = t return hlist t with
| eq_refl => hlist_app a (hlist_app b c)
end.
Lemma hlist_app_assoc'
: forall (ls ls' ls'' : list iT)
(a : hlist ls) (b : hlist ls') (c : hlist ls''),
hlist_app a (hlist_app b c) =
match
app_ass_trans ls ls' ls'' in (_ = t) return (hlist t)
with
| eq_refl => hlist_app (hlist_app a b) c
end.