Global Set Automatic Coercions Import.
Set Implicit Arguments.
(* Intended for use without Import. *)
Require Vector.
Require List.
Arguments Vector.cons [A] _ [n].
Arguments Vector.nil [A].
(* eliminators/inversion *)
Definition head A n (v: Vector.t A (S n)): A :=
match v with
| Vector.nil => I | Vector.cons h _ _ => h
end.
Definition tail n A (v: Vector.t A (S n)): Vector.t A n :=
match v with
| Vector.nil => I | Vector.cons _ _ t => t
end.
(* conversion to/from list *)
Fixpoint to_list X (n: nat) (v: Vector.t X n) {struct v}: List.list X :=
match v with
| Vector.nil => List.nil | Vector.cons x _ v' => List.cons x (to_list v')
end.
Fixpoint from_list A (l: List.list A): Vector.t A (List.length l) :=
match l return Vector.t A (List.length l) with
| List.nil => Vector.nil | List.cons h t => Vector.cons h (from_list t)
end.
Coercion to_list: Vector.t >-> List.list.
Coercion from_list: List.list >-> Vector.t.
Proof with try reflexivity. induction l... simpl. rewrite IHl... Qed.
Proof with auto.
revert f.
induction v...
intros.
simpl.
apply (IHv (fun (m: nat) (w: Vector.t X m) => f (S m) (Vector.cons h w))).
Qed.
Proof with auto.
induction n; intros.
rewrite (eq_nil x), (eq_nil y)...
rewrite (eq_cons x), (eq_cons y) in *...
inversion H.
rewrite (IHn (tail x) (tail y))...
Qed.
Proof with auto.
induction l; simpl; intros.
rewrite (eq_nil v)...
rewrite <- H...
simpl.
rewrite list_round_trip...
Qed.
(* simultaneous induction over two vectors *)
(* misc *)
Proof with auto. induction l... simpl. apply eq_S... Qed.
Fixpoint app A n: Vector.t A n -> forall m, Vector.t A m -> Vector.t A (n + m) :=
match n return Vector.t A n -> forall m, Vector.t A m -> Vector.t A (n + m) with
| 0 => fun _ _ w => w
| S n' => fun v _ w => Vector.cons (head v) (app (tail v) w)
end.
(* vmap *)
Fixpoint map X Y (f: X -> Y) (n: nat) (v: Vector.t X n): Vector.t Y n :=
match v with
| Vector.nil => @Vector.nil Y
| Vector.cons h _ t => Vector.cons (f h) (map f t)
end.
(*Fixpoint map X Y (f: X -> Y) (n: nat): Vector.t X n -> Vector.t Y n := match n with | 0 => fun _ => Vector.nil Y | S n' => fun v => Vector.cons (f (head v)) (map f (tail v)) end.*)
Proof with auto.
induction v...
simpl.
rewrite IHv...
Qed.
Proof with auto.
induction v...
simpl.
rewrite IHv.
rewrite (e h)...
Qed. (* todo: as a morphism *)
(* vnth *)
Definition natBelow_S_bla (T: Type) (n: nat) (b: natBelow n): T -> (natBelow (pred n) -> T) -> T :=
match b with
| mkNatBelow 0 _ => fun z s => z
| mkNatBelow (S i) p => fun z s => s (mkNatBelow i p)
end.
Proof with auto.
induction v.
inversion i.
simpl.
destruct (natBelow_S_inv i).
destruct s.
subst.
simpl.
unfold natBelow_S_bla.
unfold Snb.
simpl.
destruct x.
apply IHv.
subst...
Qed.
Proof with auto.
revert n x y.
apply (double_rect (fun n (x y: Vector.t A n) => ext_eq (nth x) (nth y) -> x = y))...
intros.
cset (H0 (nb0 n)).
simpl in H1.
subst.
rewrite H...
intro.
cset (H0 (Snb x)).
repeat rewrite nth_S in H1...
Qed.
Proof with auto.
induction i using natBelow_rect in v |- *.
simpl.
intros.
rewrite (eq_cons v).
simpl head.
left...
intros.
rewrite (eq_cons v).
right.
simpl plus.
fold (Snb (mkNatBelow v0 p)).
rewrite nth_S...
Qed.
Proof with auto.
induction n.
intros.
rewrite (eq_nil v)...
intros.
rewrite (eq_cons v).
simpl.
rewrite IHn...
Qed.
Proof with auto.
induction v.
intros.
inversion H.
intros.
inversion_clear H.
exists (nb0 n).
simpl...
destruct (IHv H0).
exists (Snb x).
rewrite nth_S...
Qed.

Lemma nb_val_eq_rec_r (k u: nat) (n: natBelow u) (h: k = u):
nb_val (eq_rec_r natBelow n h) = nb_val n.