VectorRefinement.v

From Tealeaves Require Export
  Classes.Categorical.Applicative
  Classes.Kleisli.TraversableFunctor
  Classes.Kleisli.Theory.TraversableFunctor (* mapReduce *)
  Functors.List.

From Coq Require Import
  Logic.ProofIrrelevance.

#[local] Generalizable Variables ϕ T G A B C D M F n m p v.
Import Monoid.Notations.
Import Applicative.Notations.

(** * Refinement-style vectors *)
(******************************************************************************)
Definition Vector (n: nat) (A: Type) : Type :=
  {l : list A | length l = n}.

(** ** Coercing lengths *)
(******************************************************************************)
Definition coerce_Vector_length:
  forall {A: Type} `(Heq: n = m),
    Vector n A -> Vector m A.forall (A : Type) (n m : nat),
n = m -> Vector n A -> Vector m A
Proof.forall (A : Type) (n m : nat),
n = m -> Vector n A -> Vector m A
  introv heq [v pf].A: Type
n, m: nat
heq: n = m
v: list A
pf: length v = n
Vector m A
  exists v.A: Type
n, m: nat
heq: n = m
v: list A
pf: length v = n
length v = m now subst.
Defined.

#[global] Notation "'coerce' Hlen 'in' V" :=
  (coerce_Vector_length Hlen V)
    (at level 10, V at level 10).

#[global] Notation "'precoerce' Hlen 'in' F" :=
  (F ○ coerce_Vector_length Hlen)
    (at level 10, F at level 20).

Lemma coerce_Vector_contents:
  forall {A: Type} `(Heq: n = m) (v: Vector n A),
    proj1_sig v = proj1_sig (coerce_Vector_length Heq v).forall (A : Type) (n m : nat) (Heq : n = m)
  (v : Vector n A),
proj1_sig v = proj1_sig (coerce Heq in v)
Proof.forall (A : Type) (n m : nat) (Heq : n = m)
  (v : Vector n A),
proj1_sig v = proj1_sig (coerce Heq in v)
  intros ? n m Heq [v pf].A: Type
n, m: nat
Heq: n = m
v: list A
pf: length v = n
proj1_sig
  (exist (fun l : list A => length l = n) v pf) =
proj1_sig
  (coerce Heq
   in exist (fun l : list A => length l = n) v pf)
  reflexivity.
Qed.

Lemma coerce_Vector_eq_refl:
  forall {A: Type} {n} (v: Vector n A),
    coerce eq_refl in v = v.forall (A : Type) (n : nat) (v : Vector n A),
coerce eq_refl in v = v
Proof.forall (A : Type) (n : nat) (v : Vector n A),
coerce eq_refl in v = v
  intros.A: Type
n: nat
v: Vector n A
coerce eq_refl in v = v
  destruct v.A: Type
n: nat
x: list A
e: length x = n
coerce eq_refl
in exist (fun l : list A => length l = n) x e =
exist (fun l : list A => length l = n) x e
  destruct e.A: Type
x: list A
coerce eq_refl
in exist (fun l : list A => length l = length x) x
     eq_refl =
exist (fun l : list A => length l = length x) x
  eq_refl
  reflexivity.
Qed.

Lemma coerce_Vector_eq_refl_pf:
  forall {A: Type} {n},
    coerce_Vector_length eq_refl = @id (Vector n A).forall (A : Type) (n : nat),
coerce_Vector_length eq_refl = id
Proof.forall (A : Type) (n : nat),
coerce_Vector_length eq_refl = id
  intros.A: Type
n: nat
coerce_Vector_length eq_refl = id ext v.A: Type
n: nat
v: Vector n A
coerce eq_refl in v = id v
  apply coerce_Vector_eq_refl.
Qed.

Lemma coerce_Vector_compose
        {n m p: nat} `{v: Vector n A}
        (Heq1: n = m)
        (Heq2: m = p):
  coerce_Vector_length Heq2 (coerce_Vector_length Heq1 v) =
    coerce_Vector_length (eq_trans Heq1 Heq2) v.n, m, p: nat
A: Type
v: Vector n A
Heq1: n = m
Heq2: m = p
coerce Heq2 in coerce Heq1 in v =
coerce eq_trans Heq1 Heq2 in v
Proof.n, m, p: nat
A: Type
v: Vector n A
Heq1: n = m
Heq2: m = p
coerce Heq2 in coerce Heq1 in v =
coerce eq_trans Heq1 Heq2 in v
  destruct Heq1.n, p: nat
A: Type
v: Vector n A
Heq2: n = p
coerce Heq2 in coerce eq_refl in v =
coerce eq_trans eq_refl Heq2 in v
  destruct Heq2.n: nat
A: Type
v: Vector n A
coerce eq_refl in coerce eq_refl in v =
coerce eq_trans eq_refl eq_refl in v
  destruct v as [vlist vlen].n: nat
A: Type
vlist: list A
vlen: length vlist = n
coerce eq_refl
in coerce eq_refl
   in exist (fun l : list A => length l = n) vlist
        vlen =
coerce eq_trans eq_refl eq_refl
in exist (fun l : list A => length l = n) vlist vlen
  destruct vlen.A: Type
vlist: list A
coerce eq_refl
in coerce eq_refl
   in exist
        (fun l : list A => length l = length vlist)
        vlist eq_refl =
coerce eq_trans eq_refl eq_refl
in exist (fun l : list A => length l = length vlist)
     vlist eq_refl
  reflexivity.
Qed.

Lemma coerce_Vector_eq_sym:
  forall {A: Type} {n m} (v: Vector n A)
    (Heq: n = m),
    v = coerce (eq_sym Heq) in coerce Heq in v.forall (A : Type) (n m : nat) (v : Vector n A)
  (Heq : n = m),
v = coerce eq_sym Heq in coerce Heq in v
Proof.forall (A : Type) (n m : nat) (v : Vector n A)
  (Heq : n = m),
v = coerce eq_sym Heq in coerce Heq in v
  intros.A: Type
n, m: nat
v: Vector n A
Heq: n = m
v = coerce eq_sym Heq in coerce Heq in v
  rewrite coerce_Vector_compose.A: Type
n, m: nat
v: Vector n A
Heq: n = m
v = coerce eq_trans Heq (eq_sym Heq) in v
  rewrite eq_trans_sym_inv_r.A: Type
n, m: nat
v: Vector n A
Heq: n = m
v = coerce eq_refl in v
  rewrite coerce_Vector_eq_refl.A: Type
n, m: nat
v: Vector n A
Heq: n = m
v = v
  reflexivity.
Qed.

(** ** Similarity *)
(******************************************************************************)
From Coq Require Import RelationClasses.

Definition Vector_sim {n m A}:
  Vector n A -> Vector m A -> Prop :=
  fun v1 v2 => proj1_sig v1 = proj1_sig v2.

#[local] Infix "~~" := (Vector_sim) (at level 30).

(* Without <<n = m>>, functions with <<n <> m>> are related which is
awkward and blocks transitivity. >> *)
Definition Vector_fun_sim {n m A B}:
  (Vector n A -> B) -> (Vector m A -> B) -> Prop :=
  fun f1 f2 => n = m /\ forall v1 v2, v1 ~~ v2 ->
                     f1 v1 = f2 v2.

#[local] Infix "~!~" := (Vector_fun_sim) (at level 30).

Definition Vector_fun_indep {n A B} (f: Vector n A -> B)
  : Prop := f ~!~ f.

Lemma Vector_fun_sim_eq
        {n m A B} {v1: Vector n A} {v2: Vector m A}
        {f: Vector n A -> B} {g: Vector m A -> B}:
  f ~!~ g ->
  v1 ~~ v2 ->
  f v1 = g v2.n, m: nat
A, B: Type
v1: Vector n A
v2: Vector m A
f: Vector n A -> B
g: Vector m A -> B
f ~!~ g -> v1 ~~ v2 -> f v1 = g v2
Proof.n, m: nat
A, B: Type
v1: Vector n A
v2: Vector m A
f: Vector n A -> B
g: Vector m A -> B
f ~!~ g -> v1 ~~ v2 -> f v1 = g v2
  introv Hfsim Hsim.n, m: nat
A, B: Type
v1: Vector n A
v2: Vector m A
f: Vector n A -> B
g: Vector m A -> B
Hfsim: f ~!~ g
Hsim: v1 ~~ v2
f v1 = g v2
  destruct Hfsim as [Heq Hfsim].n, m: nat
A, B: Type
v1: Vector n A
v2: Vector m A
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
Hsim: v1 ~~ v2
f v1 = g v2
  auto.
Qed.

Lemma Vector_fun_indep_eq
        {n A B} {v1: Vector n A} {v2: Vector n A}
        {f: Vector n A -> B} (Hind: f ~!~f):
  v1 ~~ v2 ->
  f v1 = f v2.n: nat
A, B: Type
v1, v2: Vector n A
f: Vector n A -> B
Hind: f ~!~ f
v1 ~~ v2 -> f v1 = f v2
Proof.n: nat
A, B: Type
v1, v2: Vector n A
f: Vector n A -> B
Hind: f ~!~ f
v1 ~~ v2 -> f v1 = f v2
  now apply Vector_fun_sim_eq.
Qed.

Lemma Vector_sim_length:
  forall {A: Type} {n m: nat}
    (v1: Vector n A)
    (v2: Vector m A),
    v1 ~~ v2 -> n = m.forall (A : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m A), v1 ~~ v2 -> n = m
Proof.forall (A : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m A), v1 ~~ v2 -> n = m
  intros.A: Type
n, m: nat
v1: Vector n A
v2: Vector m A
H: v1 ~~ v2
n = m
  destruct v1.A: Type
n, m: nat
x: list A
e: length x = n
v2: Vector m A
H: exist (fun l : list A => length l = n) x e ~~ v2
n = m
  destruct v2.A: Type
n, m: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = m
H: exist (fun l : list A => length l = n) x e ~~
exist (fun l : list A => length l = m) x0 e0
n = m
  unfold Vector_sim in H.A: Type
n, m: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = m
H: proj1_sig
  (exist (fun l : list A => length l = n) x e) =
proj1_sig
  (exist (fun l : list A => length l = m) x0 e0)
n = m
  cbn in H.A: Type
n, m: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = m
H: x = x0
n = m
  subst.A: Type
x0: list A
length x0 = length x0
  reflexivity.
Qed.

Lemma Vector_fun_sim_length:
  forall {A B: Type} {n m: nat}
    {f: Vector n A -> B}
    {g: Vector m A -> B},
    f ~!~ g -> n = m.forall (A B : Type) (n m : nat) (f : Vector n A -> B)
  (g : Vector m A -> B), f ~!~ g -> n = m
Proof.forall (A B : Type) (n m : nat) (f : Vector n A -> B)
  (g : Vector m A -> B), f ~!~ g -> n = m
  intros.A, B: Type
n, m: nat
f: Vector n A -> B
g: Vector m A -> B
H: f ~!~ g
n = m
  unfold Vector_fun_sim in H.A, B: Type
n, m: nat
f: Vector n A -> B
g: Vector m A -> B
H: n = m /\
(forall (v1 : Vector n A) (v2 : Vector m A),
 v1 ~~ v2 -> f v1 = g v2)
n = m
  tauto.
Qed.

(** ** Notions of equality assuming proof-irrelevance axiom *)
(******************************************************************************)
Lemma Vector_eq_list_eq:
  forall (A: Type) (n: nat) (l1 l2 : list A)
    (p1 : length l1 = n)
    (p2 : length l2 = n),
    (l1 = l2) =
      (exist (fun l => length l = n) l1 p1 =
         exist (fun l => length l = n) l2 p2).forall (A : Type) (n : nat) (l1 l2 : list A)
  (p1 : length l1 = n) (p2 : length l2 = n),
(l1 = l2) =
(exist (fun l : list A => length l = n) l1 p1 =
 exist (fun l : list A => length l = n) l2 p2)
Proof.forall (A : Type) (n : nat) (l1 l2 : list A)
  (p1 : length l1 = n) (p2 : length l2 = n),
(l1 = l2) =
(exist (fun l : list A => length l = n) l1 p1 =
 exist (fun l : list A => length l = n) l2 p2)
  intros.A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
(l1 = l2) =
(exist (fun l : list A => length l = n) l1 p1 =
 exist (fun l : list A => length l = n) l2 p2)
  propext.A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
l1 = l2 ->
exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2
A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2 ->
l1 = l2
  +A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
l1 = l2 ->
exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2 intros.A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
H: l1 = l2
exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2 subst.A: Type
l2: list A
p2: length l2 = length l2
exist (fun l : list A => length l = length l2) l2
  eq_refl =
exist (fun l : list A => length l = length l2) l2 p2
    fequal.A: Type
l2: list A
p2: length l2 = length l2
eq_refl = p2
    apply proof_irrelevance.
  +A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2 ->
l1 = l2 intros.A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
H: exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2
l1 = l2
    inversion H.A: Type
n: nat
l1, l2: list A
p1: length l1 = n
p2: length l2 = n
H: exist (fun l : list A => length l = n) l1 p1 =
exist (fun l : list A => length l = n) l2 p2
H1: l1 = l2
l2 = l2
    reflexivity.
Qed.

(** Proof irrelevance implies similarity entails equality *)
Lemma Vector_eq:
  forall (A: Type) (n: nat)
    (v1 v2: Vector n A),
    proj1_sig v1 = proj1_sig v2 ->
    v1 = v2.forall (A : Type) (n : nat) (v1 v2 : Vector n A),
proj1_sig v1 = proj1_sig v2 -> v1 = v2
Proof.forall (A : Type) (n : nat) (v1 v2 : Vector n A),
proj1_sig v1 = proj1_sig v2 -> v1 = v2
  intros.A: Type
n: nat
v1, v2: Vector n A
H: proj1_sig v1 = proj1_sig v2
v1 = v2
  destruct v1.A: Type
n: nat
x: list A
e: length x = n
v2: Vector n A
H: proj1_sig
  (exist (fun l : list A => length l = n) x e) =
proj1_sig v2
exist (fun l : list A => length l = n) x e = v2
  destruct v2.A: Type
n: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = n
H: proj1_sig
  (exist (fun l : list A => length l = n) x e) =
proj1_sig
  (exist (fun l : list A => length l = n) x0 e0)
exist (fun l : list A => length l = n) x e =
exist (fun l : list A => length l = n) x0 e0
  cbn in H.A: Type
n: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = n
H: x = x0
exist (fun l : list A => length l = n) x e =
exist (fun l : list A => length l = n) x0 e0
  erewrite Vector_eq_list_eq in H.A: Type
n: nat
x: list A
e: length x = n
x0: list A
e0: length x0 = n
H: exist (fun l : list A => length l = ?n) x ?p1 =
exist (fun l : list A => length l = ?n) x0 ?p2
exist (fun l : list A => length l = n) x e =
exist (fun l : list A => length l = n) x0 e0
  eassumption.
Defined.

Lemma Vector_sim_eq {n A} (v1 v2: Vector n A):
  v1 ~~ v2 -> v1 = v2.n: nat
A: Type
v1, v2: Vector n A
v1 ~~ v2 -> v1 = v2
Proof.n: nat
A: Type
v1, v2: Vector n A
v1 ~~ v2 -> v1 = v2
  apply Vector_eq.
Qed.

(** *** Relation properties *)
(******************************************************************************)

(** **** Reflexivity *)
(******************************************************************************)
#[export] Instance Reflexive_Vector_sim {n A}:
  Reflexive (@Vector_sim n n A).n: nat
A: Type
Reflexive Vector_sim
Proof.n: nat
A: Type
Reflexive Vector_sim
  unfold Reflexive.n: nat
A: Type
forall x : Vector n A, x ~~ x reflexivity.
Qed.

(* You need proof irrelevance to prove reflexivity *)
#[export] Instance Reflexive_Vector_fun_sim {n A B}:
  Reflexive (@Vector_fun_sim n n A B).n: nat
A, B: Type
Reflexive Vector_fun_sim
Proof.n: nat
A, B: Type
Reflexive Vector_fun_sim
  unfold Reflexive.n: nat
A, B: Type
forall x : Vector n A -> B, x ~!~ x intro f.n: nat
A, B: Type
f: Vector n A -> B
f ~!~ f
  unfold Vector_fun_sim.n: nat
A, B: Type
f: Vector n A -> B
n = n /\
(forall v1 v2 : Vector n A, v1 ~~ v2 -> f v1 = f v2)
  split; auto.n: nat
A, B: Type
f: Vector n A -> B
forall v1 v2 : Vector n A, v1 ~~ v2 -> f v1 = f v2
  intros.n: nat
A, B: Type
f: Vector n A -> B
v1, v2: Vector n A
H: v1 ~~ v2
f v1 = f v2
  apply Vector_sim_eq in H.n: nat
A, B: Type
f: Vector n A -> B
v1, v2: Vector n A
H: v1 = v2
f v1 = f v2
  now subst.
Qed.

(** **** Symmetry *)
(******************************************************************************)
(* We cannot instantiate <<Symmetric>> because ~~ is parameterized by
n and m. *)
Lemma symmetric_Vector_sim
        `{v1: Vector n A}
        `{v2: Vector m A}:
  v1 ~~ v2 <->
    v2 ~~ v1.n: nat
A: Type
v1: Vector n A
m: nat
v2: Vector m A
v1 ~~ v2 <-> v2 ~~ v1
Proof.n: nat
A: Type
v1: Vector n A
m: nat
v2: Vector m A
v1 ~~ v2 <-> v2 ~~ v1
  split; symmetry; assumption.
Qed.

Ltac vec_symmetry :=
  rewrite symmetric_Vector_sim.

Lemma symmetric_Vector_fun_sim
        `{f1: Vector n A -> B}
        `{f2: Vector m A -> B}:
  f1 ~!~ f2 <->
    f2 ~!~ f1.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
f1 ~!~ f2 <-> f2 ~!~ f1
Proof.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
f1 ~!~ f2 <-> f2 ~!~ f1
  unfold Vector_fun_sim.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
n = m /\
(forall (v1 : Vector n A) (v2 : Vector m A),
 v1 ~~ v2 -> f1 v1 = f2 v2) <->
m = n /\
(forall (v1 : Vector m A) (v2 : Vector n A),
 v1 ~~ v2 -> f2 v1 = f1 v2)
  (*
  split; intros.
  - symmetry. apply H. now vec_symmetry.
  - symmetry. apply H. now vec_symmetry.
  *)
  split; intros [H1 H2]; split; try congruence; subst.A, B: Type
m: nat
f1, f2: Vector m A -> B
H2: forall v1 v2 : Vector m A,
v1 ~~ v2 -> f1 v1 = f2 v2
forall v1 v2 : Vector m A, v1 ~~ v2 -> f2 v1 = f1 v2
n: nat
A, B: Type
f1, f2: Vector n A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f2 v1 = f1 v2
forall v1 v2 : Vector n A, v1 ~~ v2 -> f1 v1 = f2 v2
  -A, B: Type
m: nat
f1, f2: Vector m A -> B
H2: forall v1 v2 : Vector m A,
v1 ~~ v2 -> f1 v1 = f2 v2
forall v1 v2 : Vector m A, v1 ~~ v2 -> f2 v1 = f1 v2 symmetry.A, B: Type
m: nat
f1, f2: Vector m A -> B
H2: forall v1 v2 : Vector m A,
v1 ~~ v2 -> f1 v1 = f2 v2
v1, v2: Vector m A
H: v1 ~~ v2
f1 v2 = f2 v1 apply H2; auto.A, B: Type
m: nat
f1, f2: Vector m A -> B
H2: forall v1 v2 : Vector m A,
v1 ~~ v2 -> f1 v1 = f2 v2
v1, v2: Vector m A
H: v1 ~~ v2
v2 ~~ v1 now vec_symmetry.
  -n: nat
A, B: Type
f1, f2: Vector n A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f2 v1 = f1 v2
forall v1 v2 : Vector n A, v1 ~~ v2 -> f1 v1 = f2 v2 symmetry.n: nat
A, B: Type
f1, f2: Vector n A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f2 v1 = f1 v2
v1, v2: Vector n A
H: v1 ~~ v2
f2 v2 = f1 v1 apply H2; auto.n: nat
A, B: Type
f1, f2: Vector n A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f2 v1 = f1 v2
v1, v2: Vector n A
H: v1 ~~ v2
v2 ~~ v1 now vec_symmetry.
Qed.

Ltac vec_fun_symmetry :=
  rewrite symmetric_Vector_fun_sim.

(** *** Transitivity *)
(******************************************************************************)
(* We cannot instantiate <<Transitive>> because ~~ is parameterized by
n and m. *)
Lemma transitive_Vector_sim
        `{v1: Vector n A}
        `{v2: Vector m A}
        `{v3: Vector p A}:
  v1 ~~ v2 -> v2 ~~ v3 -> v1 ~~ v3.n: nat
A: Type
v1: Vector n A
m: nat
v2: Vector m A
p: nat
v3: Vector p A
v1 ~~ v2 -> v2 ~~ v3 -> v1 ~~ v3
Proof.n: nat
A: Type
v1: Vector n A
m: nat
v2: Vector m A
p: nat
v3: Vector p A
v1 ~~ v2 -> v2 ~~ v3 -> v1 ~~ v3
  congruence.
Qed.

Lemma transitive_Vector_fun_sim
        `{f1: Vector n A -> B}
        `{f2: Vector m A -> B}
        `{f3: Vector p A -> B}:
  f1 ~!~ f2 ->
  f2 ~!~ f3 ->
  f1 ~!~ f3.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
p: nat
f3: Vector p A -> B
f1 ~!~ f2 -> f2 ~!~ f3 -> f1 ~!~ f3
Proof.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
p: nat
f3: Vector p A -> B
f1 ~!~ f2 -> f2 ~!~ f3 -> f1 ~!~ f3
  intros.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
p: nat
f3: Vector p A -> B
H: f1 ~!~ f2
H0: f2 ~!~ f3
f1 ~!~ f3
  unfold Vector_fun_sim in *.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
p: nat
f3: Vector p A -> B
H: n = m /\
(forall (v1 : Vector n A) (v2 : Vector m A),
 v1 ~~ v2 -> f1 v1 = f2 v2)
H0: m = p /\
(forall (v1 : Vector m A) (v2 : Vector p A),
 v1 ~~ v2 -> f2 v1 = f3 v2)
n = p /\
(forall (v1 : Vector n A) (v2 : Vector p A),
 v1 ~~ v2 -> f1 v1 = f3 v2)
  intuition.n: nat
A, B: Type
f1: Vector n A -> B
m: nat
f2: Vector m A -> B
p: nat
f3: Vector p A -> B
H1: n = m
H2: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f1 v1 = f2 v2
H: m = p
H3: forall (v1 : Vector m A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f1 v1 = f3 v2
  destruct H1.n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f1 v1 = f3 v2
  transitivity (f2 v1).n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f1 v1 = f2 v1
n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f2 v1 = f3 v2
  -n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f1 v1 = f2 v1 apply H2.n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
v1 ~~ v1 reflexivity.
  -n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
f2 v1 = f3 v2 apply H3.n: nat
A, B: Type
f1, f2: Vector n A -> B
p: nat
f3: Vector p A -> B
H2: forall v1 v2 : Vector n A,
v1 ~~ v2 -> f1 v1 = f2 v2
H: n = p
H3: forall (v1 : Vector n A) (v2 : Vector p A),
v1 ~~ v2 -> f2 v1 = f3 v2
v1: Vector n A
v2: Vector p A
H0: v1 ~~ v2
v1 ~~ v2 assumption.
Qed.

(** *** Length coercions *)
(******************************************************************************)
Lemma Vector_coerce_sim_l {n m} `{v: Vector n A} (Heq: n = m):
    coerce Heq in v ~~ v.n, m: nat
A: Type
v: Vector n A
Heq: n = m
coerce Heq in v ~~ v
Proof.n, m: nat
A: Type
v: Vector n A
Heq: n = m
coerce Heq in v ~~ v
  unfold Vector_sim.n, m: nat
A: Type
v: Vector n A
Heq: n = m
proj1_sig (coerce Heq in v) = proj1_sig v
  rewrite (coerce_Vector_contents Heq).n, m: nat
A: Type
v: Vector n A
Heq: n = m
proj1_sig (coerce Heq in v) =
proj1_sig (coerce Heq in v)
  reflexivity.
Qed.

Lemma Vector_coerce_sim_r {n m} `{v: Vector n A} (Heq: n = m):
  v ~~ coerce Heq in v.n, m: nat
A: Type
v: Vector n A
Heq: n = m
v ~~ coerce Heq in v
Proof.n, m: nat
A: Type
v: Vector n A
Heq: n = m
v ~~ coerce Heq in v
  vec_symmetry.n, m: nat
A: Type
v: Vector n A
Heq: n = m
coerce Heq in v ~~ v
  apply Vector_coerce_sim_l.
Qed.

(* Tactics *)
Lemma Vector_coerce_sim_l'
        {n m p} `{w: Vector p A} `{v: Vector n A} (Heq: n = m):
  v ~~ w ->
  coerce Heq in v ~~ w.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
v ~~ w -> coerce Heq in v ~~ w
Proof.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
v ~~ w -> coerce Heq in v ~~ w
  apply transitive_Vector_sim.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
coerce Heq in v ~~ v
  apply Vector_coerce_sim_l.
Qed.

Lemma Vector_coerce_sim_r'
        {n m p} `{w: Vector p A} `{v: Vector n A} (Heq: n = m):
  w ~~ v ->
  w ~~ coerce Heq in v.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
w ~~ v -> w ~~ coerce Heq in v
Proof.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
w ~~ v -> w ~~ coerce Heq in v
  intro.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
H: w ~~ v
w ~~ coerce Heq in v
  vec_symmetry.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
H: w ~~ v
coerce Heq in v ~~ w
  eapply transitive_Vector_sim.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
H: w ~~ v
coerce Heq in v ~~ ?v2
n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
H: w ~~ v
?v2 ~~ w
  apply Vector_coerce_sim_l.n, m, p: nat
A: Type
w: Vector p A
v: Vector n A
Heq: n = m
H: w ~~ v
v ~~ w
  now vec_symmetry.
Qed.

Lemma Vector_coerce_fun_sim_l
        {n m A B} {f: Vector n A -> B}:
  forall (Heq: m = n),
    (f ○ coerce_Vector_length Heq) ~!~ f.n, m: nat
A, B: Type
f: Vector n A -> B
forall Heq : m = n, precoerce Heq in f ~!~ f
Proof.n, m: nat
A, B: Type
f: Vector n A -> B
forall Heq : m = n, precoerce Heq in f ~!~ f
  intros Heq.n, m: nat
A, B: Type
f: Vector n A -> B
Heq: m = n
precoerce Heq in f ~!~ f destruct Heq.m: nat
A, B: Type
f: Vector m A -> B
precoerce eq_refl in f ~!~ f
  rewrite coerce_Vector_eq_refl_pf.m: nat
A, B: Type
f: Vector m A -> B
(f ○ id) ~!~ f
  reflexivity.
Qed.

Lemma Vector_coerce_fun_sim_r
        {n m A B} {f: Vector n A -> B}:
  forall (Heq: m = n),
    f ~!~ (f ○ coerce_Vector_length Heq).n, m: nat
A, B: Type
f: Vector n A -> B
forall Heq : m = n, f ~!~ precoerce Heq in f
Proof.n, m: nat
A, B: Type
f: Vector n A -> B
forall Heq : m = n, f ~!~ precoerce Heq in f
  intros.n, m: nat
A, B: Type
f: Vector n A -> B
Heq: m = n
f ~!~ precoerce Heq in f
  vec_fun_symmetry.n, m: nat
A, B: Type
f: Vector n A -> B
Heq: m = n
precoerce Heq in f ~!~ f
  apply Vector_coerce_fun_sim_l.
Qed.

Lemma Vector_coerce_fun_sim_l'
        {n m p A B}
        {f: Vector n A -> B} {g: Vector m A -> B}:
  forall (Heq: p = n),
    f ~!~ g ->
    (f ○ coerce_Vector_length Heq) ~!~ g.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : p = n,
f ~!~ g -> precoerce Heq in f ~!~ g
Proof.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : p = n,
f ~!~ g -> precoerce Heq in f ~!~ g
  unfold Vector_fun_sim.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : p = n,
n = m /\
(forall (v1 : Vector n A) (v2 : Vector m A),
 v1 ~~ v2 -> f v1 = g v2) ->
p = m /\
(forall (v1 : Vector p A) (v2 : Vector m A),
 v1 ~~ v2 -> f (coerce Heq in v1) = g v2)
  intros Heq1 [Heq2 Hfsim].n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
p = m /\
(forall (v1 : Vector p A) (v2 : Vector m A),
 v1 ~~ v2 -> f (coerce Heq1 in v1) = g v2)
  split.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
p = m
n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
forall (v1 : Vector p A) (v2 : Vector m A),
v1 ~~ v2 -> f (coerce Heq1 in v1) = g v2
  -n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
p = m congruence.
  -n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
forall (v1 : Vector p A) (v2 : Vector m A),
v1 ~~ v2 -> f (coerce Heq1 in v1) = g v2 intros v1 v2 Hsim.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
v1: Vector p A
v2: Vector m A
Hsim: v1 ~~ v2
f (coerce Heq1 in v1) = g v2
    apply Hfsim.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq1: p = n
Heq2: n = m
Hfsim: forall (v1 : Vector n A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
v1: Vector p A
v2: Vector m A
Hsim: v1 ~~ v2
coerce Heq1 in v1 ~~ v2
    destruct Heq1.m, p: nat
A, B: Type
f: Vector p A -> B
g: Vector m A -> B
Heq2: p = m
Hfsim: forall (v1 : Vector p A) (v2 : Vector m A),
v1 ~~ v2 -> f v1 = g v2
v1: Vector p A
v2: Vector m A
Hsim: v1 ~~ v2
coerce eq_refl in v1 ~~ v2
    now rewrite coerce_Vector_eq_refl.
Qed.

Lemma Vector_coerce_fun_sim_r'
        {n m p A B}
        {f: Vector n A -> B} {g: Vector m A -> B}:
  forall (Heq: p = n),
    g ~!~ f ->
    g ~!~ (f ○ coerce_Vector_length Heq).n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : p = n,
g ~!~ f -> g ~!~ precoerce Heq in f
Proof.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : p = n,
g ~!~ f -> g ~!~ precoerce Heq in f
  intros.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: p = n
H: g ~!~ f
g ~!~ precoerce Heq in f
  vec_fun_symmetry.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: p = n
H: g ~!~ f
precoerce Heq in f ~!~ g
  apply Vector_coerce_fun_sim_l'.n, m, p: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: p = n
H: g ~!~ f
f ~!~ g
  now vec_fun_symmetry.
Qed.

Lemma Vector_coerce_fun_coerce
        {n m A B} {f: Vector n A -> B} {g: Vector m A -> B}:
  forall (Heq: n = m),
    f ~!~ g ->
    f = (g ○ coerce_Vector_length Heq).n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : n = m, f ~!~ g -> f = precoerce Heq in g
Proof.n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
forall Heq : n = m, f ~!~ g -> f = precoerce Heq in g
  intros.n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
H: f ~!~ g
f = precoerce Heq in g
  ext v.n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
H: f ~!~ g
v: Vector n A
f v = g (coerce Heq in v)
  apply Vector_coerce_fun_sim_r'.n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
H: f ~!~ g
v: Vector n A
f ~!~ g
n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
H: f ~!~ g
v: Vector n A
v ~~ v
  assumption.n, m: nat
A, B: Type
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
H: f ~!~ g
v: Vector n A
v ~~ v
  reflexivity.
Qed.

(** ** Derived constructors *)
(******************************************************************************)
Definition vnil {A}: Vector 0 A :=
  exist (fun l => length l = 0) nil eq_refl.

Definition vcons (n:nat) {A}:
  A ->
  Vector n A ->
  Vector (S n) A.n: nat
A: Type
A -> Vector n A -> Vector (S n) A
Proof.n: nat
A: Type
A -> Vector n A -> Vector (S n) A
  introv a v.n: nat
A: Type
a: A
v: Vector n A
Vector (S n) A
  destruct v as [vlist vlen].n: nat
A: Type
a: A
vlist: list A
vlen: length vlist = n
Vector (S n) A
  apply (exist (fun l => length l = S n) (cons a vlist)).n: nat
A: Type
a: A
vlist: list A
vlen: length vlist = n
length (a :: vlist) = S n
  cbn.n: nat
A: Type
a: A
vlist: list A
vlen: length vlist = n
S (length vlist) = S n fequal.n: nat
A: Type
a: A
vlist: list A
vlen: length vlist = n
length vlist = n assumption.
Defined.

(** *** Inversion of smart constructor equality *)
(******************************************************************************)
Lemma vcons_eq_inv_both: forall (n: nat) (A: Type) (a1 a2: A) (v1 v2: Vector n A),
    vcons n a1 v1 = vcons n a2 v2 ->
    a1 = a2 /\ v1 = v2.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2 /\ v1 = v2
Proof.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2 /\ v1 = v2
  intros.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
a1 = a2 /\ v1 = v2
  destruct v1 as [l1 len1].n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
v2: Vector n A
H: vcons n a1
  (exist (fun l : list A => length l = n) l1 len1) =
vcons n a2 v2
a1 = a2 /\
exist (fun l : list A => length l = n) l1 len1 = v2
  destruct v2 as [l2 len2].n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: vcons n a1
  (exist (fun l : list A => length l = n) l1 len1) =
vcons n a2
  (exist (fun l : list A => length l = n) l2 len2)
a1 = a2 /\
exist (fun l : list A => length l = n) l1 len1 =
exist (fun l : list A => length l = n) l2 len2
  cbn in H.n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: exist (fun l : list A => length l = S n)
  (a1 :: l1) (args_eq_1 S len1) =
exist (fun l : list A => length l = S n)
  (a2 :: l2) (args_eq_1 S len2)
a1 = a2 /\
exist (fun l : list A => length l = n) l1 len1 =
exist (fun l : list A => length l = n) l2 len2
  inversion H.n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: exist (fun l : list A => length l = S n)
  (a1 :: l1) (args_eq_1 S len1) =
exist (fun l : list A => length l = S n)
  (a2 :: l2) (args_eq_1 S len2)
H1: a1 = a2
H2: l1 = l2
a2 = a2 /\
exist (fun l : list A => length l = n) l1 len1 =
exist (fun l : list A => length l = n) l2 len2
  split; auto.n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: exist (fun l : list A => length l = S n)
  (a1 :: l1) (args_eq_1 S len1) =
exist (fun l : list A => length l = S n)
  (a2 :: l2) (args_eq_1 S len2)
H1: a1 = a2
H2: l1 = l2
exist (fun l : list A => length l = n) l1 len1 =
exist (fun l : list A => length l = n) l2 len2
  apply Vector_sim_eq.n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: exist (fun l : list A => length l = S n)
  (a1 :: l1) (args_eq_1 S len1) =
exist (fun l : list A => length l = S n)
  (a2 :: l2) (args_eq_1 S len2)
H1: a1 = a2
H2: l1 = l2
exist (fun l : list A => length l = n) l1 len1 ~~
exist (fun l : list A => length l = n) l2 len2
  unfold Vector_sim.n: nat
A: Type
a1, a2: A
l1: list A
len1: length l1 = n
l2: list A
len2: length l2 = n
H: exist (fun l : list A => length l = S n)
  (a1 :: l1) (args_eq_1 S len1) =
exist (fun l : list A => length l = S n)
  (a2 :: l2) (args_eq_1 S len2)
H1: a1 = a2
H2: l1 = l2
proj1_sig
  (exist (fun l : list A => length l = n) l1 len1) =
proj1_sig
  (exist (fun l : list A => length l = n) l2 len2)
  assumption.
Qed.

Lemma vcons_eq_inv_hd: forall (n: nat) (A: Type) (a1 a2: A) (v1 v2: Vector n A),
    vcons n a1 v1 = vcons n a2 v2 ->
    a1 = a2.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2
Proof.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2
  intros.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
a1 = a2
  apply vcons_eq_inv_both in H; tauto.
Qed.

Lemma vcons_eq_inv_tl: forall (n: nat) (A: Type) (a1 a2: A) (v1 v2: Vector n A),
    vcons n a1 v1 = vcons n a2 v2 ->
    v1 = v2.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> v1 = v2
Proof.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> v1 = v2
  intros.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
v1 = v2
  apply vcons_eq_inv_both in H; tauto.
Qed.

(** *** Projecting the smart constructors *)
(******************************************************************************)
Lemma proj_vnil: forall `(v: Vector 0 A),
    proj1_sig v = nil.forall (A : Type) (v : Vector 0 A), proj1_sig v = nil
Proof.forall (A : Type) (v : Vector 0 A), proj1_sig v = nil
  intros.A: Type
v: Vector 0 A
proj1_sig v = nil
  destruct v as [v vlen].A: Type
v: list A
vlen: length v = 0
proj1_sig
  (exist (fun l : list A => length l = 0) v vlen) =
nil
  cbn.A: Type
v: list A
vlen: length v = 0
v = nil
  now apply List.length_zero_iff_nil.
Qed.

Lemma proj_vcons: forall (n: nat) `(a: A) (v: Vector n A),
    proj1_sig (vcons n a v) = cons a (proj1_sig v).forall (n : nat) (A : Type) (a : A) (v : Vector n A),
proj1_sig (vcons n a v) = a :: proj1_sig v
Proof.forall (n : nat) (A : Type) (a : A) (v : Vector n A),
proj1_sig (vcons n a v) = a :: proj1_sig v
  intros.n: nat
A: Type
a: A
v: Vector n A
proj1_sig (vcons n a v) = a :: proj1_sig v
  destruct v as [vlist vlen].n: nat
A: Type
a: A
vlist: list A
vlen: length vlist = n
proj1_sig
  (vcons n a
     (exist (fun l : list A => length l = n) vlist
        vlen)) =
a
:: proj1_sig
     (exist (fun l : list A => length l = n) vlist
        vlen)
  destruct vlen.A: Type
a: A
vlist: list A
proj1_sig
  (vcons (length vlist) a
     (exist
        (fun l : list A => length l = length vlist)
        vlist eq_refl)) =
a
:: proj1_sig
     (exist
        (fun l : list A => length l = length vlist)
        vlist eq_refl)
  reflexivity.
Qed.

Lemma vcons_sim
        {n m:nat} `{a:A}
        `{v1: Vector n A}
        `{v2: Vector m A}:
        v1 ~~ v2 ->
      vcons n a v1 ~~ vcons m a v2.n, m: nat
A: Type
a: A
v1: Vector n A
v2: Vector m A
v1 ~~ v2 -> vcons n a v1 ~~ vcons m a v2
Proof.n, m: nat
A: Type
a: A
v1: Vector n A
v2: Vector m A
v1 ~~ v2 -> vcons n a v1 ~~ vcons m a v2
  intros.n, m: nat
A: Type
a: A
v1: Vector n A
v2: Vector m A
H: v1 ~~ v2
vcons n a v1 ~~ vcons m a v2
  unfold Vector_sim in *.n, m: nat
A: Type
a: A
v1: Vector n A
v2: Vector m A
H: proj1_sig v1 = proj1_sig v2
proj1_sig (vcons n a v1) = proj1_sig (vcons m a v2)
  do 2 rewrite proj_vcons.n, m: nat
A: Type
a: A
v1: Vector n A
v2: Vector m A
H: proj1_sig v1 = proj1_sig v2
a :: proj1_sig v1 = a :: proj1_sig v2
  now rewrite H.
Qed.

(*
Instance vcons_resp:
  forall a n m, n = m ->
           vcons n a ~!~ vcons m a.
*)

(* This is better for rewriting *)
Lemma vcons_sim'
        {n:nat} `{a:A}
        `{v1: Vector n A}
        `{v2: Vector n A}:
        v1 ~~ v2 ->
      vcons n a v1 = vcons n a v2.n: nat
A: Type
a: A
v1, v2: Vector n A
v1 ~~ v2 -> vcons n a v1 = vcons n a v2
Proof.n: nat
A: Type
a: A
v1, v2: Vector n A
v1 ~~ v2 -> vcons n a v1 = vcons n a v2
  intros.n: nat
A: Type
a: A
v1, v2: Vector n A
H: v1 ~~ v2
vcons n a v1 = vcons n a v2
  fequal.n: nat
A: Type
a: A
v1, v2: Vector n A
H: v1 ~~ v2
v1 = v2
  now apply Vector_eq.
Qed.

Definition vcons_resp:
  forall `(a:A) n,
    Vector_fun_indep (vcons n a).forall (A : Type) (a : A) (n : nat),
Vector_fun_indep (vcons n a)
Proof.forall (A : Type) (a : A) (n : nat),
Vector_fun_indep (vcons n a)
  intros.A: Type
a: A
n: nat
Vector_fun_indep (vcons n a)
  unfold Vector_fun_indep; split.A: Type
a: A
n: nat
n = n
A: Type
a: A
n: nat
forall v1 v2 : Vector n A,
v1 ~~ v2 -> vcons n a v1 = vcons n a v2
  -A: Type
a: A
n: nat
n = n reflexivity.
  -A: Type
a: A
n: nat
forall v1 v2 : Vector n A,
v1 ~~ v2 -> vcons n a v1 = vcons n a v2 intros.A: Type
a: A
n: nat
v1, v2: Vector n A
H: v1 ~~ v2
vcons n a v1 = vcons n a v2 auto using vcons_sim'.
Qed.

(** ** Reversing vectors *)
(******************************************************************************)
Definition Vector_rev {n: nat} {A: Type}:
  Vector n A -> Vector n A :=
  fun v => match v with
        | exist _ vlist vlen =>
            exist _ (List.rev vlist) (eq_trans (List.rev_length vlist) vlen)
        end.

Lemma Vector_rev_inv
        {n: nat} {A: Type}
        (v: Vector n A):
  Vector_rev (Vector_rev v) ~~ v.n: nat
A: Type
v: Vector n A
Vector_rev (Vector_rev v) ~~ v
Proof.n: nat
A: Type
v: Vector n A
Vector_rev (Vector_rev v) ~~ v
  destruct v as [vlist vlen].n: nat
A: Type
vlist: list A
vlen: length vlist = n
Vector_rev
  (Vector_rev
     (exist (fun l : list A => length l = n) vlist
        vlen)) ~~
exist (fun l : list A => length l = n) vlist vlen
  unfold Vector_sim.n: nat
A: Type
vlist: list A
vlen: length vlist = n
proj1_sig
  (Vector_rev
     (Vector_rev
        (exist (fun l : list A => length l = n) vlist
           vlen))) =
proj1_sig
  (exist (fun l : list A => length l = n) vlist vlen)
  apply (List.rev_involutive vlist).
Qed.

Lemma Vector_rev_vnil: forall {A: Type},
    Vector_rev (@vnil A) = vnil.forall A : Type, Vector_rev vnil = vnil
Proof.forall A : Type, Vector_rev vnil = vnil
  unfold vnil.forall A : Type,
Vector_rev
  (exist (fun l : list A => length l = 0) nil eq_refl) =
exist (fun l : list A => length l = 0) nil eq_refl
  cbn.forall A : Type,
exist (fun l : list A => length l = 0) nil
  (List.rev_length nil) =
exist (fun l : list A => length l = 0) nil eq_refl
  intros.A: Type
exist (fun l : list A => length l = 0) nil
  (List.rev_length nil) =
exist (fun l : list A => length l = 0) nil eq_refl fequal.A: Type
List.rev_length nil = eq_refl
  apply proof_irrelevance.
Qed.

Lemma Vector_rev_vcons: forall {A: Type} {a: A} `{rest: Vector n A},
    Vector_rev (vcons n a rest) =
      Vector_rev (vcons n a rest).forall (A : Type) (a : A) (n : nat)
  (rest : Vector n A),
Vector_rev (vcons n a rest) =
Vector_rev (vcons n a rest)
Proof.forall (A : Type) (a : A) (n : nat)
  (rest : Vector n A),
Vector_rev (vcons n a rest) =
Vector_rev (vcons n a rest)
  intros.A: Type
a: A
n: nat
rest: Vector n A
Vector_rev (vcons n a rest) =
Vector_rev (vcons n a rest)
  unfold Vector_rev.A: Type
a: A
n: nat
rest: Vector n A
(let (vlist, vlen) := vcons n a rest in
 exist (fun l : list A => length l = S n)
   (List.rev vlist)
   (eq_trans (List.rev_length vlist) vlen)) =
(let (vlist, vlen) := vcons n a rest in
 exist (fun l : list A => length l = S n)
   (List.rev vlist)
   (eq_trans (List.rev_length vlist) vlen))
  destruct (vcons n a rest).A: Type
a: A
n: nat
rest: Vector n A
x: list A
e: length x = S n
exist (fun l : list A => length l = S n) (List.rev x)
  (eq_trans (List.rev_length x) e) =
exist (fun l : list A => length l = S n) (List.rev x)
  (eq_trans (List.rev_length x) e)
Abort.

(** ** Inversion/un-consing non-empty vectors *)
(******************************************************************************)
Section inversion.

  Section heads_tails.

    Context {A: Type} {n: nat}.

    Implicit Type (v: Vector (S n) A).

    (* Un-nil-ing *)
    Lemma Vector_nil_eq:
      forall `(v: Vector 0 A),
        v = vnil.A: Type
n: nat
forall v : Vector 0 A, v = vnil
    Proof.A: Type
n: nat
forall v : Vector 0 A, v = vnil
      intros.A: Type
n: nat
v: Vector 0 A
v = vnil
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = 0
exist (fun l : list A => length l = 0) vlist vlen =
vnil
      assert (vlist = @nil A) by
        now rewrite (List.length_zero_iff_nil vlist) in vlen.A: Type
n: nat
vlist: list A
vlen: length vlist = 0
H: vlist = nil
exist (fun l : list A => length l = 0) vlist vlen =
vnil
      subst.A: Type
n: nat
vlen: length nil = 0
exist (fun l : list A => length l = 0) nil vlen = vnil
      apply Vector_eq.A: Type
n: nat
vlen: length nil = 0
proj1_sig
  (exist (fun l : list A => length l = 0) nil vlen) =
proj1_sig vnil
      reflexivity.
    Qed.

    Lemma Vector_uncons_exists:
      forall v, exists (a: A) (v': Vector n A),
        v = vcons n a v'.A: Type
n: nat
forall v,
exists (a : A) (v' : Vector n A), v = vcons n a v'
    Proof.A: Type
n: nat
forall v,
exists (a : A) (v' : Vector n A), v = vcons n a v'
      intros.A: Type
n: nat
v: Vector (S n) A
exists (a : A) (v' : Vector n A), v = vcons n a v'
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
exists (a : A) (v' : Vector n A),
  exist (fun l : list A => length l = S n) vlist vlen =
  vcons n a v'
      specialize (list_uncons_exists _ _ _ vlen).A: Type
n: nat
vlist: list A
vlen: length vlist = S n
(exists (a : A) (v' : list A), vlist = a :: v') ->
exists (a : A) (v' : Vector n A),
  exist (fun l : list A => length l = S n) vlist vlen =
  vcons n a v'
      intros [vhd [vtl v_eq]].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vhd: A
vtl: list A
v_eq: vlist = vhd :: vtl
exists (a : A) (v' : Vector n A),
  exist (fun l : list A => length l = S n) vlist vlen =
  vcons n a v'
      subst.A: Type
n: nat
vhd: A
vtl: list A
vlen: length (vhd :: vtl) = S n
exists (a : A) (v' : Vector n A),
  exist (fun l : list A => length l = S n)
    (vhd :: vtl) vlen = vcons n a v'
      exists vhd.A: Type
n: nat
vhd: A
vtl: list A
vlen: length (vhd :: vtl) = S n
exists v' : Vector n A,
  exist (fun l : list A => length l = S n)
    (vhd :: vtl) vlen = vcons n vhd v'
      exists (exist (fun l => length l = n) vtl (S_uncons vlen)).A: Type
n: nat
vhd: A
vtl: list A
vlen: length (vhd :: vtl) = S n
exist (fun l : list A => length l = S n) (vhd :: vtl)
  vlen =
vcons n vhd
  (exist (fun l : list A => length l = n) vtl
     (S_uncons vlen))
      cbn.A: Type
n: nat
vhd: A
vtl: list A
vlen: length (vhd :: vtl) = S n
exist (fun l : list A => length l = S n) (vhd :: vtl)
  vlen =
exist (fun l : list A => length l = S n) (vhd :: vtl)
  (args_eq_1 S (S_uncons vlen))
      fequal.A: Type
n: nat
vhd: A
vtl: list A
vlen: length (vhd :: vtl) = S n
vlen = args_eq_1 S (S_uncons vlen)
      cbn in *.A: Type
n: nat
vhd: A
vtl: list A
vlen: S (length vtl) = S n
vlen = args_eq_1 S (S_uncons vlen)
      apply proof_irrelevance.
    Qed.

    Lemma Vector_uncons_inform:
      forall v, {p: A * Vector n A | v = vcons n (fst p) (snd p)}.A: Type
n: nat
forall v,
{p : A * Vector n A | v = vcons n (fst p) (snd p)}
    Proof.A: Type
n: nat
forall v,
{p : A * Vector n A | v = vcons n (fst p) (snd p)}
      intros.A: Type
n: nat
v: Vector (S n) A
{p : A * Vector n A | v = vcons n (fst p) (snd p)}
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
{p : A * Vector n A
| exist (fun l : list A => length l = S n) vlist vlen =
  vcons n (fst p) (snd p)}
      destruct (list_uncons_sigma2 vlist vlen) as [[vhd vtl] veq].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vhd: A
vtl: list A
veq: vlist = uncurry cons (vhd, vtl)
{p : A * Vector n A
| exist (fun l : list A => length l = S n) vlist vlen =
  vcons n (fst p) (snd p)}
      subst.A: Type
n: nat
vhd: A
vtl: list A
vlen: length (uncurry cons (vhd, vtl)) = S n
{p : A * Vector n A
| exist (fun l : list A => length l = S n)
    (uncurry cons (vhd, vtl)) vlen =
  vcons n (fst p) (snd p)}
      cbn in vlen.A: Type
n: nat
vhd: A
vtl: list A
vlen: S (length vtl) = S n
{p : A * Vector n A
| exist (fun l : list A => length l = S n)
    (uncurry cons (vhd, vtl)) vlen =
  vcons n (fst p) (snd p)}
      exists (vhd, (exist (fun l => length l = n)) vtl (S_uncons vlen)).A: Type
n: nat
vhd: A
vtl: list A
vlen: S (length vtl) = S n
exist (fun l : list A => length l = S n)
  (uncurry cons (vhd, vtl)) vlen =
vcons n
  (fst
     (vhd,
      exist (fun l : list A => length l = n) vtl
        (S_uncons vlen)))
  (snd
     (vhd,
      exist (fun l : list A => length l = n) vtl
        (S_uncons vlen)))
      cbn.A: Type
n: nat
vhd: A
vtl: list A
vlen: S (length vtl) = S n
exist (fun l : list A => length l = S n) (vhd :: vtl)
  vlen =
exist (fun l : list A => length l = S n) (vhd :: vtl)
  (args_eq_1 S (S_uncons vlen))
      fequal.A: Type
n: nat
vhd: A
vtl: list A
vlen: S (length vtl) = S n
vlen = args_eq_1 S (S_uncons vlen)
      apply proof_irrelevance.
    Defined.

    Definition Vector_uncons {n A} (v: Vector (S n) A):
      A * Vector n A :=
      let (vlist, vlen) := v in
      match vlist return (length vlist = S n -> A * Vector n A) with
      | nil => zero_not_S
      | cons a rest => fun vlen => (a, exist _ rest (S_uncons vlen))
      end vlen.

    Lemma Vector_uncons_inform1 (v: Vector (S n) A):
      Vector_uncons v = proj1_sig (Vector_uncons_inform v).A: Type
n: nat
v: Vector (S n) A
Vector_uncons v = proj1_sig (Vector_uncons_inform v)
    Proof.A: Type
n: nat
v: Vector (S n) A
Vector_uncons v = proj1_sig (Vector_uncons_inform v)
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen) =
proj1_sig
  (Vector_uncons_inform
     (exist (fun l : list A => length l = S n) vlist
        vlen))
      destruct vlist.A: Type
n: nat
vlen: length nil = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) nil vlen) =
proj1_sig
  (Vector_uncons_inform
     (exist (fun l : list A => length l = S n) nil
        vlen))
A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
Vector_uncons
  (exist (fun l : list A => length l = S n)
     (a :: vlist) vlen) =
proj1_sig
  (Vector_uncons_inform
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
      -A: Type
n: nat
vlen: length nil = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) nil vlen) =
proj1_sig
  (Vector_uncons_inform
     (exist (fun l : list A => length l = S n) nil
        vlen)) inversion vlen.
      -A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
Vector_uncons
  (exist (fun l : list A => length l = S n)
     (a :: vlist) vlen) =
proj1_sig
  (Vector_uncons_inform
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen)) cbn.A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
(a,
 exist (fun l : list A => length l = n) vlist
   (S_uncons vlen)) =
(a,
 exist (fun l : list A => length l = n) vlist
   (S_uncons vlen)) reflexivity.
    Qed.

    Definition Vector_hd:
      Vector (S n) A -> A :=
      fst ∘ Vector_uncons.

    Definition Vector_tl:
      Vector (S n) A -> Vector n A :=
      snd ∘ Vector_uncons.

    Lemma Vector_list_hd (v: Vector (S n) A):
      Vector_hd v = list_hd (proj1_sig v) (proj2_sig v).A: Type
n: nat
v: Vector (S n) A
Vector_hd v = list_hd (proj1_sig v) (proj2_sig v)
    Proof.A: Type
n: nat
v: Vector (S n) A
Vector_hd v = list_hd (proj1_sig v) (proj2_sig v)
      intros.A: Type
n: nat
v: Vector (S n) A
Vector_hd v = list_hd (proj1_sig v) (proj2_sig v)
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_hd
  (exist (fun l : list A => length l = S n) vlist vlen) =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
      destruct vlist.A: Type
n: nat
vlen: length nil = S n
Vector_hd
  (exist (fun l : list A => length l = S n) nil vlen) =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
Vector_hd
  (exist (fun l : list A => length l = S n)
     (a :: vlist) vlen) =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
      -A: Type
n: nat
vlen: length nil = S n
Vector_hd
  (exist (fun l : list A => length l = S n) nil vlen) =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) nil
        vlen)) inversion vlen.
      -A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
Vector_hd
  (exist (fun l : list A => length l = S n)
     (a :: vlist) vlen) =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen)) reflexivity.
    Qed.

    Lemma proj_Vector_tl: forall `(v: Vector (S n) A),
        proj1_sig (Vector_tl v) = list_tl (proj1_sig v) (proj2_sig v).A: Type
n: nat
forall v,
proj1_sig (Vector_tl v) =
list_tl (proj1_sig v) (proj2_sig v)
    Proof.A: Type
n: nat
forall v,
proj1_sig (Vector_tl v) =
list_tl (proj1_sig v) (proj2_sig v)
      intros.A: Type
n: nat
v: Vector (S n) A
proj1_sig (Vector_tl v) =
list_tl (proj1_sig v) (proj2_sig v)
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n) vlist
        vlen)) =
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
      destruct vlist.A: Type
n: nat
vlen: length nil = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n) nil
        vlen)) =
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen)) =
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
      -A: Type
n: nat
vlen: length nil = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n) nil
        vlen)) =
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n) nil
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) nil
        vlen)) inversion vlen.
      -A: Type
n: nat
a: A
vlist: list A
vlen: length (a :: vlist) = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen)) =
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n)
        (a :: vlist) vlen)) reflexivity.
    Qed.

    Lemma Vector_list_tl: forall `(v: Vector (S n) A),
        Vector_tl v = exist (fun l : list A => length l = n)
                            (list_tl (proj1_sig v) (proj2_sig v))
                            (list_tl_length (proj1_sig v) (proj2_sig v)).A: Type
n: nat
forall v,
Vector_tl v =
exist (fun l : list A => length l = n)
  (list_tl (proj1_sig v) (proj2_sig v))
  (list_tl_length (proj1_sig v) (proj2_sig v))
    Proof.A: Type
n: nat
forall v,
Vector_tl v =
exist (fun l : list A => length l = n)
  (list_tl (proj1_sig v) (proj2_sig v))
  (list_tl_length (proj1_sig v) (proj2_sig v))
      intros.A: Type
n: nat
v: Vector (S n) A
Vector_tl v =
exist (fun l : list A => length l = n)
  (list_tl (proj1_sig v) (proj2_sig v))
  (list_tl_length (proj1_sig v) (proj2_sig v))
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_tl
  (exist (fun l : list A => length l = S n) vlist vlen) =
exist (fun l : list A => length l = n)
  (list_tl
     (proj1_sig
        (exist (fun l : list A => length l = S n)
           vlist vlen))
     (proj2_sig
        (exist (fun l : list A => length l = S n)
           vlist vlen)))
  (list_tl_length
     (proj1_sig
        (exist (fun l : list A => length l = S n)
           vlist vlen))
     (proj2_sig
        (exist (fun l : list A => length l = S n)
           vlist vlen)))
      apply Vector_eq.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
proj1_sig
  (Vector_tl
     (exist (fun l : list A => length l = S n) vlist
        vlen)) =
proj1_sig
  (exist (fun l : list A => length l = n)
     (list_tl
        (proj1_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))
        (proj2_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen)))
     (list_tl_length
        (proj1_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))
        (proj2_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))))
      rewrite proj_Vector_tl.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
list_tl
  (proj1_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen)) =
proj1_sig
  (exist (fun l : list A => length l = n)
     (list_tl
        (proj1_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))
        (proj2_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen)))
     (list_tl_length
        (proj1_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))
        (proj2_sig
           (exist (fun l : list A => length l = S n)
              vlist vlen))))
      reflexivity.
    Qed.

    Lemma Vector_surjective_pairing `{v: Vector (S n) A}:
      Vector_uncons v = (Vector_hd v , Vector_tl v).A: Type
n: nat
v: Vector (S n) A
Vector_uncons v = (Vector_hd v, Vector_tl v)
    Proof.A: Type
n: nat
v: Vector (S n) A
Vector_uncons v = (Vector_hd v, Vector_tl v)
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen) =
(Vector_hd
   (exist (fun l : list A => length l = S n) vlist
      vlen),
 Vector_tl
   (exist (fun l : list A => length l = S n) vlist
      vlen))
      unfold Vector_hd, Vector_tl.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen) =
((fst ∘ Vector_uncons)
   (exist (fun l : list A => length l = S n) vlist
      vlen),
 (snd ∘ Vector_uncons)
   (exist (fun l : list A => length l = S n) vlist
      vlen))
      unfold compose.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen) =
(fst
   (Vector_uncons
      (exist (fun l : list A => length l = S n) vlist
         vlen)),
 snd
   (Vector_uncons
      (exist (fun l : list A => length l = S n) vlist
         vlen)))
      rewrite <- surjective_pairing.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen) =
Vector_uncons
  (exist (fun l : list A => length l = S n) vlist vlen)
      reflexivity.
    Qed.

    Lemma Vector_surjective_pairing2 `{v: Vector (S n) A}:
      v = vcons n (Vector_hd v) (Vector_tl v).A: Type
n: nat
v: Vector (S n) A
v = vcons n (Vector_hd v) (Vector_tl v)
    Proof.A: Type
n: nat
v: Vector (S n) A
v = vcons n (Vector_hd v) (Vector_tl v)
      destruct v as [vlist vlen].A: Type
n: nat
vlist: list A
vlen: length vlist = S n
exist (fun l : list A => length l = S n) vlist vlen =
vcons n
  (Vector_hd
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (Vector_tl
     (exist (fun l : list A => length l = S n) vlist
        vlen))
      apply Vector_eq.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
proj1_sig
  (exist (fun l : list A => length l = S n) vlist vlen) =
proj1_sig
  (vcons n
     (Vector_hd
        (exist (fun l : list A => length l = S n)
           vlist vlen))
     (Vector_tl
        (exist (fun l : list A => length l = S n)
           vlist vlen)))
      rewrite proj_vcons.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
proj1_sig
  (exist (fun l : list A => length l = S n) vlist vlen) =
Vector_hd
  (exist (fun l : list A => length l = S n) vlist vlen)
:: proj1_sig
     (Vector_tl
        (exist (fun l : list A => length l = S n)
           vlist vlen))
      cbn.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vlist =
Vector_hd
  (exist (fun l : list A => length l = S n) vlist vlen)
:: proj1_sig
     (Vector_tl
        (exist (fun l : list A => length l = S n)
           vlist vlen))
      rewrite Vector_list_hd.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vlist =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
:: proj1_sig
     (Vector_tl
        (exist (fun l : list A => length l = S n)
           vlist vlen))
      rewrite Vector_list_tl.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vlist =
list_hd
  (proj1_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
  (proj2_sig
     (exist (fun l : list A => length l = S n) vlist
        vlen))
:: proj1_sig
     (exist (fun l : list A => length l = n)
        (list_tl
           (proj1_sig
              (exist
                 (fun l : list A => length l = S n)
                 vlist vlen))
           (proj2_sig
              (exist
                 (fun l : list A => length l = S n)
                 vlist vlen)))
        (list_tl_length
           (proj1_sig
              (exist
                 (fun l : list A => length l = S n)
                 vlist vlen))
           (proj2_sig
              (exist
                 (fun l : list A => length l = S n)
                 vlist vlen))))
      cbn.A: Type
n: nat
vlist: list A
vlen: length vlist = S n
vlist = list_hd vlist vlen :: list_tl vlist vlen
      apply list_surjective_pairing2.
    Qed.

    Lemma Vector_hd_vcons {a} {v: Vector n A}:
      Vector_hd (vcons n a v) = a.A: Type
n: nat
a: A
v: Vector n A
Vector_hd (vcons n a v) = a
    Proof.A: Type
n: nat
a: A
v: Vector n A
Vector_hd (vcons n a v) = a
      destruct v.A: Type
n: nat
a: A
x: list A
e: length x = n
Vector_hd
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) = a
      reflexivity.
    Qed.

    Lemma Vector_tl_vcons {a} {v: Vector n A}:
      Vector_tl (vcons n a v) = v.A: Type
n: nat
a: A
v: Vector n A
Vector_tl (vcons n a v) = v
    Proof.A: Type
n: nat
a: A
v: Vector n A
Vector_tl (vcons n a v) = v
      destruct v.A: Type
n: nat
a: A
x: list A
e: length x = n
Vector_tl
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) =
exist (fun l : list A => length l = n) x e
      cbn.A: Type
n: nat
a: A
x: list A
e: length x = n
exist (fun l : list A => length l = n) x
  (S_uncons (args_eq_1 S e)) =
exist (fun l : list A => length l = n) x e
      fequal.A: Type
n: nat
a: A
x: list A
e: length x = n
S_uncons (args_eq_1 S e) = e
      apply proof_irrelevance.
    Qed.

  End heads_tails.

  Definition vunone {A}: Vector 1 A -> A :=
    @Vector_hd A 0.

  Lemma Vector_hd_sim {n m A}
                      {v1: Vector (S n) A}
                      {v2: Vector (S m) A}:
    v1 ~~ v2 ->
    Vector_hd v1 = Vector_hd v2.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
v1 ~~ v2 -> Vector_hd v1 = Vector_hd v2
  Proof.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
v1 ~~ v2 -> Vector_hd v1 = Vector_hd v2
    intro Hsim.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: v1 ~~ v2
Vector_hd v1 = Vector_hd v2
    rewrite Vector_list_hd.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: v1 ~~ v2
list_hd (proj1_sig v1) (proj2_sig v1) = Vector_hd v2
    rewrite Vector_list_hd.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: v1 ~~ v2
list_hd (proj1_sig v1) (proj2_sig v1) =
list_hd (proj1_sig v2) (proj2_sig v2)
    unfold Vector_sim in Hsim.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
list_hd (proj1_sig v1) (proj2_sig v1) =
list_hd (proj1_sig v2) (proj2_sig v2)
    rewrite (list_hd_rw Hsim).n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
list_hd (proj1_sig v2)
  (rew [fun l1 : list A => length l1 = S n] Hsim in
   proj2_sig v1) =
list_hd (proj1_sig v2) (proj2_sig v2)
    apply list_hd_proof_irrelevance.
  Qed.

  Lemma Vector_tl_sim {n m A}
                      {v1: Vector (S n) A}
                      {v2: Vector (S m) A}:
    v1 ~~ v2 ->
    Vector_tl v1 ~~ Vector_tl v2.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
v1 ~~ v2 -> Vector_tl v1 ~~ Vector_tl v2
  Proof.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
v1 ~~ v2 -> Vector_tl v1 ~~ Vector_tl v2
    intro Hsim.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: v1 ~~ v2
Vector_tl v1 ~~ Vector_tl v2
    unfold Vector_sim in *.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
proj1_sig (Vector_tl v1) = proj1_sig (Vector_tl v2)
    rewrite proj_Vector_tl.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
list_tl (proj1_sig v1) (proj2_sig v1) =
proj1_sig (Vector_tl v2)
    rewrite proj_Vector_tl.n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
list_tl (proj1_sig v1) (proj2_sig v1) =
list_tl (proj1_sig v2) (proj2_sig v2)
    rewrite (list_tl_rw Hsim).n, m: nat
A: Type
v1: Vector (S n) A
v2: Vector (S m) A
Hsim: proj1_sig v1 = proj1_sig v2
list_tl (proj1_sig v2)
  (rew [fun l1 : list A => length l1 = S n] Hsim in
   proj2_sig v1) =
list_tl (proj1_sig v2) (proj2_sig v2)
    apply list_tl_proof_irrelevance.
  Qed.


  Corollary Vector_hd_coerce_eq
              {n m A}
              {v: Vector (S n) A}
              {Heq: S n = S m}:
    Vector_hd v = Vector_hd (coerce_Vector_length Heq v).n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
Vector_hd v = Vector_hd (coerce Heq in v)
  Proof.n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
Vector_hd v = Vector_hd (coerce Heq in v)
    apply Vector_hd_sim.n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
v ~~ coerce Heq in v
    apply Vector_coerce_sim_r.
  Qed.

  Corollary Vector_tl_coerce_sim
              {n m A}
              {v: Vector (S n) A}
              {Heq: S n = S m}:
    Vector_tl v ~~ Vector_tl (coerce_Vector_length Heq v).n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
Vector_tl v ~~ Vector_tl (coerce Heq in v)
  Proof.n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
Vector_tl v ~~ Vector_tl (coerce Heq in v)
    apply Vector_tl_sim.n, m: nat
A: Type
v: Vector (S n) A
Heq: S n = S m
v ~~ coerce Heq in v
    apply Vector_coerce_sim_r.
  Qed.

End inversion.

Ltac vector_sim :=
  repeat (match goal with
          | |- ?v ~~ coerce ?Heq in ?v =>
              apply Vector_coerce_sim_r
          | |- coerce ?Heq in ?v ~~ ?v =>
              apply Vector_coerce_sim_l
          | |- ?v ~~ coerce ?Heq in ?w =>
              apply Vector_coerce_sim_r'
          | |- coerce ?Heq in ?w ~~ ?v =>
              apply Vector_coerce_sim_l'
          | |- Vector_tl ?v ~~ Vector_tl ?w =>
              apply Vector_tl_sim
          | |- ?v ~!~ precoerce ?Heq in ?v =>
              apply Vector_coerce_fun_sim_r
          | |- precoerce ?Heq in ?v ~~ ?v =>
              apply Vector_coerce_fun_sim_l
          | |- ?v ~~ precoerce ?Heq in ?w =>
              apply Vector_coerce_fun_sim_r'
          | |- precoerce ?Heq in ?w ~~ ?v =>
              apply Vector_coerce_fun_sim_l'
          | |- _ => reflexivity
          | |- _ => assumption
          end).

(** ** Induction *)
(******************************************************************************)
Lemma Vector_induction_core:
  forall (A: Type)
    (P: forall m, Vector m A -> Prop)
    (IHnil: P 0 vnil)
    (IHcons:
      forall a m (v: Vector m A), P m v -> P (S m) (vcons m a v)),
  forall m (v: Vector m A), P m v.forall (A : Type)
  (P : forall m : nat, Vector m A -> Prop),
P 0 vnil ->
(forall (a : A) (m : nat) (v : Vector m A),
 P m v -> P (S m) (vcons m a v)) ->
forall (m : nat) (v : Vector m A), P m v
Proof.forall (A : Type)
  (P : forall m : nat, Vector m A -> Prop),
P 0 vnil ->
(forall (a : A) (m : nat) (v : Vector m A),
 P m v -> P (S m) (vcons m a v)) ->
forall (m : nat) (v : Vector m A), P m v
  intros.A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
m: nat
v: Vector m A
P m v
  induction m.A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
v: Vector 0 A
P 0 v
A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
m: nat
v: Vector (S m) A
IHm: forall v : Vector m A, P m v
P (S m) v
  +A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
v: Vector 0 A
P 0 v rewrite Vector_nil_eq.A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
v: Vector 0 A
P 0 vnil assumption.
  +A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
m: nat
v: Vector (S m) A
IHm: forall v : Vector m A, P m v
P (S m) v destruct (Vector_uncons_inform v) as [[vhd vtl] veq].A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
m: nat
v: Vector (S m) A
IHm: forall v : Vector m A, P m v
vhd: A
vtl: Vector m A
veq: v = vcons m (fst (vhd, vtl)) (snd (vhd, vtl))
P (S m) v
    subst.A: Type
P: forall m : nat, Vector m A -> Prop
IHnil: P 0 vnil
IHcons: forall (a : A) (m : nat) (v : Vector m A),
P m v -> P (S m) (vcons m a v)
m: nat
IHm: forall v : Vector m A, P m v
vhd: A
vtl: Vector m A
P (S m) (vcons m (fst (vhd, vtl)) (snd (vhd, vtl))) auto.
Qed.

Lemma Vector_induction:
  forall (m: nat) (A: Type) (P: forall m, Vector m A -> Prop)
    (IHnil: P 0 vnil)
    (IHcons:
      forall a m (v: Vector m A), P m v -> P (S m) (vcons m a v)),
  forall (v: Vector m A), P m v.forall (m : nat) (A : Type)
  (P : forall m0 : nat, Vector m0 A -> Prop),
P 0 vnil ->
(forall (a : A) (m0 : nat) (v : Vector m0 A),
 P m0 v -> P (S m0) (vcons m0 a v)) ->
forall v : Vector m A, P m v
Proof.forall (m : nat) (A : Type)
  (P : forall m0 : nat, Vector m0 A -> Prop),
P 0 vnil ->
(forall (a : A) (m0 : nat) (v : Vector m0 A),
 P m0 v -> P (S m0) (vcons m0 a v)) ->
forall v : Vector m A, P m v
  intros; apply Vector_induction_core; auto.
Qed.

(** *** Simultaneous induction on vectors of similar length *)
(******************************************************************************)
Lemma Vector_induction2_core:
  forall (A: Type)
    (P: forall m, Vector m A -> Vector m A -> Prop)
    (IHnil: P 0 vnil vnil)
    (IHcons:
      forall m (a1 a2: A) (v1 v2: Vector m A),
        P m v1 v2 ->
        P (S m) (vcons m a1 v1) (vcons m a2 v2)),
  forall (m : nat) (v1 v2: Vector m A), P m v1 v2.forall (A : Type)
  (P : forall m : nat,
       Vector m A -> Vector m A -> Prop),
P 0 vnil vnil ->
(forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
 P m v1 v2 -> P (S m) (vcons m a1 v1) (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A), P m v1 v2
Proof.forall (A : Type)
  (P : forall m : nat,
       Vector m A -> Vector m A -> Prop),
P 0 vnil vnil ->
(forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
 P m v1 v2 -> P (S m) (vcons m a1 v1) (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A), P m v1 v2
  intros.A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
m: nat
v1, v2: Vector m A
P m v1 v2
  induction m.A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
v1, v2: Vector 0 A
P 0 v1 v2
A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
m: nat
v1, v2: Vector (S m) A
IHm: forall v1 v2 : Vector m A, P m v1 v2
P (S m) v1 v2
  +A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
v1, v2: Vector 0 A
P 0 v1 v2 rewrite Vector_nil_eq.A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
v1, v2: Vector 0 A
P 0 v1 vnil
    rewrite (Vector_nil_eq v1).A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
v1, v2: Vector 0 A
P 0 vnil vnil
    assumption.
  +A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
m: nat
v1, v2: Vector (S m) A
IHm: forall v1 v2 : Vector m A, P m v1 v2
P (S m) v1 v2 destruct (Vector_uncons_inform v1) as
      [[v1hd v1tl] v1eq].A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
m: nat
v1, v2: Vector (S m) A
IHm: forall v1 v2 : Vector m A, P m v1 v2
v1hd: A
v1tl: Vector m A
v1eq: v1 =
vcons m (fst (v1hd, v1tl)) (snd (v1hd, v1tl))
P (S m) v1 v2
    destruct (Vector_uncons_inform v2) as
      [[v2hd v2tl] v2eq].A: Type
P: forall m : nat, Vector m A -> Vector m A -> Prop
IHnil: P 0 vnil vnil
IHcons: forall (m : nat) (a1 a2 : A)
  (v1 v2 : Vector m A),
P m v1 v2 ->
P (S m) (vcons m a1 v1) (vcons m a2 v2)
m: nat
v1, v2: Vector (S m) A
IHm: forall v1 v2 : Vector m A, P m v1 v2
v1hd: A
v1tl: Vector m A
v1eq: v1 =
vcons m (fst (v1hd, v1tl)) (snd (v1hd, v1tl))
v2hd: A
v2tl: Vector m A
v2eq: v2 =
vcons m (fst (v2hd, v2tl)) (snd (v2hd, v2tl))
P (S m) v1 v2
    subst; cbn; auto.
Qed.

Lemma Vector_induction2:
  forall (A: Type) (m n : nat)
    (P: forall m n, Vector m A -> Vector n A -> Prop)
    (IHnil: P 0 0 vnil vnil)
    (IHcons:
      forall m n (a1 a2: A) (v1: Vector m A) (v2: Vector n A),
        P m n v1 v2 ->
        P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)),
  forall (v1: Vector m A) (v2: Vector n A),
    n = m -> P m n v1 v2.forall (A : Type) (m n : nat)
  (P : forall m0 n0 : nat,
       Vector m0 A -> Vector n0 A -> Prop),
P 0 0 vnil vnil ->
(forall (m0 n0 : nat) (a1 a2 : A) (v1 : Vector m0 A)
   (v2 : Vector n0 A),
 P m0 n0 v1 v2 ->
 P (S m0) (S n0) (vcons m0 a1 v1) (vcons n0 a2 v2)) ->
forall (v1 : Vector m A) (v2 : Vector n A),
n = m -> P m n v1 v2
Proof.forall (A : Type) (m n : nat)
  (P : forall m0 n0 : nat,
       Vector m0 A -> Vector n0 A -> Prop),
P 0 0 vnil vnil ->
(forall (m0 n0 : nat) (a1 a2 : A) (v1 : Vector m0 A)
   (v2 : Vector n0 A),
 P m0 n0 v1 v2 ->
 P (S m0) (S n0) (vcons m0 a1 v1) (vcons n0 a2 v2)) ->
forall (v1 : Vector m A) (v2 : Vector n A),
n = m -> P m n v1 v2
  intros.A: Type
m, n: nat
P: forall m n : nat, Vector m A -> Vector n A -> Prop
IHnil: P 0 0 vnil vnil
IHcons: forall (m n : nat) (a1 a2 : A)
  (v1 : Vector m A) (v2 : Vector n A),
P m n v1 v2 ->
P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)
v1: Vector m A
v2: Vector n A
H: n = m
P m n v1 v2
  subst.A: Type
m: nat
P: forall m n : nat, Vector m A -> Vector n A -> Prop
IHnil: P 0 0 vnil vnil
IHcons: forall (m n : nat) (a1 a2 : A)
  (v1 : Vector m A) (v2 : Vector n A),
P m n v1 v2 ->
P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)
v1, v2: Vector m A
P m m v1 v2
  apply (Vector_induction2_core A (fun m => P m m)).A: Type
m: nat
P: forall m n : nat, Vector m A -> Vector n A -> Prop
IHnil: P 0 0 vnil vnil
IHcons: forall (m n : nat) (a1 a2 : A)
  (v1 : Vector m A) (v2 : Vector n A),
P m n v1 v2 ->
P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)
v1, v2: Vector m A
P 0 0 vnil vnil
A: Type
m: nat
P: forall m n : nat, Vector m A -> Vector n A -> Prop
IHnil: P 0 0 vnil vnil
IHcons: forall (m n : nat) (a1 a2 : A)
  (v1 : Vector m A) (v2 : Vector n A),
P m n v1 v2 ->
P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)
v1, v2: Vector m A
forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
P m m v1 v2 ->
P (S m) (S m) (vcons m a1 v1) (vcons m a2 v2)
  assumption.A: Type
m: nat
P: forall m n : nat, Vector m A -> Vector n A -> Prop
IHnil: P 0 0 vnil vnil
IHcons: forall (m n : nat) (a1 a2 : A)
  (v1 : Vector m A) (v2 : Vector n A),
P m n v1 v2 ->
P (S m) (S n) (vcons m a1 v1) (vcons n a2 v2)
v1, v2: Vector m A
forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
P m m v1 v2 ->
P (S m) (S m) (vcons m a1 v1) (vcons m a2 v2)
  auto.
Qed.

(** ** Misc *)
(******************************************************************************)
Fixpoint Vector_repeat
           (n: nat) {A: Type} (a : A): Vector n A :=
  match n with
  | 0 => vnil
  | S m => vcons m a (Vector_repeat m a)
  end.

Definition Vector_tt (n: nat): Vector n unit :=
  Vector_repeat n tt.

(** ** to_list *)
(******************************************************************************)
Section sec.

  Context (A: Type).

  Definition Vector_to_list {n:nat}: Vector n A -> list A :=
    @proj1_sig (list A) _.

  Lemma Vector_to_list_vnil:
    Vector_to_list vnil = @nil A.A: Type
Vector_to_list vnil = nil
  Proof.A: Type
Vector_to_list vnil = nil
    reflexivity.
  Qed.

  Lemma Vector_to_list_vcons {a} {n} {v: Vector n A}:
    Vector_to_list (vcons _ a v) = a :: Vector_to_list v.A: Type
a: A
n: nat
v: Vector n A
Vector_to_list (vcons n a v) = a :: Vector_to_list v
  Proof.A: Type
a: A
n: nat
v: Vector n A
Vector_to_list (vcons n a v) = a :: Vector_to_list v
    destruct v.A: Type
a: A
n: nat
x: list A
e: length x = n
Vector_to_list
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) =
a
:: Vector_to_list
     (exist (fun l : list A => length l = n) x e)
    unfold vcons.A: Type
a: A
n: nat
x: list A
e: length x = n
Vector_to_list
  (exist (fun l : list A => length l = S n) (a :: x)
     (args_eq_1 S e)) =
a
:: Vector_to_list
     (exist (fun l : list A => length l = n) x e)
    reflexivity.
  Qed.

  Definition artificial_surjection {n:nat} (x: Vector n A):
    list A -> Vector n A :=
    fun l =>
      match (decide_length n l) with
      | left Heq => (exist _ l Heq)
      | right _ => x
      end.

  Lemma artificial_surjection_inv n (x:Vector n A) (l:list A) (Heq: length l = n):
    proj1_sig (artificial_surjection x l) = l.A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
proj1_sig (artificial_surjection x l) = l
  Proof.A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
proj1_sig (artificial_surjection x l) = l
    unfold artificial_surjection.A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
proj1_sig
  match decide_length n l with
  | left Heq =>
      exist (fun l : list A => length l = n) l Heq
  | right _ => x
  end = l
    assert (decide_length n l = left Heq).A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
decide_length n l = left Heq
A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
H: decide_length n l = left Heq
proj1_sig
  match decide_length n l with
  | left Heq =>
      exist (fun l : list A => length l = n) l Heq
  | right _ => x
  end = l
    {A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
decide_length n l = left Heq destruct (decide_length n l).A: Type
n: nat
x: Vector n A
l: list A
Heq, e: length l = n
left e = left Heq
A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
f: length l = n -> False
right f = left Heq
      +A: Type
n: nat
x: Vector n A
l: list A
Heq, e: length l = n
left e = left Heq fequal.A: Type
n: nat
x: Vector n A
l: list A
Heq, e: length l = n
e = Heq apply proof_irrelevance.
      +A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
f: length l = n -> False
right f = left Heq contradiction.
    }A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
H: decide_length n l = left Heq
proj1_sig
  match decide_length n l with
  | left Heq =>
      exist (fun l : list A => length l = n) l Heq
  | right _ => x
  end = l
    rewrite H.A: Type
n: nat
x: Vector n A
l: list A
Heq: length l = n
H: decide_length n l = left Heq
proj1_sig
  (exist (fun l : list A => length l = n) l Heq) = l
    reflexivity.
  Qed.

  Lemma Vector_to_list_length: forall (n:nat) (x: Vector n A),
      length (Vector_to_list x) = n.A: Type
forall (n : nat) (x : Vector n A),
length (Vector_to_list x) = n
  Proof.A: Type
forall (n : nat) (x : Vector n A),
length (Vector_to_list x) = n
    intros.A: Type
n: nat
x: Vector n A
length (Vector_to_list x) = n
    destruct x.A: Type
n: nat
x: list A
e: length x = n
length
  (Vector_to_list
     (exist (fun l : list A => length l = n) x e)) = n
    assumption.
  Qed.

  Lemma artificial_iso {n:nat}(x: Vector n A):
    artificial_surjection x ∘ Vector_to_list = id.A: Type
n: nat
x: Vector n A
artificial_surjection x ∘ Vector_to_list = id
  Proof.A: Type
n: nat
x: Vector n A
artificial_surjection x ∘ Vector_to_list = id
    intros.A: Type
n: nat
x: Vector n A
artificial_surjection x ∘ Vector_to_list = id
    ext v.A: Type
n: nat
x, v: Vector n A
(artificial_surjection x ∘ Vector_to_list) v = id v
    unfold compose.A: Type
n: nat
x, v: Vector n A
artificial_surjection x (Vector_to_list v) = id v
    destruct v.A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
artificial_surjection x
  (Vector_to_list
     (exist (fun l : list A => length l = n) x0 e)) =
id (exist (fun l : list A => length l = n) x0 e)
    apply Vector_eq.A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
proj1_sig
  (artificial_surjection x
     (Vector_to_list
        (exist (fun l : list A => length l = n) x0 e))) =
proj1_sig
  (id (exist (fun l : list A => length l = n) x0 e))
    rewrite artificial_surjection_inv.A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
Vector_to_list
  (exist (fun l : list A => length l = n) x0 e) =
proj1_sig
  (id (exist (fun l : list A => length l = n) x0 e))
A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
length
  (Vector_to_list
     (exist (fun l : list A => length l = n) x0 e)) =
n
    -A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
Vector_to_list
  (exist (fun l : list A => length l = n) x0 e) =
proj1_sig
  (id (exist (fun l : list A => length l = n) x0 e)) reflexivity.
    -A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
length
  (Vector_to_list
     (exist (fun l : list A => length l = n) x0 e)) =
n rewrite Vector_to_list_length.A: Type
n: nat
x: Vector n A
x0: list A
e: length x0 = n
n = n
      reflexivity.
  Qed.

  Lemma functors_preserve_inj `{Functor F}:
    forall {A B: Type} (f: A -> B) (g: B -> A)
      (Hinv: g ∘ f = id) (a1 a2: F A),
      map f a1 = map f a2 -> a1 = a2.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
forall (A B : Type) (f : A -> B) (g : B -> A),
g ∘ f = id ->
forall a1 a2 : F A, map f a1 = map f a2 -> a1 = a2
  Proof.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
forall (A B : Type) (f : A -> B) (g : B -> A),
g ∘ f = id ->
forall a1 a2 : F A, map f a1 = map f a2 -> a1 = a2
    introv Hinv Heq.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
a1 = a2
    change (id a1 = id a2).A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
id a1 = id a2
    rewrite <- (fun_map_id (F := F)).A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
map id a1 = map id a2
    rewrite <- Hinv.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
map (g ∘ f) a1 = map (g ∘ f) a2
    rewrite <- (fun_map_map (F := F)).A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
(map g ∘ map f) a1 = (map g ∘ map f) a2
    unfold compose.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
map g (map f a1) = map g (map f a2)
    rewrite Heq.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
g: B -> A0
Hinv: g ∘ f = id
a1, a2: F A0
Heq: map f a1 = map f a2
map g (map f a2) = map g (map f a2)
    reflexivity.
  Qed.

  Lemma functors_preserve_inj2 `{Functor F}:
    forall {A B: Type} (f: A -> B) (a1 a2: F A),
    (exists g: B -> A, g ∘ f = id) ->
      map f a1 = map f a2 -> a1 = a2.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
forall (A B : Type) (f : A -> B) (a1 a2 : F A),
(exists g : B -> A, g ∘ f = id) ->
map f a1 = map f a2 -> a1 = a2
  Proof.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
forall (A B : Type) (f : A -> B) (a1 a2 : F A),
(exists g : B -> A, g ∘ f = id) ->
map f a1 = map f a2 -> a1 = a2
    introv Hinv.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
a1, a2: F A0
Hinv: exists g : B -> A0, g ∘ f = id
map f a1 = map f a2 -> a1 = a2 destruct Hinv.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
a1, a2: F A0
x: B -> A0
H0: x ∘ f = id
map f a1 = map f a2 -> a1 = a2
    eapply functors_preserve_inj.A: Type
F: Type -> Type
Map_F: Map F
H: Functor F
A0, B: Type
f: A0 -> B
a1, a2: F A0
x: B -> A0
H0: x ∘ f = id
?g ∘ f = id
    eassumption.
  Qed.

  Lemma functors_preserve_inj4 `{Applicative F}:
    forall {A1 A2 B: Type} (f: A1 -> A2 -> B) (a1 a2: F A1) (a1' a2': F A2),
    (exists g: B -> A1 * A2, (forall x y, (compose g ∘ f) x y = (x, y))) ->
    pure f <⋆> a1 <⋆> a1'
    = pure f <⋆> a2 <⋆> a2'
    -> a1 = a2 /\ a1' = a2'.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A1 A2 B : Type) (f : A1 -> A2 -> B)
  (a1 a2 : F A1) (a1' a2' : F A2),
(exists g : B -> A1 * A2,
   forall (x : A1) (y : A2),
   (compose g ∘ f) x y = (x, y)) ->
pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2' ->
a1 = a2 /\ a1' = a2'
  Proof.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A1 A2 B : Type) (f : A1 -> A2 -> B)
  (a1 a2 : F A1) (a1' a2' : F A2),
(exists g : B -> A1 * A2,
   forall (x : A1) (y : A2),
   (compose g ∘ f) x y = (x, y)) ->
pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2' ->
a1 = a2 /\ a1' = a2'
    introv Hinv Heq.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
a1 = a2 /\ a1' = a2'
    enough (cut: (a1, a1') = (a2, a2')).A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
cut: (a1, a1') = (a2, a2')
a1 = a2 /\ a1' = a2'
A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
(a1, a1') = (a2, a2')
    {A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
cut: (a1, a1') = (a2, a2')
a1 = a2 /\ a1' = a2' inversion cut.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
cut: (a1, a1') = (a2, a2')
H1: a1 = a2
H2: a1' = a2'
a2 = a2 /\ a2' = a2' now subst. }A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
(a1, a1') = (a2, a2')
    change (id (a1, a1') = (a2, a2')).A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
id (a1, a1') = (a2, a2')
    assert (a1 ⊗ a1' = a2 ⊗ a2' -> (a1, a1') = (a2, a2')).A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
a1 ⊗ a1' = a2 ⊗ a2' -> (a1, a1') = (a2, a2')
A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
H0: a1 ⊗ a1' = a2 ⊗ a2' -> (a1, a1') = (a2, a2')
id (a1, a1') = (a2, a2')
    {A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
a1 ⊗ a1' = a2 ⊗ a2' -> (a1, a1') = (a2, a2') intro eq_mult.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
(a1, a1') = (a2, a2')
      assert (map fst (a1 ⊗ a1') =
                map fst (a2 ⊗ a2'))
               by now rewrite eq_mult.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
(a1, a1') = (a2, a2')
      assert (map snd (a1 ⊗ a1') =
                map snd (a2 ⊗ a2'))
        by now rewrite eq_mult.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
(a1, a1') = (a2, a2')
      assert (map (F := F) (fun x => (fst x, snd x)) (a1 ⊗ a1') =
                map (fun x => (fst x, snd x)) (a2 ⊗ a2')).A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
map (fun x : A1 * A2 => (fst x, snd x)) (a1 ⊗ a1') =
map (fun x : A1 * A2 => (fst x, snd x)) (a2 ⊗ a2')
A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
H2: map (fun x : A1 * A2 => (fst x, snd x))
  (a1 ⊗ a1') =
map (fun x : A1 * A2 => (fst x, snd x))
  (a2 ⊗ a2')
(a1, a1') = (a2, a2')
      {A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
map (fun x : A1 * A2 => (fst x, snd x)) (a1 ⊗ a1') =
map (fun x : A1 * A2 => (fst x, snd x)) (a2 ⊗ a2') rewrite eq_mult.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
map (fun x : A1 * A2 => (fst x, snd x)) (a2 ⊗ a2') =
map (fun x : A1 * A2 => (fst x, snd x)) (a2 ⊗ a2') reflexivity. }A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, A2, B: Type
f: A1 -> A2 -> B
a1, a2: F A1
a1', a2': F A2
Hinv: exists g : B -> A1 * A2,
  forall (x : A1) (y : A2),
  (compose g ∘ f) x y = (x, y)
Heq: pure f <⋆> a1 <⋆> a1' = pure f <⋆> a2 <⋆> a2'
eq_mult: a1 ⊗ a1' = a2 ⊗ a2'
H0: map fst (a1 ⊗ a1') = map fst (a2 ⊗ a2')
H1: map snd (a1 ⊗ a1') = map snd (a2 ⊗ a2')
H2: map (fun x : A1 * A2 => (fst x, snd x))
  (a1 ⊗ a1') =
map (fun x : A1 * A2 => (fst x, snd x))
  (a2 ⊗ a2')
(a1, a1') = (a2, a2')
  Abort.

  Lemma functors_preserve_inj3 `{Applicative F}:
    forall {A B: Type} (f: A -> B) (a1 a2: F A),
    (exists g: B -> A, g ∘ f = id) ->
    pure f <⋆> a1 = pure f <⋆> a2 -> a1 = a2.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A B : Type) (f : A -> B) (a1 a2 : F A),
(exists g : B -> A, g ∘ f = id) ->
pure f <⋆> a1 = pure f <⋆> a2 -> a1 = a2
  Proof.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A B : Type) (f : A -> B) (a1 a2 : F A),
(exists g : B -> A, g ∘ f = id) ->
pure f <⋆> a1 = pure f <⋆> a2 -> a1 = a2
    introv Hinv.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A0, B: Type
f: A0 -> B
a1, a2: F A0
Hinv: exists g : B -> A0, g ∘ f = id
pure f <⋆> a1 = pure f <⋆> a2 -> a1 = a2
    rewrite <- map_to_ap.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A0, B: Type
f: A0 -> B
a1, a2: F A0
Hinv: exists g : B -> A0, g ∘ f = id
map f a1 = pure f <⋆> a2 -> a1 = a2
    rewrite <- map_to_ap.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A0, B: Type
f: A0 -> B
a1, a2: F A0
Hinv: exists g : B -> A0, g ∘ f = id
map f a1 = map f a2 -> a1 = a2
    apply functors_preserve_inj2.A: Type
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A0, B: Type
f: A0 -> B
a1, a2: F A0
Hinv: exists g : B -> A0, g ∘ f = id
exists g : B -> A0, g ∘ f = id
    assumption.
  Qed.

  Lemma Vector_pres_inj {n:nat} (v: Vector n A) `{Functor F}:
    forall (x y: F (Vector n A)),
      map Vector_to_list x = map Vector_to_list y ->
      x = y.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
forall x y : F (Vector n A),
map Vector_to_list x = map Vector_to_list y -> x = y
  Proof.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
forall x y : F (Vector n A),
map Vector_to_list x = map Vector_to_list y -> x = y
    introv Heq.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
x = y
    assert (map (artificial_surjection v) (map Vector_to_list x)
            = map (artificial_surjection v) (map Vector_to_list y)).A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
map (artificial_surjection v) (map Vector_to_list x) =
map (artificial_surjection v) (map Vector_to_list y)
A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
x = y
    {A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
map (artificial_surjection v) (map Vector_to_list x) =
map (artificial_surjection v) (map Vector_to_list y) now rewrite Heq. }A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
x = y
    generalize H0.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
map (artificial_surjection v) (map Vector_to_list x) =
map (artificial_surjection v) (map Vector_to_list y) ->
x = y
    compose near x.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
(map (artificial_surjection v) ∘ map Vector_to_list) x =
map (artificial_surjection v) (map Vector_to_list y) ->
x = y
    compose near y.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
(map (artificial_surjection v) ∘ map Vector_to_list) x =
(map (artificial_surjection v) ∘ map Vector_to_list) y ->
x = y
    rewrite (fun_map_map).A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
map (artificial_surjection v ∘ Vector_to_list) x =
map (artificial_surjection v ∘ Vector_to_list) y ->
x = y
    rewrite artificial_iso.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
map id x = map id y -> x = y
    rewrite fun_map_id.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
id x = id y -> x = y
    unfold id.A: Type
n: nat
v: Vector n A
F: Type -> Type
Map_F: Map F
H: Functor F
x, y: F (Vector n A)
Heq: map Vector_to_list x = map Vector_to_list y
H0: map (artificial_surjection v)
  (map Vector_to_list x) =
map (artificial_surjection v)
  (map Vector_to_list y)
x = y -> x = y
    auto.
  Qed.

End sec.

(** * Functor instance *)
(******************************************************************************)
Definition map_Vector
             (n : nat) {A B : Type} (f : A -> B)
             (v : Vector n A): Vector n B :=
  match v with
  | exist _ l p =>
      exist _ (map (F := list) f l)
            (eq_trans (map_preserve_length A B f l) p)
  end.

#[export] Instance Map_Vector (n: nat) : Map (Vector n) := @map_Vector n.

Lemma fun_map_id_Vector : forall (n : nat) (A : Type),
    map (F := Vector n) id = @id (Vector n A).forall (n : nat) (A : Type), map id = id
Proof.forall (n : nat) (A : Type), map id = id
  intros.n: nat
A: Type
map id = id
  ext [l Heq].n: nat
A: Type
l: list A
Heq: length l = n
map id (exist (fun l : list A => length l = n) l Heq) =
id (exist (fun l : list A => length l = n) l Heq)
  apply Vector_eq.n: nat
A: Type
l: list A
Heq: length l = n
proj1_sig
  (map id
     (exist (fun l : list A => length l = n) l Heq)) =
proj1_sig
  (id (exist (fun l : list A => length l = n) l Heq))
  cbn.n: nat
A: Type
l: list A
Heq: length l = n
map id l = l
  now rewrite fun_map_id.
Qed.

Lemma fun_map_map_Vector : forall (n : nat) (A B C : Type) (f : A -> B) (g : B -> C),
    map (F := Vector n) g ∘ map (F := Vector n) f = map (F := Vector n) (g ∘ f).forall (n : nat) (A B C : Type) (f : A -> B)
  (g : B -> C), map g ∘ map f = map (g ∘ f)
Proof.forall (n : nat) (A B C : Type) (f : A -> B)
  (g : B -> C), map g ∘ map f = map (g ∘ f)
  intros.n: nat
A, B, C: Type
f: A -> B
g: B -> C
map g ∘ map f = map (g ∘ f)
  ext [l Heq].n: nat
A, B, C: Type
f: A -> B
g: B -> C
l: list A
Heq: length l = n
(map g ∘ map f)
  (exist (fun l : list A => length l = n) l Heq) =
map (g ∘ f)
  (exist (fun l : list A => length l = n) l Heq)
  apply Vector_eq.n: nat
A, B, C: Type
f: A -> B
g: B -> C
l: list A
Heq: length l = n
proj1_sig
  ((map g ∘ map f)
     (exist (fun l : list A => length l = n) l Heq)) =
proj1_sig
  (map (g ∘ f)
     (exist (fun l : list A => length l = n) l Heq))
  cbn.n: nat
A, B, C: Type
f: A -> B
g: B -> C
l: list A
Heq: length l = n
map g (map f l) = map (g ∘ f) l compose near l on left.n: nat
A, B, C: Type
f: A -> B
g: B -> C
l: list A
Heq: length l = n
(map g ∘ map f) l = map (g ∘ f) l
  now rewrite fun_map_map.
Qed.

#[export] Instance Functor_Vector (n : nat) : Functor (Vector n) :=
  {| fun_map_id := fun_map_id_Vector n;
    fun_map_map := fun_map_map_Vector n;
  |}.

Lemma map_coerce_Vector:
  forall (A B: Type) (f: A -> B) (n m: nat) (Heq: n = m) (v: Vector n A),
    map f v ~~ map f (coerce Heq in v).forall (A B : Type) (f : A -> B) (n m : nat)
  (Heq : n = m) (v : Vector n A),
map f v ~~ map f (coerce Heq in v)
Proof.forall (A B : Type) (f : A -> B) (n m : nat)
  (Heq : n = m) (v : Vector n A),
map f v ~~ map f (coerce Heq in v)
  intros.A, B: Type
f: A -> B
n, m: nat
Heq: n = m
v: Vector n A
map f v ~~ map f (coerce Heq in v) unfold Vector_sim.A, B: Type
f: A -> B
n, m: nat
Heq: n = m
v: Vector n A
proj1_sig (map f v) =
proj1_sig (map f (coerce Heq in v))
  destruct v as [l Hlen].A, B: Type
f: A -> B
n, m: nat
Heq: n = m
l: list A
Hlen: length l = n
proj1_sig
  (map f
     (exist (fun l : list A => length l = n) l Hlen)) =
proj1_sig
  (map f
     (coerce Heq
      in exist (fun l : list A => length l = n) l Hlen))
  reflexivity.
Qed.

Lemma map_coerce_Vector2:
  forall (A B: Type) (f: A -> B) (n m: nat) (Heq: n = m) (v: Vector n A),
    map f (coerce Heq in v) = coerce Heq in (map f v).forall (A B : Type) (f : A -> B) (n m : nat)
  (Heq : n = m) (v : Vector n A),
map f (coerce Heq in v) = coerce Heq in map f v
Proof.forall (A B : Type) (f : A -> B) (n m : nat)
  (Heq : n = m) (v : Vector n A),
map f (coerce Heq in v) = coerce Heq in map f v
  intros.A, B: Type
f: A -> B
n, m: nat
Heq: n = m
v: Vector n A
map f (coerce Heq in v) = coerce Heq in map f v
  unfold Vector_sim.A, B: Type
f: A -> B
n, m: nat
Heq: n = m
v: Vector n A
map f (coerce Heq in v) = coerce Heq in map f v
  subst.A, B: Type
f: A -> B
m: nat
v: Vector m A
map f (coerce eq_refl in v) =
coerce eq_refl in map f v
  rewrite coerce_Vector_eq_refl.A, B: Type
f: A -> B
m: nat
v: Vector m A
map f v = coerce eq_refl in map f v
  rewrite coerce_Vector_eq_refl.A, B: Type
f: A -> B
m: nat
v: Vector m A
map f v = map f v
  reflexivity.
Qed.

Lemma Vector_coerce_map_l'
  {n m p} `{f: A -> B}
  `{w: Vector p A} `{v: Vector n B}
  (Heq: p = m):
    coerce Heq in (map f w) ~~ v ->
    map f (coerce Heq in w) ~~ v.n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
coerce Heq in map f w ~~ v ->
map f (coerce Heq in w) ~~ v
Proof.n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
coerce Heq in map f w ~~ v ->
map f (coerce Heq in w) ~~ v
  intros.n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
H: coerce Heq in map f w ~~ v
map f (coerce Heq in w) ~~ v
  rewrite (map_coerce_Vector2).n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
H: coerce Heq in map f w ~~ v
coerce Heq in map f w ~~ v
  assumption.
Qed.

Lemma Vector_coerce_map_r'
  {n m p} `{f: A -> B}
  `{w: Vector p A} `{v: Vector n B}
  (Heq: p = m):
  (v ~~ coerce Heq in (map f w)) ->
  v ~~ map f (coerce Heq in w).n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
v ~~ coerce Heq in map f w ->
v ~~ map f (coerce Heq in w)
Proof.n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
v ~~ coerce Heq in map f w ->
v ~~ map f (coerce Heq in w)
  intros.n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
H: v ~~ coerce Heq in map f w
v ~~ map f (coerce Heq in w)
  rewrite (map_coerce_Vector2).n, m, p: nat
A, B: Type
f: A -> B
w: Vector p A
v: Vector n B
Heq: p = m
H: v ~~ coerce Heq in map f w
v ~~ coerce Heq in map f w
  assumption.
Qed.

Ltac vector_sim ::=
  repeat (match goal with
          | |- _ => reflexivity
          | |- _ => assumption
          | |- ?v ~~ coerce ?Heq in ?v =>
              apply Vector_coerce_sim_r
          | |- coerce ?Heq in ?v ~~ ?v =>
              apply Vector_coerce_sim_l
          | |- ?v ~~ coerce ?Heq in ?w =>
              apply Vector_coerce_sim_r'
          | |- coerce ?Heq in ?w ~~ ?v =>
              apply Vector_coerce_sim_l'
          | |- Vector_tl ?v ~~ Vector_tl ?w =>
              apply Vector_tl_sim
          | |- ?v ~!~ precoerce ?Heq in ?v =>
              apply Vector_coerce_fun_sim_r
          | |- precoerce ?Heq in ?v ~~ ?v =>
              apply Vector_coerce_fun_sim_l
          | |- ?v ~~ precoerce ?Heq in ?w =>
              apply Vector_coerce_fun_sim_r'
          | |- precoerce ?Heq in ?w ~~ ?v =>
              apply Vector_coerce_fun_sim_l'
          | |- map ?f (coerce ?Heq in ?w) ~~ ?v =>
              apply Vector_coerce_map_l'
          | |- ?v ~~ map ?f (coerce ?Heq in ?w) =>
              apply Vector_coerce_map_r'
          end).

(** ** Mapping similar functions over Functors *)
(******************************************************************************)
(** The <<Heq>> argument is redundant in the sense it is derivable
      from f ~!~ g. However, it's more convenient to let the caller
      give a proof as the alternative is to wrap the output in an
      existential quantifier *)
Lemma map_sim_function `{Functor F} (A B: Type) (n m: nat):
  forall (f: Vector n A -> B) (g: Vector m A -> B)
    (Heq: n = m),
    f ~!~ g ->
    map (F := F) f = map (precoerce Heq in g).F: Type -> Type
Map_F: Map F
H: Functor F
A, B: Type
n, m: nat
forall (f : Vector n A -> B) (g : Vector m A -> B)
  (Heq : n = m),
f ~!~ g -> map f = map (precoerce Heq in g)
Proof.F: Type -> Type
Map_F: Map F
H: Functor F
A, B: Type
n, m: nat
forall (f : Vector n A -> B) (g : Vector m A -> B)
  (Heq : n = m),
f ~!~ g -> map f = map (precoerce Heq in g)
  introv Hsim.F: Type -> Type
Map_F: Map F
H: Functor F
A, B: Type
n, m: nat
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
Hsim: f ~!~ g
map f = map (precoerce Heq in g)
  rewrite (Vector_coerce_fun_coerce Heq Hsim).F: Type -> Type
Map_F: Map F
H: Functor F
A, B: Type
n, m: nat
f: Vector n A -> B
g: Vector m A -> B
Heq: n = m
Hsim: f ~!~ g
map (precoerce Heq in g) = map (precoerce Heq in g)
  reflexivity.
Qed.

(** ** Rewriting rules *)
(******************************************************************************)
Lemma map_Vector_vnil:
  forall {A B : Type} (f : A -> B),
    map f vnil = vnil.forall (A B : Type) (f : A -> B), map f vnil = vnil
Proof.forall (A B : Type) (f : A -> B), map f vnil = vnil
  intros.A, B: Type
f: A -> B
map f vnil = vnil
  apply Vector_eq.A, B: Type
f: A -> B
proj1_sig (map f vnil) = proj1_sig vnil
  reflexivity.
Qed.

Lemma map_Vector_rw2:
  forall {A B : Type} (f : A -> B)
    (a : A) (l: list A)
    (n : nat)
    (p : length (a :: l) = S n),
    map f (exist _ (a :: l) p) =
      vcons n (f a) (map f (exist (fun l => length l = n) l (S_uncons p))).forall (A B : Type) (f : A -> B) (a : A) (l : list A)
  (n : nat) (p : length (a :: l) = S n),
map f
  (exist (fun l0 : list A => length l0 = S n) (a :: l)
     p) =
vcons n (f a)
  (map f
     (exist (fun l0 : list A => length l0 = n) l
        (S_uncons p)))
Proof.forall (A B : Type) (f : A -> B) (a : A) (l : list A)
  (n : nat) (p : length (a :: l) = S n),
map f
  (exist (fun l0 : list A => length l0 = S n) (a :: l)
     p) =
vcons n (f a)
  (map f
     (exist (fun l0 : list A => length l0 = n) l
        (S_uncons p)))
  intros.A, B: Type
f: A -> B
a: A
l: list A
n: nat
p: length (a :: l) = S n
map f
  (exist (fun l : list A => length l = S n) (a :: l) p) =
vcons n (f a)
  (map f
     (exist (fun l : list A => length l = n) l
        (S_uncons p)))
  apply Vector_eq.A, B: Type
f: A -> B
a: A
l: list A
n: nat
p: length (a :: l) = S n
proj1_sig
  (map f
     (exist (fun l : list A => length l = S n)
        (a :: l) p)) =
proj1_sig
  (vcons n (f a)
     (map f
        (exist (fun l : list A => length l = n) l
           (S_uncons p))))
  reflexivity.
Qed.

Lemma map_Vector_vcons:
  forall  {A B : Type} (f : A -> B)
     (n : nat) (v : Vector n A) (a : A),
    map f (vcons n a v) =
      vcons n (f a) (map f v).forall (A B : Type) (f : A -> B) (n : nat)
  (v : Vector n A) (a : A),
map f (vcons n a v) = vcons n (f a) (map f v)
Proof.forall (A B : Type) (f : A -> B) (n : nat)
  (v : Vector n A) (a : A),
map f (vcons n a v) = vcons n (f a) (map f v)
  intros.A, B: Type
f: A -> B
n: nat
v: Vector n A
a: A
map f (vcons n a v) = vcons n (f a) (map f v)
  destruct v.A, B: Type
f: A -> B
n: nat
x: list A
e: length x = n
a: A
map f
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) =
vcons n (f a)
  (map f (exist (fun l : list A => length l = n) x e))
  unfold vcons.A, B: Type
f: A -> B
n: nat
x: list A
e: length x = n
a: A
map f
  (exist (fun l : list A => length l = S n) (a :: x)
     (args_eq_1 S e)) =
(let (x, p) :=
   map f (exist (fun l : list A => length l = n) x e) in
 exist (fun l : list B => length l = S n) (f a :: x)
   (args_eq_1 S p))
  rewrite map_Vector_rw2.A, B: Type
f: A -> B
n: nat
x: list A
e: length x = n
a: A
vcons n (f a)
  (map f
     (exist (fun l : list A => length l = n) x
        (S_uncons (args_eq_1 S e)))) =
(let (x, p) :=
   map f (exist (fun l : list A => length l = n) x e) in
 exist (fun l : list B => length l = S n) (f a :: x)
   (args_eq_1 S p))
  cbn.A, B: Type
f: A -> B
n: nat
x: list A
e: length x = n
a: A
exist (fun l : list B => length l = S n)
  (f a :: map f x)
  (args_eq_1 S
     (eq_trans (map_preserve_length A B f x)
        (S_uncons (args_eq_1 S e)))) =
exist (fun l : list B => length l = S n)
  (f a :: map f x)
  (args_eq_1 S
     (eq_trans (map_preserve_length A B f x) e)) fequal.A, B: Type
f: A -> B
n: nat
x: list A
e: length x = n
a: A
args_eq_1 S
  (eq_trans (map_preserve_length A B f x)
     (S_uncons (args_eq_1 S e))) =
args_eq_1 S (eq_trans (map_preserve_length A B f x) e)
  apply proof_irrelevance.
Qed.

(** * Traversable instance *)
(******************************************************************************)
Definition traverse_Vector_core
             {G} `{Map G} `{Pure G} `{Mult G}
             {A B : Type} (f : A -> G B)
             (vlist : list A) `(vlen : length vlist = n) : G (Vector n B) :=
      (fix go (vl : list A) n : length vl = n -> G (Vector n B) :=
         match vl
               return length vl = n -> G (Vector n B)
         with
         | nil =>
             fun vlen =>
               pure (F := G) (exist _ nil vlen)
         | cons a rest =>
             fun vlen =>
               match n return
                     length (a :: rest) = n -> G (Vector n B)
               with
               | O => fun vlen' => zero_not_S (eq_sym vlen')
               | S m =>
                   fun vlen' =>
                     pure (@vcons m B) <⋆> f a <⋆> go rest m (S_uncons vlen')
               end vlen
         end) vlist n vlen.

Definition traverse_Vector
             (n : nat) (G : Type -> Type) `{Map G} `{Pure G} `{Mult G}
             {A B : Type} (f : A -> G B)
             (v : Vector n A) : G (Vector n B) :=
  match v with
  | exist _ vlist vlen =>
      traverse_Vector_core f vlist vlen
  end.

#[export] Instance Traverse_Vector {n}: Traverse (Vector n)
  := traverse_Vector n.


#[export] Instance ToBatch_Vector {n: nat}:
  Coalgebraic.TraversableFunctor.ToBatch (Vector n) :=
  KleisliToCoalgebraic.TraversableFunctor.DerivedOperations.ToBatch_Traverse.

(** ** Rewriting rules *)
(******************************************************************************)
Lemma traverse_Vector_vnil:
  forall (G : Type -> Type) `{Map G} `{Pure G} `{Mult G}
    {A B : Type} (f : A -> G B),
    traverse f vnil = pure vnil.forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G) (A B : Type) (f : A -> G B),
traverse f vnil = pure vnil
Proof.forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G) (A B : Type) (f : A -> G B),
traverse f vnil = pure vnil
  intros.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
traverse f vnil = pure vnil
  reflexivity.
Qed.

Lemma traverse_Vector_rw_lemma:
  forall (n : nat) (G : Type -> Type) `{Map G} `{Pure G} `{Mult G}
    {A B : Type} (f : A -> G B)
    (a : A) (l: list A)
    (p : length (a :: l) = S n),
    traverse f (exist _ (a :: l) p) =
      pure (vcons n) <⋆> f a <⋆>
        traverse f (exist (fun l => length l = n) l (S_uncons p)).forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B) (a : A) (l : list A)
  (p : length (a :: l) = S n),
traverse f
  (exist (fun l0 : list A => length l0 = S n) (a :: l)
     p) =
pure (vcons n) <⋆> f a <⋆>
traverse f
  (exist (fun l0 : list A => length l0 = n) l
     (S_uncons p))
Proof.forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B) (a : A) (l : list A)
  (p : length (a :: l) = S n),
traverse f
  (exist (fun l0 : list A => length l0 = S n) (a :: l)
     p) =
pure (vcons n) <⋆> f a <⋆>
traverse f
  (exist (fun l0 : list A => length l0 = n) l
     (S_uncons p))
  intros.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
a: A
l: list A
p: length (a :: l) = S n
traverse f
  (exist (fun l : list A => length l = S n) (a :: l) p) =
pure (vcons n) <⋆> f a <⋆>
traverse f
  (exist (fun l : list A => length l = n) l
     (S_uncons p))
  reflexivity.
Qed.

Lemma traverse_Vector_vcons:
  forall (n : nat) (G : Type -> Type) `{Map G} `{Pure G} `{Mult G}
    {A B : Type} (f : A -> G B)
    (v : Vector n A) (a : A),
    traverse f (vcons n a v) =
      pure (vcons n) <⋆> f a <⋆> traverse f v.forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B) (v : Vector n A) (a : A),
traverse f (vcons n a v) =
pure (vcons n) <⋆> f a <⋆> traverse f v
Proof.forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B) (v : Vector n A) (a : A),
traverse f (vcons n a v) =
pure (vcons n) <⋆> f a <⋆> traverse f v
  intros.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
v: Vector n A
a: A
traverse f (vcons n a v) =
pure (vcons n) <⋆> f a <⋆> traverse f v
  destruct v.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
traverse f
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) =
pure (vcons n) <⋆> f a <⋆>
traverse f
  (exist (fun l : list A => length l = n) x e)
  unfold vcons.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
traverse f
  (exist (fun l : list A => length l = S n) (a :: x)
     (args_eq_1 S e)) =
pure
  (fun (a : B) (v : Vector n B) =>
   let (x, p) := v in
   exist (fun l : list B => length l = S n) (a :: x)
     (args_eq_1 S p)) <⋆> f a <⋆>
traverse f
  (exist (fun l : list A => length l = n) x e)
  rewrite traverse_Vector_rw_lemma.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
pure (vcons n) <⋆> f a <⋆>
traverse f
  (exist (fun l : list A => length l = n) x
     (S_uncons (args_eq_1 S e))) =
pure
  (fun (a : B) (v : Vector n B) =>
   let (x, p) := v in
   exist (fun l : list B => length l = S n) (a :: x)
     (args_eq_1 S p)) <⋆> f a <⋆>
traverse f
  (exist (fun l : list A => length l = n) x e)
  fequal.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
traverse f
  (exist (fun l : list A => length l = n) x
     (S_uncons (args_eq_1 S e))) =
traverse f
  (exist (fun l : list A => length l = n) x e)
  fequal.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
exist (fun l : list A => length l = n) x
  (S_uncons (args_eq_1 S e)) =
exist (fun l : list A => length l = n) x e
  fequal.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
x: list A
e: length x = n
a: A
S_uncons (args_eq_1 S e) = e
  apply proof_irrelevance.
Qed.

(** *** Rewriting rules for foldmap *)
(******************************************************************************)
Lemma mapReduce_Vector_vnil:
  forall (M : Type) `{Monoid_op M} `{Monoid_unit M}
    {A : Type} (f : A -> M) (v: Vector 0 A),
    mapReduce f v = Ƶ.forall (M : Type) (H : Monoid_op M)
  (H0 : Monoid_unit M) (A : Type) (f : A -> M)
  (v : Vector 0 A), mapReduce f v = Ƶ
Proof.forall (M : Type) (H : Monoid_op M)
  (H0 : Monoid_unit M) (A : Type) (f : A -> M)
  (v : Vector 0 A), mapReduce f v = Ƶ
  intros.M: Type
H: Monoid_op M
H0: Monoid_unit M
A: Type
f: A -> M
v: Vector 0 A
mapReduce f v = Ƶ
  rewrite (Vector_nil_eq v).M: Type
H: Monoid_op M
H0: Monoid_unit M
A: Type
f: A -> M
v: Vector 0 A
mapReduce f vnil = Ƶ
  reflexivity.
Qed.

Lemma mapReduce_Vector_vcons:
  forall {M: Type} `{op: Monoid_op M} `{unit: Monoid_unit M}
    `{! Monoid M}
    (n : nat) {A : Type} (f : A -> M) (v : Vector n A) (a : A),
    mapReduce f (vcons n a v) = f a ● mapReduce f v.forall (M : Type) (op : Monoid_op M)
  (unit : Monoid_unit M),
Monoid M ->
forall (n : nat) (A : Type) (f : A -> M)
  (v : Vector n A) (a : A),
mapReduce f (vcons n a v) = f a ● mapReduce f v
Proof.forall (M : Type) (op : Monoid_op M)
  (unit : Monoid_unit M),
Monoid M ->
forall (n : nat) (A : Type) (f : A -> M)
  (v : Vector n A) (a : A),
mapReduce f (vcons n a v) = f a ● mapReduce f v
  intros.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
mapReduce f (vcons n a v) = f a ● mapReduce f v
  unfold mapReduce.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
traverse f (vcons n a v) = f a ● traverse f v
  rewrite traverse_Vector_vcons.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
pure (vcons n) <⋆> f a <⋆> traverse f v =
f a ● traverse f v
  unfold_ops @Pure_const.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
Ƶ <⋆> f a <⋆> traverse f v = f a ● traverse f v
  unfold_ops @Map_const.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
Ƶ <⋆> f a <⋆> traverse f v = f a ● traverse f v
  unfold ap.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
map (fun '(f, a) => f a)
  (map (fun '(f, a) => f a) (Ƶ ⊗ f a) ⊗ traverse f v) =
f a ● traverse f v
  unfold_ops @Mult_const.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
(Ƶ ● f a) ● traverse f v = f a ● traverse f v
  rewrite monoid_id_l.M: Type
op: Monoid_op M
unit: Monoid_unit M
Monoid0: Monoid M
n: nat
A: Type
f: A -> M
v: Vector n A
a: A
f a ● traverse f v = f a ● traverse f v
  reflexivity.
Qed.

Corollary plength_Vector {n: nat} {A: Type}:
  forall (v: Vector n A), plength v = n.n: nat
A: Type
forall v : Vector n A, plength v = n
Proof.n: nat
A: Type
forall v : Vector n A, plength v = n
  intros.n: nat
A: Type
v: Vector n A
plength v = n
  induction v using Vector_induction.n: nat
A: Type
plength vnil = 0
n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: plength v = m
plength (vcons m a v) = S m
  -n: nat
A: Type
plength vnil = 0 reflexivity.
  -n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: plength v = m
plength (vcons m a v) = S m unfold plength.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: plength v = m
mapReduce (fun _ : A => 1) (vcons m a v) = S m
    rewrite (mapReduce_Vector_vcons).n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: plength v = m
1 ● mapReduce (fun _ : A => 1) v = S m
    auto.
Qed.


(** ** Relation between <<Vector_to_list>> and <<tolist>> *)
(******************************************************************************)
Lemma Vector_to_list_tolist {A}: forall (n: nat) (v: Vector n A),
    Vector_to_list _ v = tolist v.A: Type
forall (n : nat) (v : Vector n A),
Vector_to_list A v = tolist v
Proof.A: Type
forall (n : nat) (v : Vector n A),
Vector_to_list A v = tolist v
  intros.A: Type
n: nat
v: Vector n A
Vector_to_list A v = tolist v
  rewrite tolist_to_mapReduce.A: Type
n: nat
v: Vector n A
Vector_to_list A v = mapReduce ret v
  induction v using Vector_induction.A: Type
n: nat
Vector_to_list A vnil = mapReduce ret vnil
A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_to_list A v = mapReduce ret v
Vector_to_list A (vcons m a v) =
mapReduce ret (vcons m a v)
  -A: Type
n: nat
Vector_to_list A vnil = mapReduce ret vnil rewrite Vector_to_list_vnil.A: Type
n: nat
nil = mapReduce ret vnil
    rewrite mapReduce_Vector_vnil.A: Type
n: nat
nil = Ƶ
    reflexivity.
  -A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_to_list A v = mapReduce ret v
Vector_to_list A (vcons m a v) =
mapReduce ret (vcons m a v) rewrite Vector_to_list_vcons.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_to_list A v = mapReduce ret v
a :: Vector_to_list A v = mapReduce ret (vcons m a v)
    rewrite mapReduce_Vector_vcons.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_to_list A v = mapReduce ret v
a :: Vector_to_list A v = ret a ● mapReduce ret v
    rewrite IHv.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_to_list A v = mapReduce ret v
a :: mapReduce ret v = ret a ● mapReduce ret v
    reflexivity.
Qed.

(** ** Traversing over similar vectors *)
(******************************************************************************)
Lemma map_sim_function_traverse_Vector
  `{Applicative G} (A B: Type) (n m: nat):
  forall (f: A -> G B) (Heq: n = m) (v1: Vector n A) (v2: Vector m A),
    v1 ~~ v2 ->
    map (coerce_Vector_length Heq) (traverse f v1) =
      (traverse f v2).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n, m: nat
forall (f : A -> G B) (Heq : n = m) (v1 : Vector n A)
  (v2 : Vector m A),
v1 ~~ v2 ->
map (coerce_Vector_length Heq) (traverse f v1) =
traverse f v2

Proof.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n, m: nat
forall (f : A -> G B) (Heq : n = m) (v1 : Vector n A)
  (v2 : Vector m A),
v1 ~~ v2 ->
map (coerce_Vector_length Heq) (traverse f v1) =
traverse f v2
  introv Hsim.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n, m: nat
f: A -> G B
Heq: n = m
v1: Vector n A
v2: Vector m A
Hsim: v1 ~~ v2
map (coerce_Vector_length Heq) (traverse f v1) =
traverse f v2
  destruct Heq.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n: nat
f: A -> G B
v1, v2: Vector n A
Hsim: v1 ~~ v2
map (coerce_Vector_length eq_refl) (traverse f v1) =
traverse f v2
  rewrite coerce_Vector_eq_refl_pf.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n: nat
f: A -> G B
v1, v2: Vector n A
Hsim: v1 ~~ v2
map id (traverse f v1) = traverse f v2
  rewrite (fun_map_id).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n: nat
f: A -> G B
v1, v2: Vector n A
Hsim: v1 ~~ v2
id (traverse f v1) = traverse f v2
  rewrite (Vector_sim_eq _ _ Hsim).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
n: nat
f: A -> G B
v1, v2: Vector n A
Hsim: v1 ~~ v2
id (traverse f v2) = traverse f v2
  reflexivity.
Qed.

(** ** Compatibility with <<map>> *)
(******************************************************************************)
#[export] Instance Compat_Map_Traverse_Vector {n: nat}:
  Compat_Map_Traverse (Vector n).n: nat
Compat_Map_Traverse (Vector n)
Proof.n: nat
Compat_Map_Traverse (Vector n)
  hnf.n: nat
Map_Vector n =
DerivedOperations.Map_Traverse (Vector n) ext A B f v.n: nat
A, B: Type
f: A -> B
v: Vector n A
Map_Vector n A B f v =
DerivedOperations.Map_Traverse (Vector n) A B f v
  change_left (map (F := Vector n) f v).n: nat
A, B: Type
f: A -> B
v: Vector n A
map f v =
DerivedOperations.Map_Traverse (Vector n) A B f v
  change_right (traverse (G := fun A => A) (T := Vector n) f v).n: nat
A, B: Type
f: A -> B
v: Vector n A
map f v = traverse f v
  induction v using Vector_induction.n: nat
A, B: Type
f: A -> B
map f vnil = traverse f vnil
n: nat
A, B: Type
f: A -> B
a: A
m: nat
v: Vector m A
IHv: map f v = traverse f v
map f (vcons m a v) = traverse f (vcons m a v)
  -n: nat
A, B: Type
f: A -> B
map f vnil = traverse f vnil rewrite map_Vector_vnil.n: nat
A, B: Type
f: A -> B
vnil = traverse f vnil
    rewrite traverse_Vector_vnil.n: nat
A, B: Type
f: A -> B
vnil = pure vnil
    reflexivity.
  -n: nat
A, B: Type
f: A -> B
a: A
m: nat
v: Vector m A
IHv: map f v = traverse f v
map f (vcons m a v) = traverse f (vcons m a v) rewrite map_Vector_vcons.n: nat
A, B: Type
f: A -> B
a: A
m: nat
v: Vector m A
IHv: map f v = traverse f v
vcons m (f a) (map f v) = traverse f (vcons m a v)
    rewrite traverse_Vector_vcons.n: nat
A, B: Type
f: A -> B
a: A
m: nat
v: Vector m A
IHv: map f v = traverse f v
vcons m (f a) (map f v) =
pure (vcons m) <⋆> f a <⋆> traverse f v
    rewrite IHv.n: nat
A, B: Type
f: A -> B
a: A
m: nat
v: Vector m A
IHv: map f v = traverse f v
vcons m (f a) (traverse f v) =
pure (vcons m) <⋆> f a <⋆> traverse f v
    reflexivity.
Qed.

(** ** Miscellaneous *)
(******************************************************************************)
 Lemma traverse_Vector_contents:
   forall (n : nat) (G : Type -> Type) `{Map G} `{Pure G} `{Mult G}
     {A B : Type} (f : A -> G B)
     `{! Applicative G}
     (v : Vector n A),
     map (F := G)
             (@proj1_sig (list B) (fun l => length l = n))
             (traverse (T := Vector n) f v) =
       traverse f (proj1_sig v).forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B),
Applicative G ->
forall v : Vector n A,
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f v) = traverse f (proj1_sig v)
 Proof.forall (n : nat) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A B : Type)
  (f : A -> G B),
Applicative G ->
forall v : Vector n A,
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f v) = traverse f (proj1_sig v)
   intros.n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
v: Vector n A
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f v) = traverse f (proj1_sig v)
   destruct v as [vlist vlen].n: nat
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
vlist: list A
vlen: length vlist = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n) vlist
        vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n) vlist
        vlen))
   generalize dependent n.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
vlist: list A
forall (n : nat) (vlen : length vlist = n),
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n) vlist
        vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n) vlist
        vlen))
   induction vlist; intros n vlen.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
n: nat
vlen: length nil = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n) nil vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n) nil vlen))
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
n: nat
vlen: length (a :: vlist) = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        (a :: vlist) vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        (a :: vlist) vlen))
   -G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
n: nat
vlen: length nil = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n) nil vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n) nil vlen)) cbn.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
n: nat
vlen: length nil = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (pure
     (exist (fun l : list B => length l = n) nil vlen)) =
pure nil rewrite app_pure_natural.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
n: nat
vlen: length nil = n
pure
  (proj1_sig
     (exist (fun l : list B => length l = n) nil vlen)) =
pure nil reflexivity.
   -G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
n: nat
vlen: length (a :: vlist) = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        (a :: vlist) vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        (a :: vlist) vlen)) cbn.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
n: nat
vlen: length (a :: vlist) = n
map (proj1_sig (P:=fun l : list B => length l = n))
  (match
     n return (S (length vlist) = n -> G (Vector n B))
   with
   | 0 => zero_not_S ○ eq_sym (y:=0)
   | S m =>
       fun vlen' : S (length vlist) = S m =>
       pure (vcons m) <⋆> f a <⋆>
       (fix go (vl : list A) (n : nat) {struct vl} :
            length vl = n -> G (Vector n B) :=
          match
            vl as vl0
            return (length vl0 = n -> G (Vector n B))
          with
          | nil =>
              pure
              ○ exist (fun l : list B => length l = n)
                  nil
          | a :: rest =>
              fun vlen : S (length rest) = n =>
              match
                n as n0
                return
                  (S (length rest) = n0 ->
                   G (Vector n0 B))
              with
              | 0 => zero_not_S ○ eq_sym (y:=0)
              | S m0 =>
                  fun vlen'0 : S (length rest) = S m0
                  =>
                  pure (vcons m0) <⋆> f a <⋆>
                  go rest m0 (S_uncons vlen'0)
              end vlen
          end) vlist m (S_uncons vlen')
   end vlen) = pure cons <⋆> f a <⋆> traverse f vlist destruct n.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
vlen: length (a :: vlist) = 0
map (proj1_sig (P:=fun l : list B => length l = 0))
  (zero_not_S (eq_sym vlen)) =
pure cons <⋆> f a <⋆> traverse f vlist
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
n: nat
vlen: length (a :: vlist) = S n
map (proj1_sig (P:=fun l : list B => length l = S n))
  (pure (vcons n) <⋆> f a <⋆>
   (fix go (vl : list A) (n : nat) {struct vl} :
        length vl = n -> G (Vector n B) :=
      match
        vl as vl0
        return (length vl0 = n -> G (Vector n B))
      with
      | nil =>
          pure
          ○ exist (fun l : list B => length l = n) nil
      | a :: rest =>
          fun vlen : S (length rest) = n =>
          match
            n as n0
            return
              (S (length rest) = n0 -> G (Vector n0 B))
          with
          | 0 => zero_not_S ○ eq_sym (y:=0)
          | S m =>
              fun vlen' : S (length rest) = S m =>
              pure (vcons m) <⋆> f a <⋆>
              go rest m (S_uncons vlen')
          end vlen
      end) vlist n (S_uncons vlen)) =
pure cons <⋆> f a <⋆> traverse f vlist
     +G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
vlen: length (a :: vlist) = 0
map (proj1_sig (P:=fun l : list B => length l = 0))
  (zero_not_S (eq_sym vlen)) =
pure cons <⋆> f a <⋆> traverse f vlist false.
     +G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse f
     (exist (fun l : list A => length l = n)
        vlist vlen)) =
traverse f
  (proj1_sig
     (exist (fun l : list A => length l = n)
        vlist vlen))
n: nat
vlen: length (a :: vlist) = S n
map (proj1_sig (P:=fun l : list B => length l = S n))
  (pure (vcons n) <⋆> f a <⋆>
   (fix go (vl : list A) (n : nat) {struct vl} :
        length vl = n -> G (Vector n B) :=
      match
        vl as vl0
        return (length vl0 = n -> G (Vector n B))
      with
      | nil =>
          pure
          ○ exist (fun l : list B => length l = n) nil
      | a :: rest =>
          fun vlen : S (length rest) = n =>
          match
            n as n0
            return
              (S (length rest) = n0 -> G (Vector n0 B))
          with
          | 0 => zero_not_S ○ eq_sym (y:=0)
          | S m =>
              fun vlen' : S (length rest) = S m =>
              pure (vcons m) <⋆> f a <⋆>
              go rest m (S_uncons vlen')
          end vlen
      end) vlist n (S_uncons vlen)) =
pure cons <⋆> f a <⋆> traverse f vlist cbn in IHvlist.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
map (proj1_sig (P:=fun l : list B => length l = S n))
  (pure (vcons n) <⋆> f a <⋆>
   (fix go (vl : list A) (n : nat) {struct vl} :
        length vl = n -> G (Vector n B) :=
      match
        vl as vl0
        return (length vl0 = n -> G (Vector n B))
      with
      | nil =>
          pure
          ○ exist (fun l : list B => length l = n) nil
      | a :: rest =>
          fun vlen : S (length rest) = n =>
          match
            n as n0
            return
              (S (length rest) = n0 -> G (Vector n0 B))
          with
          | 0 => zero_not_S ○ eq_sym (y:=0)
          | S m =>
              fun vlen' : S (length rest) = S m =>
              pure (vcons m) <⋆> f a <⋆>
              go rest m (S_uncons vlen')
          end vlen
      end) vlist n (S_uncons vlen)) =
pure cons <⋆> f a <⋆> traverse f vlist
       rewrite <- (IHvlist n (S_uncons vlen)).G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
map (proj1_sig (P:=fun l : list B => length l = S n))
  (pure (vcons n) <⋆> f a <⋆>
   (fix go (vl : list A) (n : nat) {struct vl} :
        length vl = n -> G (Vector n B) :=
      match
        vl as vl0
        return (length vl0 = n -> G (Vector n B))
      with
      | nil =>
          pure
          ○ exist (fun l : list B => length l = n) nil
      | a :: rest =>
          fun vlen : S (length rest) = n =>
          match
            n as n0
            return
              (S (length rest) = n0 -> G (Vector n0 B))
          with
          | 0 => zero_not_S ○ eq_sym (y:=0)
          | S m =>
              fun vlen' : S (length rest) = S m =>
              pure (vcons m) <⋆> f a <⋆>
              go rest m (S_uncons vlen')
          end vlen
      end) vlist n (S_uncons vlen)) =
pure cons <⋆> f a <⋆>
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist (S_uncons vlen))
       rewrite map_ap.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
map
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n)))
  (pure (vcons n) <⋆> f a) <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
pure cons <⋆> f a <⋆>
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist (S_uncons vlen))
       rewrite map_ap.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
map
  (compose
     (compose
        (proj1_sig
           (P:=fun l : list B => length l = S n))))
  (pure (vcons n)) <⋆> f a <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
pure cons <⋆> f a <⋆>
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist (S_uncons vlen))
       rewrite app_pure_natural.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) <⋆> f a <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
pure cons <⋆> f a <⋆>
map (proj1_sig (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist (S_uncons vlen))
       rewrite <- ap_map.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) <⋆> f a <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
map
  (precompose
     (proj1_sig (P:=fun l : list B => length l = n)))
  (pure cons <⋆> f a) <⋆>
traverse_Vector_core f vlist (S_uncons vlen)
       rewrite map_ap.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) <⋆> f a <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
map
  (compose
     (precompose
        (proj1_sig (P:=fun l : list B => length l = n))))
  (pure cons) <⋆> f a <⋆>
traverse_Vector_core f vlist (S_uncons vlen)
       rewrite app_pure_natural.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) <⋆> f a <⋆>
(fix go (vl : list A) (n : nat) {struct vl} :
     length vl = n -> G (Vector n B) :=
   match
     vl as vl0
     return (length vl0 = n -> G (Vector n B))
   with
   | nil =>
       pure
       ○ exist (fun l : list B => length l = n) nil
   | a :: rest =>
       fun vlen : S (length rest) = n =>
       match
         n as n0
         return
           (S (length rest) = n0 -> G (Vector n0 B))
       with
       | 0 => zero_not_S ○ eq_sym (y:=0)
       | S m =>
           fun vlen' : S (length rest) = S m =>
           pure (vcons m) <⋆> f a <⋆>
           go rest m (S_uncons vlen')
       end vlen
   end) vlist n (S_uncons vlen) =
pure
  (precompose
     (proj1_sig (P:=fun l : list B => length l = n))
   ∘ cons) <⋆> f a <⋆>
traverse_Vector_core f vlist (S_uncons vlen)
       fequal.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) <⋆> f a =
pure
  (precompose
     (proj1_sig (P:=fun l : list B => length l = n))
   ∘ cons) <⋆> f a
       fequal.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
pure
  (compose
     (proj1_sig (P:=fun l : list B => length l = S n))
   ∘ vcons n) =
pure
  (precompose
     (proj1_sig (P:=fun l : list B => length l = n))
   ∘ cons)
       fequal.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
compose
  (proj1_sig (P:=fun l : list B => length l = S n))
∘ vcons n =
precompose
  (proj1_sig (P:=fun l : list B => length l = n))
∘ cons
       ext b vb.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
b: B
vb: Vector n B
(compose
   (proj1_sig (P:=fun l : list B => length l = S n))
 ∘ vcons n) b vb =
(precompose
   (proj1_sig (P:=fun l : list B => length l = n))
 ∘ cons) b vb
       unfold compose, precompose.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
b: B
vb: Vector n B
proj1_sig (vcons n b vb) = b :: proj1_sig vb
       rewrite proj_vcons.G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, B: Type
f: A -> G B
Applicative0: Applicative G
a: A
vlist: list A
IHvlist: forall (n : nat) (vlen : length vlist = n),
map
  (proj1_sig
     (P:=fun l : list B => length l = n))
  (traverse_Vector_core f vlist vlen) =
traverse f vlist
n: nat
vlen: length (a :: vlist) = S n
b: B
vb: Vector n B
b :: proj1_sig vb = b :: proj1_sig vb
       reflexivity.
 Qed.

Lemma traverse_Vector_coerce:
  forall (n m : nat) `{Applicative G}
    {A B : Type} (f : A -> G B)
    (Heq: n = m) (v : Vector n A),
    traverse f v = map (F := G) (fun v => coerce (eq_sym Heq) in v)
                       (traverse f (coerce Heq in v) : G (Vector m B)).forall (n m : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B) (Heq : n = m)
  (v : Vector n A),
traverse f v =
map (fun v0 : Vector m B => coerce eq_sym Heq in v0)
  (traverse f (coerce Heq in v) : G (Vector m B))
Proof.forall (n m : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B) (Heq : n = m)
  (v : Vector n A),
traverse f v =
map (fun v0 : Vector m B => coerce eq_sym Heq in v0)
  (traverse f (coerce Heq in v) : G (Vector m B))
  intros.n, m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
Heq: n = m
v: Vector n A
traverse f v =
map (fun v : Vector m B => coerce eq_sym Heq in v)
  (traverse f (coerce Heq in v) : G (Vector m B))
  subst.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
traverse f v =
map (fun v : Vector m B => coerce eq_sym eq_refl in v)
  (traverse f (coerce eq_refl in v))
  replace (fun v0 : Vector m B => coerce eq_sym eq_refl in v0)
    with (@id (Vector m B)).m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
traverse f v =
map id (traverse f (coerce eq_refl in v))
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id =
(fun v0 : Vector m B => coerce eq_sym eq_refl in v0)
  rewrite (fun_map_id).m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
traverse f v = id (traverse f (coerce eq_refl in v))
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id =
(fun v0 : Vector m B => coerce eq_sym eq_refl in v0)
  replace (coerce eq_refl in v) with v.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
traverse f v = id (traverse f v)
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id =
(fun v0 : Vector m B => coerce eq_sym eq_refl in v0)
  reflexivity.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id =
(fun v0 : Vector m B => coerce eq_sym eq_refl in v0)
  -m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v destruct v.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list A
e: length x = m
exist (fun l : list A => length l = m) x e =
coerce eq_refl
in exist (fun l : list A => length l = m) x e
    destruct e.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list A
exist (fun l : list A => length l = length x) x
  eq_refl =
coerce eq_refl
in exist (fun l : list A => length l = length x) x
     eq_refl
    reflexivity.
  -m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id =
(fun v0 : Vector m B => coerce eq_sym eq_refl in v0) ext w.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
w: Vector m B
id w = coerce eq_sym eq_refl in w
    destruct w.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
x: list B
e: length x = m
id (exist (fun l : list B => length l = m) x e) =
coerce eq_sym eq_refl
in exist (fun l : list B => length l = m) x e
    destruct e.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list B
v: Vector (length x) A
id
  (exist (fun l : list B => length l = length x) x
     eq_refl) =
coerce eq_sym eq_refl
in exist (fun l : list B => length l = length x) x
     eq_refl
    reflexivity.
Qed.

Lemma traverse_Vector_coerce_natural:
  forall (n m : nat) `{Applicative G}
    {A B : Type} (f : A -> G B)
    (Heq: n = m) (v : Vector n A),
    map (F := G) (fun v => coerce Heq in v)
      (traverse f v) =
      (traverse f (coerce Heq in v) : G (Vector m B)).forall (n m : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B) (Heq : n = m)
  (v : Vector n A),
map (fun v0 : Vector n B => coerce Heq in v0)
  (traverse f v) =
(traverse f (coerce Heq in v) : G (Vector m B))
Proof.forall (n m : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B) (Heq : n = m)
  (v : Vector n A),
map (fun v0 : Vector n B => coerce Heq in v0)
  (traverse f v) =
(traverse f (coerce Heq in v) : G (Vector m B))
  intros.n, m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
Heq: n = m
v: Vector n A
map (fun v : Vector n B => coerce Heq in v)
  (traverse f v) =
(traverse f (coerce Heq in v) : G (Vector m B))
  subst.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
map (fun v : Vector m B => coerce eq_refl in v)
  (traverse f v) = traverse f (coerce eq_refl in v)
  replace (fun v0 : Vector m B => coerce eq_refl in v0)
    with (@id (Vector m B)).m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
map id (traverse f v) =
traverse f (coerce eq_refl in v)
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id = (fun v0 : Vector m B => coerce eq_refl in v0)
  rewrite (fun_map_id).m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id (traverse f v) = traverse f (coerce eq_refl in v)
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id = (fun v0 : Vector m B => coerce eq_refl in v0)
  replace (coerce eq_refl in v) with v.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id (traverse f v) = traverse f v
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id = (fun v0 : Vector m B => coerce eq_refl in v0)
  reflexivity.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v
m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id = (fun v0 : Vector m B => coerce eq_refl in v0)
  -m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
v = coerce eq_refl in v destruct v.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list A
e: length x = m
exist (fun l : list A => length l = m) x e =
coerce eq_refl
in exist (fun l : list A => length l = m) x e
    destruct e.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list A
exist (fun l : list A => length l = length x) x
  eq_refl =
coerce eq_refl
in exist (fun l : list A => length l = length x) x
     eq_refl
    reflexivity.
  -m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
id = (fun v0 : Vector m B => coerce eq_refl in v0) ext w.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
w: Vector m B
id w = coerce eq_refl in w
    destruct w.m: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v: Vector m A
x: list B
e: length x = m
id (exist (fun l : list B => length l = m) x e) =
coerce eq_refl
in exist (fun l : list B => length l = m) x e
    destruct e.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
x: list B
v: Vector (length x) A
id
  (exist (fun l : list B => length l = length x) x
     eq_refl) =
coerce eq_refl
in exist (fun l : list B => length l = length x) x
     eq_refl
    reflexivity.
Qed.

Lemma traverse_Vector_indep:
  forall (n : nat) `{Applicative G}
    {A B : Type} (f : A -> G B),
    @Vector_fun_indep n A (G (Vector n B)) (traverse f).forall (n : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B),
Vector_fun_indep (traverse f)
Proof.forall (n : nat) (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B),
Vector_fun_indep (traverse f)
  intros.n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
Vector_fun_indep (traverse f)
  unfold Vector_fun_indep.n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
traverse f ~!~ traverse f
  split.n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
n = n
n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
forall v1 v2 : Vector n A,
v1 ~~ v2 -> traverse f v1 = traverse f v2
  -n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
n = n reflexivity.
  -n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
forall v1 v2 : Vector n A,
v1 ~~ v2 -> traverse f v1 = traverse f v2 intros.n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
traverse f v1 = traverse f v2
    pose (Ind:= Vector_induction2_core
                  A
                  (fun x v1 v2 =>
                     v1 ~~ v2 ->
                     traverse (G := G) (T := Vector x) f v1 =
                       traverse (G := G) (T := Vector x) f v2)).n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
traverse f v1 = traverse f v2
    apply Ind.n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
vnil ~~ vnil -> traverse f vnil = traverse f vnil
n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
(v1 ~~ v2 -> traverse f v1 = traverse f v2) ->
vcons m a1 v1 ~~ vcons m a2 v2 ->
traverse f (vcons m a1 v1) =
traverse f (vcons m a2 v2)
n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
v1 ~~ v2
    +n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
vnil ~~ vnil -> traverse f vnil = traverse f vnil reflexivity.
    +n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
(v1 ~~ v2 -> traverse f v1 = traverse f v2) ->
vcons m a1 v1 ~~ vcons m a2 v2 ->
traverse f (vcons m a1 v1) =
traverse f (vcons m a2 v2) clear.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
forall (m : nat) (a1 a2 : A) (v1 v2 : Vector m A),
(v1 ~~ v2 -> traverse f v1 = traverse f v2) ->
vcons m a1 v1 ~~ vcons m a2 v2 ->
traverse f (vcons m a1 v1) =
traverse f (vcons m a2 v2)
      intros n a1 a2 v1 v2 Hsim Heq.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
traverse f (vcons n a1 v1) =
traverse f (vcons n a2 v2)
      assert (Hsim_: a1 = a2 /\ v1 ~~ v2).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
a1 = a2 /\ v1 ~~ v2
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Hsim_: a1 = a2 /\ v1 ~~ v2
traverse f (vcons n a1 v1) =
traverse f (vcons n a2 v2)
      {G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
a1 = a2 /\ v1 ~~ v2 unfold Vector_sim in Heq.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: proj1_sig (vcons n a1 v1) =
proj1_sig (vcons n a2 v2)
a1 = a2 /\ v1 ~~ v2
        do 2 rewrite proj_vcons in Heq.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
a1 = a2 /\ v1 ~~ v2
        inversion Heq.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
H0: a1 = a2
H1: proj1_sig v1 = proj1_sig v2
a2 = a2 /\ v1 ~~ v2
        auto. }G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Hsim_: a1 = a2 /\ v1 ~~ v2
traverse f (vcons n a1 v1) =
traverse f (vcons n a2 v2)
      destruct Hsim_ as [Ha Hcons].G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Ha: a1 = a2
Hcons: v1 ~~ v2
traverse f (vcons n a1 v1) =
traverse f (vcons n a2 v2)
      inversion Ha.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Ha: a1 = a2
Hcons: v1 ~~ v2
H: a1 = a2
traverse f (vcons n a2 v1) =
traverse f (vcons n a2 v2)
      do 2 rewrite traverse_Vector_vcons.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Ha: a1 = a2
Hcons: v1 ~~ v2
H: a1 = a2
pure (vcons n) <⋆> f a2 <⋆> traverse f v1 =
pure (vcons n) <⋆> f a2 <⋆> traverse f v2
      rewrite (Hsim Hcons).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
A, B: Type
f: A -> G B
n: nat
a1, a2: A
v1, v2: Vector n A
Hsim: v1 ~~ v2 -> traverse f v1 = traverse f v2
Heq: vcons n a1 v1 ~~ vcons n a2 v2
Ha: a1 = a2
Hcons: v1 ~~ v2
H: a1 = a2
pure (vcons n) <⋆> f a2 <⋆> traverse f v2 =
pure (vcons n) <⋆> f a2 <⋆> traverse f v2
      reflexivity.
    +n: nat
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
v1, v2: Vector n A
H0: v1 ~~ v2
Ind:= Vector_induction2_core A
  (fun (x : nat) (v1 v2 : Vector x A) =>
   v1 ~~ v2 -> traverse f v1 = traverse f v2): (fun (x : nat) (v1 v2 : Vector x A) =>
 v1 ~~ v2 -> traverse f v1 = traverse f v2) 0
  vnil vnil ->
(forall (m : nat) (a1 a2 : A)
   (v1 v2 : Vector m A),
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4) m
   v1 v2 ->
 (fun (x : nat) (v3 v4 : Vector x A) =>
  v3 ~~ v4 -> traverse f v3 = traverse f v4)
   (S m) (vcons m a1 v1) 
   (vcons m a2 v2)) ->
forall (m : nat) (v1 v2 : Vector m A),
(fun (x : nat) (v3 v4 : Vector x A) =>
 v3 ~~ v4 -> traverse f v3 = traverse f v4) m v1
  v2
v1 ~~ v2 assumption.
Qed.

(** ** Traversal laws *)
(******************************************************************************)
Lemma traverse_Vector_id `{v : Vector n A}:
  traverse (G := fun A => A) id v = v.n: nat
A: Type
v: Vector n A
traverse id v = v
Proof.n: nat
A: Type
v: Vector n A
traverse id v = v
  induction v using Vector_induction.n: nat
A: Type
traverse id vnil = vnil
n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: traverse id v = v
traverse id (vcons m a v) = vcons m a v
  -n: nat
A: Type
traverse id vnil = vnil rewrite traverse_Vector_vnil.n: nat
A: Type
pure vnil = vnil
    reflexivity.
  -n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: traverse id v = v
traverse id (vcons m a v) = vcons m a v rewrite traverse_Vector_vcons.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: traverse id v = v
pure (vcons m) <⋆> id a <⋆> traverse id v =
vcons m a v
    rewrite IHv.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: traverse id v = v
pure (vcons m) <⋆> id a <⋆> v = vcons m a v
    reflexivity.
Qed.

Lemma trf_traverse_traverse_Vector:
  forall (G1 : Type -> Type)
    (H0 : Map G1) (H1 : Pure G1)
    (H2 : Mult G1),
    Applicative G1 ->
    forall (G2 : Type -> Type)
      (H4 : Map G2) (H5 : Pure G2)
      (H6 : Mult G2),
      Applicative G2 ->
      forall (A B C : Type) (g : B -> G2 C) (f : A -> G1 B),
      forall `{v : Vector n A},
        (map (traverse (G := G2) g) ∘ traverse (G := G1) f) v =
          traverse (T := Vector n) (G := G1 ∘ G2) (kc2 g f) v.forall (G1 : Type -> Type) (H0 : Map G1)
  (H1 : Pure G1) (H2 : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (H4 : Map G2)
  (H5 : Pure G2) (H6 : Mult G2),
Applicative G2 ->
forall (A B C : Type) (g : B -> G2 C) (f : A -> G1 B)
  (n : nat) (v : Vector n A),
(map (traverse g) ∘ traverse f) v =
traverse (kc2 g f) v
Proof.forall (G1 : Type -> Type) (H0 : Map G1)
  (H1 : Pure G1) (H2 : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (H4 : Map G2)
  (H5 : Pure G2) (H6 : Mult G2),
Applicative G2 ->
forall (A B C : Type) (g : B -> G2 C) (f : A -> G1 B)
  (n : nat) (v : Vector n A),
(map (traverse g) ∘ traverse f) v =
traverse (kc2 g f) v
  intros.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
v: Vector n A
(map (traverse g) ∘ traverse f) v =
traverse (kc2 g f) v
  unfold compose at 1.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
v: Vector n A
map (traverse g) (traverse f v) = traverse (kc2 g f) v
  induction v using Vector_induction.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
map (traverse g) (traverse f vnil) =
traverse (kc2 g f) vnil
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
map (traverse g) (traverse f (vcons m a v)) =
traverse (kc2 g f) (vcons m a v)
  -G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
map (traverse g) (traverse f vnil) =
traverse (kc2 g f) vnil do 2 rewrite traverse_Vector_vnil.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
map (traverse g) (pure vnil) = pure vnil
    rewrite app_pure_natural.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
pure (traverse g vnil) = pure vnil
    rewrite traverse_Vector_vnil.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
pure (pure vnil) = pure vnil
    reflexivity.
  -G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
map (traverse g) (traverse f (vcons m a v)) =
traverse (kc2 g f) (vcons m a v) rewrite traverse_Vector_vcons.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
map (traverse g)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
traverse (kc2 g f) (vcons m a v)
    rewrite map_ap.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
map (compose (traverse g)) (pure (vcons m) <⋆> f a) <⋆>
traverse f v = traverse (kc2 g f) (vcons m a v)
    rewrite map_ap.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
map (compose (compose (traverse g))) (pure (vcons m)) <⋆>
f a <⋆> traverse f v =
traverse (kc2 g f) (vcons m a v)
    rewrite app_pure_natural.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v = traverse (kc2 g f) (vcons m a v)
    rewrite traverse_Vector_vcons.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure (vcons m) <⋆> kc2 g f a <⋆> traverse (kc2 g f) v
    rewrite <- IHv.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure (vcons m) <⋆> kc2 g f a <⋆>
map (traverse g) (traverse f v)
    rewrite (ap_compose2 G2 G1).G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
map (ap G2) (pure (vcons m) <⋆> kc2 g f a) <⋆>
map (traverse g) (traverse f v)
    rewrite (ap_compose2 G2 G1).G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
map (ap G2)
  (map (ap G2) (pure (vcons m)) <⋆> kc2 g f a) <⋆>
map (traverse g) (traverse f v)
    unfold_ops @Pure_compose.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
map (ap G2)
  (map (ap G2) (pure (pure (vcons m))) <⋆> kc2 g f a) <⋆>
map (traverse g) (traverse f v)
    repeat rewrite map_ap;
      rewrite (app_pure_natural (G := G1));
      rewrite <- ap_map;
      repeat rewrite map_ap;
      rewrite (app_pure_natural (G := G1)).G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
map (compose (precompose (traverse g)))
  (pure (ap G2 ∘ ap G2 (pure (vcons m)))) <⋆>
kc2 g f a <⋆> traverse f v
    rewrite app_pure_natural.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure
  (precompose (traverse g)
   ∘ (ap G2 ∘ ap G2 (pure (vcons m)))) <⋆> kc2 g f a <⋆>
traverse f v
    unfold kc2.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure
  (precompose (traverse g)
   ∘ (ap G2 ∘ ap G2 (pure (vcons m)))) <⋆>
(map g ∘ f) a <⋆> traverse f v
    unfold compose at 5.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure
  (precompose (traverse g)
   ∘ (ap G2 ∘ ap G2 (pure (vcons m)))) <⋆> map g (f a) <⋆>
traverse f v
    rewrite <- ap_map.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
map (precompose g)
  (pure
     (precompose (traverse g)
      ∘ (ap G2 ∘ ap G2 (pure (vcons m))))) <⋆> f a <⋆>
traverse f v
    rewrite (app_pure_natural (G := G1)).G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure
  (precompose g
     (precompose (traverse g)
      ∘ (ap G2 ∘ ap G2 (pure (vcons m))))) <⋆> f a <⋆>
traverse f v
    {G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
pure (compose (traverse g) ∘ vcons m) <⋆> f a <⋆>
traverse f v =
pure
  (precompose g
     (precompose (traverse g)
      ∘ (ap G2 ∘ ap G2 (pure (vcons m))))) <⋆> f a <⋆>
traverse f v repeat fequal.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
compose (traverse g) ∘ vcons m =
precompose g
  (precompose (traverse g)
   ∘ (ap G2 ∘ ap G2 (pure (vcons m))))
      ext w z.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
w: B
z: Vector m B
(compose (traverse g) ∘ vcons m) w z =
precompose g
  (precompose (traverse g)
   ∘ (ap G2 ∘ ap G2 (pure (vcons m)))) w z
      unfold compose, precompose.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
w: B
z: Vector m B
traverse g (vcons m w z) =
pure (vcons m) <⋆> g w <⋆> traverse g z
      rewrite traverse_Vector_vcons.G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: map (traverse g) (traverse f v) = traverse (kc2 g f) v
w: B
z: Vector m B
pure (vcons m) <⋆> g w <⋆> traverse g z =
pure (vcons m) <⋆> g w <⋆> traverse g z
      reflexivity.
    }
Qed.

Lemma trf_traverse_morphism_Vector :
  forall (G1 G2 : Type -> Type)
    (H0 : Map G1) (H1 : Mult G1)
    (H2 : Pure G1) (H3 : Map G2)
    (H4 : Mult G2) (H5 : Pure G2)
    (ϕ : forall A : Type, G1 A -> G2 A),
    ApplicativeMorphism G1 G2 ϕ ->
    forall (A B : Type) (f : A -> G1 B),
    forall `{v : Vector n A},
      ϕ (_ B) (traverse f v) = traverse (ϕ B ∘ f) v.forall (G1 G2 : Type -> Type) (H0 : Map G1)
  (H1 : Mult G1) (H2 : Pure G1) (H3 : Map G2)
  (H4 : Mult G2) (H5 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A B : Type) (f : A -> G1 B) (n : nat)
  (v : Vector n A),
ϕ (Vector n B) (traverse f v) = traverse (ϕ B ∘ f) v
Proof.forall (G1 G2 : Type -> Type) (H0 : Map G1)
  (H1 : Mult G1) (H2 : Pure G1) (H3 : Map G2)
  (H4 : Mult G2) (H5 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A B : Type) (f : A -> G1 B) (n : nat)
  (v : Vector n A),
ϕ (Vector n B) (traverse f v) = traverse (ϕ B ∘ f) v
  intros.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
v: Vector n A
ϕ (Vector n B) (traverse f v) = traverse (ϕ B ∘ f) v
  induction v using Vector_induction.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
ϕ (Vector 0 B) (traverse f vnil) =
traverse (ϕ B ∘ f) vnil
G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
ϕ (Vector (S m) B) (traverse f (vcons m a v)) =
traverse (ϕ B ∘ f) (vcons m a v)
  -G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
ϕ (Vector 0 B) (traverse f vnil) =
traverse (ϕ B ∘ f) vnil do 2 rewrite traverse_Vector_vnil.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
ϕ (Vector 0 B) (pure vnil) = pure vnil
    rewrite appmor_pure.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
pure vnil = pure vnil
    reflexivity.
  -G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
ϕ (Vector (S m) B) (traverse f (vcons m a v)) =
traverse (ϕ B ∘ f) (vcons m a v) rewrite traverse_Vector_vcons.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
traverse (ϕ B ∘ f) (vcons m a v)
    rewrite traverse_Vector_vcons.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
pure (vcons m) <⋆> (ϕ B ∘ f) a <⋆>
traverse (ϕ B ∘ f) v
    inversion H.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
appmor_app_F: Applicative G1
appmor_app_G: Applicative G2
appmor_natural: forall (A B : Type) (f : A -> B)
  (x : G1 A),
ϕ B (map f x) = map f (ϕ A x)
appmor_pure: forall (A : Type) (a : A),
ϕ A (pure a) = pure a
appmor_mult: forall (A B : Type) (x : G1 A)
  (y : G1 B),
ϕ (A * B) (x ⊗ y) = ϕ A x ⊗ ϕ B y
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
pure (vcons m) <⋆> (ϕ B ∘ f) a <⋆>
traverse (ϕ B ∘ f) v
    rewrite <- appmor_pure.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
appmor_app_F: Applicative G1
appmor_app_G: Applicative G2
appmor_natural: forall (A B : Type) (f : A -> B)
  (x : G1 A),
ϕ B (map f x) = map f (ϕ A x)
appmor_pure: forall (A : Type) (a : A),
ϕ A (pure a) = pure a
appmor_mult: forall (A B : Type) (x : G1 A)
  (y : G1 B),
ϕ (A * B) (x ⊗ y) = ϕ A x ⊗ ϕ B y
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
ϕ (B -> Vector m B -> Vector (S m) B) (pure (vcons m)) <⋆>
(ϕ B ∘ f) a <⋆> traverse (ϕ B ∘ f) v
    rewrite <- IHv.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
appmor_app_F: Applicative G1
appmor_app_G: Applicative G2
appmor_natural: forall (A B : Type) (f : A -> B)
  (x : G1 A),
ϕ B (map f x) = map f (ϕ A x)
appmor_pure: forall (A : Type) (a : A),
ϕ A (pure a) = pure a
appmor_mult: forall (A B : Type) (x : G1 A)
  (y : G1 B),
ϕ (A * B) (x ⊗ y) = ϕ A x ⊗ ϕ B y
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
ϕ (B -> Vector m B -> Vector (S m) B) (pure (vcons m)) <⋆>
(ϕ B ∘ f) a <⋆> ϕ (Vector m B) (traverse f v)
    unfold compose at 1.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
appmor_app_F: Applicative G1
appmor_app_G: Applicative G2
appmor_natural: forall (A B : Type) (f : A -> B)
  (x : G1 A),
ϕ B (map f x) = map f (ϕ A x)
appmor_pure: forall (A : Type) (a : A),
ϕ A (pure a) = pure a
appmor_mult: forall (A B : Type) (x : G1 A)
  (y : G1 B),
ϕ (A * B) (x ⊗ y) = ϕ A x ⊗ ϕ B y
ϕ (Vector (S m) B)
  (pure (vcons m) <⋆> f a <⋆> traverse f v) =
ϕ (B -> Vector m B -> Vector (S m) B) (pure (vcons m)) <⋆>
ϕ B (f a) <⋆> ϕ (Vector m B) (traverse f v)
    do 2 rewrite ap_morphism_1.G1, G2: Type -> Type
H0: Map G1
H1: Mult G1
H2: Pure G1
H3: Map G2
H4: Mult G2
H5: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
n: nat
a: A
m: nat
v: Vector m A
IHv: ϕ (Vector m B) (traverse f v) = traverse (ϕ B ∘ f) v
appmor_app_F: Applicative G1
appmor_app_G: Applicative G2
appmor_natural: forall (A B : Type) (f : A -> B)
  (x : G1 A),
ϕ B (map f x) = map f (ϕ A x)
appmor_pure: forall (A : Type) (a : A),
ϕ A (pure a) = pure a
appmor_mult: forall (A B : Type) (x : G1 A)
  (y : G1 B),
ϕ (A * B) (x ⊗ y) = ϕ A x ⊗ ϕ B y
ϕ (B -> Vector m B -> Vector (S m) B) (pure (vcons m)) <⋆>
ϕ B (f a) <⋆> ϕ (Vector m B) (traverse f v) =
ϕ (B -> Vector m B -> Vector (S m) B) (pure (vcons m)) <⋆>
ϕ B (f a) <⋆> ϕ (Vector m B) (traverse f v)
    reflexivity.
Qed.

#[export] Instance TraversableFunctor_Vector {n:nat}:
  TraversableFunctor (Vector n).n: nat
TraversableFunctor (Vector n)
Proof.n: nat
TraversableFunctor (Vector n)
  constructor.n: nat
forall A : Type, traverse id = id
n: nat
forall (G1 : Type -> Type) (Map_G : Map G1)
  (Pure_G : Pure G1) (Mult_G : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (Map_G0 : Map G2)
  (Pure_G0 : Pure G2) (Mult_G0 : Mult G2),
Applicative G2 ->
forall (A B C : Type) (g : B -> G2 C) (f : A -> G1 B),
map (traverse g) ∘ traverse f = traverse (kc2 g f)
n: nat
forall (G1 G2 : Type -> Type) (H : Map G1)
  (H0 : Mult G1) (H1 : Pure G1) (H2 : Map G2)
  (H3 : Mult G2) (H4 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A B : Type) (f : A -> G1 B),
ϕ (Vector n B) ∘ traverse f = traverse (ϕ B ∘ f)
  -n: nat
forall A : Type, traverse id = id intros.n: nat
A: Type
traverse id = id
    apply functional_extensionality.n: nat
A: Type
forall x : Vector n A, traverse id x = id x
    intros.n: nat
A: Type
x: Vector n A
traverse id x = id x
    apply traverse_Vector_id.
  -n: nat
forall (G1 : Type -> Type) (Map_G : Map G1)
  (Pure_G : Pure G1) (Mult_G : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (Map_G0 : Map G2)
  (Pure_G0 : Pure G2) (Mult_G0 : Mult G2),
Applicative G2 ->
forall (A B C : Type) (g : B -> G2 C) (f : A -> G1 B),
map (traverse g) ∘ traverse f = traverse (kc2 g f) intros.n: nat
G1: Type -> Type
Map_G: Map G1
Pure_G: Pure G1
Mult_G: Mult G1
H: Applicative G1
G2: Type -> Type
Map_G0: Map G2
Pure_G0: Pure G2
Mult_G0: Mult G2
H0: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
map (traverse g) ∘ traverse f = traverse (kc2 g f)
    apply functional_extensionality.n: nat
G1: Type -> Type
Map_G: Map G1
Pure_G: Pure G1
Mult_G: Mult G1
H: Applicative G1
G2: Type -> Type
Map_G0: Map G2
Pure_G0: Pure G2
Mult_G0: Mult G2
H0: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
forall x : Vector n A,
(map (traverse g) ∘ traverse f) x =
traverse (kc2 g f) x
    intros.n: nat
G1: Type -> Type
Map_G: Map G1
Pure_G: Pure G1
Mult_G: Mult G1
H: Applicative G1
G2: Type -> Type
Map_G0: Map G2
Pure_G0: Pure G2
Mult_G0: Mult G2
H0: Applicative G2
A, B, C: Type
g: B -> G2 C
f: A -> G1 B
x: Vector n A
(map (traverse g) ∘ traverse f) x =
traverse (kc2 g f) x
    apply trf_traverse_traverse_Vector; auto.
  -n: nat
forall (G1 G2 : Type -> Type) (H : Map G1)
  (H0 : Mult G1) (H1 : Pure G1) (H2 : Map G2)
  (H3 : Mult G2) (H4 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A B : Type) (f : A -> G1 B),
ϕ (Vector n B) ∘ traverse f = traverse (ϕ B ∘ f) intros.n: nat
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
morphism: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
ϕ (Vector n B) ∘ traverse f = traverse (ϕ B ∘ f)
    apply functional_extensionality.n: nat
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
morphism: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
forall x : Vector n A,
(ϕ (Vector n B) ∘ traverse f) x = traverse (ϕ B ∘ f) x
    intros.n: nat
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
morphism: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
x: Vector n A
(ϕ (Vector n B) ∘ traverse f) x = traverse (ϕ B ∘ f) x
    apply trf_traverse_morphism_Vector.n: nat
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
morphism: ApplicativeMorphism G1 G2 ϕ
A, B: Type
f: A -> G1 B
x: Vector n A
ApplicativeMorphism G1 G2 ϕ
    auto.
Qed.

(** ** Traversals and reversals *)
(******************************************************************************)
From Tealeaves Require Export
  Functors.Backwards.

Lemma Vector_traverse_rev
        `{Applicative G}
        {n: nat} {A B: Type}
        (f: A -> G B)
        (v: Vector n A):
  forwards (traverse (G := Backwards G) (mkBackwards ∘ f) v) =
    traverse f (Vector_rev v).G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
v: Vector n A
forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
Proof.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
v: Vector n A
forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
  induction v using Vector_induction.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
forwards (traverse (mkBackwards ∘ f) vnil) =
traverse f (Vector_rev vnil)
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
a: A
m: nat
v: Vector m A
IHv: forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
forwards (traverse (mkBackwards ∘ f) (vcons m a v)) =
traverse f (Vector_rev (vcons m a v))
  -G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
forwards (traverse (mkBackwards ∘ f) vnil) =
traverse f (Vector_rev vnil) rewrite traverse_Vector_vnil.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
forwards (pure vnil) = traverse f (Vector_rev vnil)
    unfold vnil.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
forwards
  (pure
     (exist (fun l : list B => length l = 0) nil
        eq_refl)) =
traverse f
  (Vector_rev
     (exist (fun l : list A => length l = 0) nil
        eq_refl))
    cbn.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
pure
  (exist (fun l : list B => length l = 0) nil eq_refl) =
pure
  (exist (fun l : list B => length l = 0) nil
     (List.rev_length nil))
    repeat fequal.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
eq_refl = List.rev_length nil
    apply proof_irrelevance.
  -G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
a: A
m: nat
v: Vector m A
IHv: forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
forwards (traverse (mkBackwards ∘ f) (vcons m a v)) =
traverse f (Vector_rev (vcons m a v)) rewrite traverse_Vector_vcons.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
a: A
m: nat
v: Vector m A
IHv: forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
forwards
  (pure (vcons m) <⋆> (mkBackwards ∘ f) a <⋆>
   traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev (vcons m a v))
    cbn.G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
n: nat
A, B: Type
f: A -> G B
a: A
m: nat
v: Vector m A
IHv: forwards (traverse (mkBackwards ∘ f) v) =
traverse f (Vector_rev v)
map (fun '(f, a) => f a)
  (map swap
     (forwards (traverse (mkBackwards ∘ f) v)
      ⊗ map (fun '(f, a) => f a)
          (map swap (f a ⊗ pure (vcons m))))) =
traverse f (Vector_rev (vcons m a v))
Abort.

(** * SameSetRight *)
(******************************************************************************)
Inductive SameSetRight {A : Type}: forall (n m: nat), Vector n A -> Vector m A -> Type :=
| ssetr_nil : SameSetRight 0 0 vnil vnil
| sset_dup: forall (n: nat) (a: A) (v: Vector n A),
    SameSetRight (S n) (S (S n)) (vcons n a v) (vcons (S n) a (vcons n a v))
| sset_skip: forall (n m: nat) (a: A) (v1: Vector n A) (v2: Vector m A),
    SameSetRight n m v1 v2 -> SameSetRight (S n) (S m) (vcons n a v1) (vcons m a v2)
| sset_swap: forall (n: nat) (a1 a2: A) (v: Vector n A),
    SameSetRight (S (S n)) (S (S n)) (vcons (S n) a1 (vcons n a2 v)) (vcons (S n) a2 (vcons n a1 v))
| sset_trans: forall (n m p: nat) (v1: Vector n A) (v2: Vector m A) (v3: Vector p A),
    SameSetRight n m v1 v2 -> SameSetRight m p v2 v3 -> SameSetRight n p v1 v3.

Definition vdup: forall (n : nat) {A: Type},
    Vector (S n) A -> Vector (S (S n)) A.forall (n : nat) (A : Type),
Vector (S n) A -> Vector (S (S n)) A
Proof.forall (n : nat) (A : Type),
Vector (S n) A -> Vector (S (S n)) A
Abort.

Definition vswap: forall (n : nat) {A: Type},
    Vector (S (S n)) A -> Vector (S (S n)) A.forall (n : nat) (A : Type),
Vector (S (S n)) A -> Vector (S (S n)) A
Proof.forall (n : nat) (A : Type),
Vector (S (S n)) A -> Vector (S (S n)) A
Abort.

Definition vskip: forall (n : nat) {A: Type} (f: Vector n A -> Vector n A),
    Vector (S n) A -> Vector (S n) A.forall (n : nat) (A : Type),
(Vector n A -> Vector n A) ->
Vector (S n) A -> Vector (S n) A
Proof.forall (n : nat) (A : Type),
(Vector n A -> Vector n A) ->
Vector (S n) A -> Vector (S n) A
Abort.


(** * Elimination principles *)
Section elimination.

  Context {A: Type}.

  Definition vcons_fn: forall (n: nat) (B: Type),
      (A -> Vector n A -> B) -> Vector (S n) A -> B.A: Type
forall (n : nat) (B : Type),
(A -> Vector n A -> B) -> Vector (S n) A -> B
  Proof.A: Type
forall (n : nat) (B : Type),
(A -> Vector n A -> B) -> Vector (S n) A -> B
  Abort.

End elimination.

Definition SSR_Goal: Type :=
  forall (A: Type) (n m: nat) (v1: Vector n A) (v2: Vector m A),
    SameSetRight n m v1 v2 ->
    {ϕ : forall (X: Type), Vector n X -> Vector m X | ϕ A v1 = v2}.

Goal SSR_Goal.SSR_Goal
  unfold SSR_Goal.forall (A : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m A),
SameSetRight n m v1 v2 ->
{ϕ : forall X : Type, Vector n X -> Vector m X
| ϕ A v1 = v2} intros.A: Type
n, m: nat
v1: Vector n A
v2: Vector m A
X: SameSetRight n m v1 v2
{ϕ : forall X : Type, Vector n X -> Vector m X
| ϕ A v1 = v2}
Abort.

(** * <<tosubset>> on Vectors *)
(******************************************************************************)
Import ContainerFunctor.Notations.
Import Subset.Notations.

#[export] Instance ToSubset_Vector {n}: ToSubset (Vector n) :=
  fun A v => tosubset (F := list) (proj1_sig v).

Lemma tosubset_Vector_vnil: forall (A: Type),
    tosubset (@vnil A) = ∅.forall A : Type, tosubset vnil = ∅
Proof.forall A : Type, tosubset vnil = ∅
  tauto.
Qed.

Lemma tosubset_Vector_vcons: forall (n: nat) (A: Type) (a: A) (v: Vector n A),
    tosubset (vcons n a v) = {{a}} ∪ tosubset v.forall (n : nat) (A : Type) (a : A) (v : Vector n A),
tosubset (vcons n a v) = {{a}} ∪ tosubset v
Proof.forall (n : nat) (A : Type) (a : A) (v : Vector n A),
tosubset (vcons n a v) = {{a}} ∪ tosubset v
  intros.n: nat
A: Type
a: A
v: Vector n A
tosubset (vcons n a v) = {{a}} ∪ tosubset v
  destruct v.n: nat
A: Type
a: A
x: list A
e: length x = n
tosubset
  (vcons n a
     (exist (fun l : list A => length l = n) x e)) =
{{a}}
∪ tosubset
    (exist (fun l : list A => length l = n) x e)
  cbn.n: nat
A: Type
a: A
x: list A
e: length x = n
tosubset
  (exist (fun l : list A => length l = S n) (a :: x)
     (args_eq_1 S e)) =
{{a}}
∪ tosubset
    (exist (fun l : list A => length l = n) x e) tauto.
Qed.

#[export] Instance Compat_ToSubset_Traverse_Vector {n: nat}:
  Compat_ToSubset_Traverse (Vector n).n: nat
Compat_ToSubset_Traverse (Vector n)
Proof.n: nat
Compat_ToSubset_Traverse (Vector n)
  hnf.n: nat
ToSubset_Vector = ToSubset_Traverse ext A v.n: nat
A: Type
v: Vector n A
ToSubset_Vector A v = ToSubset_Traverse A v
  unfold_ops @ToSubset_Traverse.n: nat
A: Type
v: Vector n A
ToSubset_Vector A v = mapReduce ret v
  change_left (tosubset v).n: nat
A: Type
v: Vector n A
tosubset v = mapReduce ret v
  induction v using Vector_induction.n: nat
A: Type
tosubset vnil = mapReduce ret vnil
n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: tosubset v = mapReduce ret v
tosubset (vcons m a v) = mapReduce ret (vcons m a v)
  -n: nat
A: Type
tosubset vnil = mapReduce ret vnil reflexivity.
  -n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: tosubset v = mapReduce ret v
tosubset (vcons m a v) = mapReduce ret (vcons m a v) rewrite mapReduce_Vector_vcons;
      try typeclasses eauto.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: tosubset v = mapReduce ret v
tosubset (vcons m a v) = ret a ● mapReduce ret v
    rewrite tosubset_Vector_vcons.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: tosubset v = mapReduce ret v
{{a}} ∪ tosubset v = ret a ● mapReduce ret v
    rewrite IHv.n: nat
A: Type
a: A
m: nat
v: Vector m A
IHv: tosubset v = mapReduce ret v
{{a}} ∪ mapReduce ret v = ret a ● mapReduce ret v
    reflexivity.
Qed.

(** * Zipping vectors *)
(******************************************************************************)
Definition Vector_zip_eq:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B),
    Vector n (A * B).forall (A B : Type) (n : nat),
Vector n A -> Vector n B -> Vector n (A * B)
Proof.forall (A B : Type) (n : nat),
Vector n A -> Vector n B -> Vector n (A * B)
  introv v1 v2.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Vector n (A * B)
  induction n.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
Vector 0 (A * B)
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector (S n) (A * B)
  -A, B: Type
v1: Vector 0 A
v2: Vector 0 B
Vector 0 (A * B) exact vnil.
  -A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector (S n) (A * B) apply vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
A * B
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector n (A * B)
    exact (Vector_hd v1, Vector_hd v2).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector n (A * B)
    apply IHn.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector n A
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector n B
    exact (Vector_tl v1).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: Vector n A -> Vector n B -> Vector n (A * B)
Vector n B
    exact (Vector_tl v2).
Defined.

#[global] Arguments Vector_zip_eq {A B}%type_scope {n}%nat_scope v1 v2.

(** ** Rewriting Lemmas *)
(******************************************************************************)
Lemma Vector_zip_eq_vnil:
  forall (A B: Type)
    (v1: Vector 0 A)
    (v2: Vector 0 B),
    Vector_zip_eq v1 v2 = vnil.forall (A B : Type) (v1 : Vector 0 A)
  (v2 : Vector 0 B), Vector_zip_eq v1 v2 = vnil
Proof.forall (A B : Type) (v1 : Vector 0 A)
  (v2 : Vector 0 B), Vector_zip_eq v1 v2 = vnil
  intros.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
Vector_zip_eq v1 v2 = vnil
  reflexivity.
Qed.

Lemma Vector_zip_eq_vcons:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (a: A) (b: B),
    Vector_zip_eq
      (vcons n a v1) (vcons n b v2) =
      vcons n (a, b) (Vector_zip_eq v1 v2).forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (a : A) (b : B),
Vector_zip_eq (vcons n a v1) (vcons n b v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (a : A) (b : B),
Vector_zip_eq (vcons n a v1) (vcons n b v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  intros.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
Vector_zip_eq (vcons n a v1) (vcons n b v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite (Vector_surjective_pairing2).A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd
     (Vector_zip_eq (vcons n a v1) (vcons n b v2)))
  (Vector_tl
     (Vector_zip_eq (vcons n a v1) (vcons n b v2))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite (Vector_surjective_pairing2).A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd
     (vcons n
        (Vector_hd
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2)))
        (Vector_tl
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2)))))
  (Vector_tl
     (vcons n
        (Vector_hd
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2)))
        (Vector_tl
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_hd_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd
     (Vector_zip_eq (vcons n a v1) (vcons n b v2)))
  (Vector_tl
     (vcons n
        (Vector_hd
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2)))
        (Vector_tl
           (Vector_zip_eq (vcons n a v1)
              (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_tl_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd
     (Vector_zip_eq (vcons n a v1) (vcons n b v2)))
  (Vector_tl
     (Vector_zip_eq (vcons n a v1) (vcons n b v2))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  cbn.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd
     (vcons n
        (Vector_hd (vcons n a v1),
         Vector_hd (vcons n b v2))
        (nat_rect
           (fun n : nat =>
            Vector n A ->
            Vector n B -> Vector n (A * B))
           (fun (_ : Vector 0 A) (_ : Vector 0 B) =>
            vnil)
           (fun (n : nat)
              (IHn : Vector n A ->
                     Vector n B -> Vector n (A * B))
              (v1 : Vector (S n) A)
              (v2 : Vector (S n) B) =>
            vcons n (Vector_hd v1, Vector_hd v2)
              (IHn (Vector_tl v1) (Vector_tl v2))) n
           (Vector_tl (vcons n a v1))
           (Vector_tl (vcons n b v2)))))
  (Vector_tl
     (vcons n
        (Vector_hd (vcons n a v1),
         Vector_hd (vcons n b v2))
        (nat_rect
           (fun n : nat =>
            Vector n A ->
            Vector n B -> Vector n (A * B))
           (fun (_ : Vector 0 A) (_ : Vector 0 B) =>
            vnil)
           (fun (n : nat)
              (IHn : Vector n A ->
                     Vector n B -> Vector n (A * B))
              (v1 : Vector (S n) A)
              (v2 : Vector (S n) B) =>
            vcons n (Vector_hd v1, Vector_hd v2)
              (IHn (Vector_tl v1) (Vector_tl v2))) n
           (Vector_tl (vcons n a v1))
           (Vector_tl (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_hd_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n
  (Vector_hd (vcons n a v1), Vector_hd (vcons n b v2))
  (Vector_tl
     (vcons n
        (Vector_hd (vcons n a v1),
         Vector_hd (vcons n b v2))
        (nat_rect
           (fun n : nat =>
            Vector n A ->
            Vector n B -> Vector n (A * B))
           (fun (_ : Vector 0 A) (_ : Vector 0 B) =>
            vnil)
           (fun (n : nat)
              (IHn : Vector n A ->
                     Vector n B -> Vector n (A * B))
              (v1 : Vector (S n) A)
              (v2 : Vector (S n) B) =>
            vcons n (Vector_hd v1, Vector_hd v2)
              (IHn (Vector_tl v1) (Vector_tl v2))) n
           (Vector_tl (vcons n a v1))
           (Vector_tl (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_hd_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, Vector_hd (vcons n b v2))
  (Vector_tl
     (vcons n (a, Vector_hd (vcons n b v2))
        (nat_rect
           (fun n : nat =>
            Vector n A ->
            Vector n B -> Vector n (A * B))
           (fun (_ : Vector 0 A) (_ : Vector 0 B) =>
            vnil)
           (fun (n : nat)
              (IHn : Vector n A ->
                     Vector n B -> Vector n (A * B))
              (v1 : Vector (S n) A)
              (v2 : Vector (S n) B) =>
            vcons n (Vector_hd v1, Vector_hd v2)
              (IHn (Vector_tl v1) (Vector_tl v2))) n
           (Vector_tl (vcons n a v1))
           (Vector_tl (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_hd_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, b)
  (Vector_tl
     (vcons n (a, b)
        (nat_rect
           (fun n : nat =>
            Vector n A ->
            Vector n B -> Vector n (A * B))
           (fun (_ : Vector 0 A) (_ : Vector 0 B) =>
            vnil)
           (fun (n : nat)
              (IHn : Vector n A ->
                     Vector n B -> Vector n (A * B))
              (v1 : Vector (S n) A)
              (v2 : Vector (S n) B) =>
            vcons n (Vector_hd v1, Vector_hd v2)
              (IHn (Vector_tl v1) (Vector_tl v2))) n
           (Vector_tl (vcons n a v1))
           (Vector_tl (vcons n b v2))))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_tl_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, b)
  (nat_rect
     (fun n : nat =>
      Vector n A -> Vector n B -> Vector n (A * B))
     (fun (_ : Vector 0 A) (_ : Vector 0 B) => vnil)
     (fun (n : nat)
        (IHn : Vector n A ->
               Vector n B -> Vector n (A * B))
        (v1 : Vector (S n) A) (v2 : Vector (S n) B) =>
      vcons n (Vector_hd v1, Vector_hd v2)
        (IHn (Vector_tl v1) (Vector_tl v2))) n
     (Vector_tl (vcons n a v1))
     (Vector_tl (vcons n b v2))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_tl_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, b)
  (nat_rect
     (fun n : nat =>
      Vector n A -> Vector n B -> Vector n (A * B))
     (fun (_ : Vector 0 A) (_ : Vector 0 B) => vnil)
     (fun (n : nat)
        (IHn : Vector n A ->
               Vector n B -> Vector n (A * B))
        (v1 : Vector (S n) A) (v2 : Vector (S n) B) =>
      vcons n (Vector_hd v1, Vector_hd v2)
        (IHn (Vector_tl v1) (Vector_tl v2))) n v1
     (Vector_tl (vcons n b v2))) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_tl_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, b)
  (nat_rect
     (fun n : nat =>
      Vector n A -> Vector n B -> Vector n (A * B))
     (fun (_ : Vector 0 A) (_ : Vector 0 B) => vnil)
     (fun (n : nat)
        (IHn : Vector n A ->
               Vector n B -> Vector n (A * B))
        (v1 : Vector (S n) A) (v2 : Vector (S n) B) =>
      vcons n (Vector_hd v1, Vector_hd v2)
        (IHn (Vector_tl v1) (Vector_tl v2))) n v1 v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  reflexivity.
Qed.

(** ** Roundtrip Properties *)
(******************************************************************************)
Lemma Vector_zip_eq_fst:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B),
    map fst (Vector_zip_eq v1 v2) = v1.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
  intros.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
map fst (Vector_zip_eq v1 v2) = v1
  induction n.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map fst (Vector_zip_eq v1 v2) = v1
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
map fst (Vector_zip_eq v1 v2) = v1
  -A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map fst (Vector_zip_eq v1 v2) = v1 rewrite (Vector_nil_eq v1).A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map fst (Vector_zip_eq vnil v2) = vnil
    rewrite (Vector_nil_eq v2).A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map fst (Vector_zip_eq vnil vnil) = vnil
    apply Vector_sim_eq.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map fst (Vector_zip_eq vnil vnil) ~~ vnil
    reflexivity.
  -A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
map fst (Vector_zip_eq v1 v2) = v1 rewrite (Vector_surjective_pairing2 (v := v1)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
map fst
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1)) v2) =
vcons n (Vector_hd v1) (Vector_tl v1)
    rewrite (Vector_surjective_pairing2 (v := v2)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
map fst
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1))
     (vcons n (Vector_hd v2) (Vector_tl v2))) =
vcons n (Vector_hd v1) (Vector_tl v1)
    rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
map fst
  (vcons n (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v1) (Vector_tl v1)
    rewrite map_Vector_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
vcons n (fst (Vector_hd v1, Vector_hd v2))
  (map fst
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v1) (Vector_tl v1)
    cbn.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
vcons n (Vector_hd v1)
  (map fst
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v1) (Vector_tl v1)
    rewrite IHn.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map fst (Vector_zip_eq v1 v2) = v1
vcons n (Vector_hd v1) (Vector_tl v1) =
vcons n (Vector_hd v1) (Vector_tl v1)
    reflexivity.
Qed.

Lemma Vector_zip_eq_snd:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B),
    map snd (Vector_zip_eq v1 v2) = v2.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
  intros.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
map snd (Vector_zip_eq v1 v2) = v2
  induction n.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map snd (Vector_zip_eq v1 v2) = v2
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
map snd (Vector_zip_eq v1 v2) = v2
  -A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map snd (Vector_zip_eq v1 v2) = v2 rewrite (Vector_nil_eq v1).A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map snd (Vector_zip_eq vnil v2) = v2
    rewrite (Vector_nil_eq v2).A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map snd (Vector_zip_eq vnil vnil) = vnil
    apply Vector_sim_eq.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
map snd (Vector_zip_eq vnil vnil) ~~ vnil
    reflexivity.
  -A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
map snd (Vector_zip_eq v1 v2) = v2 rewrite (Vector_surjective_pairing2 (v := v1)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
map snd
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1)) v2) = v2
    rewrite (Vector_surjective_pairing2 (v := v2)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
map snd
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1))
     (vcons n (Vector_hd v2) (Vector_tl v2))) =
vcons n (Vector_hd v2) (Vector_tl v2)
    rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
map snd
  (vcons n (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v2) (Vector_tl v2)
    rewrite map_Vector_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
vcons n (snd (Vector_hd v1, Vector_hd v2))
  (map snd
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v2) (Vector_tl v2)
    cbn.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
vcons n (Vector_hd v2)
  (map snd
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons n (Vector_hd v2) (Vector_tl v2)
    rewrite IHn.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
map snd (Vector_zip_eq v1 v2) = v2
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2)
    reflexivity.
Qed.

(** ** <<_sim>> Properties *)
(******************************************************************************)
Lemma Vector_zip_eq_sim_both:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector n A)
    (v4: Vector n B),
    v1 ~~ v3 ->
    v2 ~~ v4 ->
    Vector_zip_eq v1 v2 =
      Vector_zip_eq v3 v4.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 -> Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 -> Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
  introv Hsim1 Hsim2.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
v3: Vector n A
v4: Vector n B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
  induction n.A, B: Type
v1: Vector 0 A
v2: Vector 0 B
v3: Vector 0 A
v4: Vector 0 B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
  -A, B: Type
v1: Vector 0 A
v2: Vector 0 B
v3: Vector 0 A
v4: Vector 0 B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4 reflexivity.
  -A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4 rewrite (Vector_surjective_pairing2 (v := v1)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Vector_zip_eq (vcons n (Vector_hd v1) (Vector_tl v1))
  v2 = Vector_zip_eq v3 v4
    rewrite (Vector_surjective_pairing2 (v := v2)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Vector_zip_eq (vcons n (Vector_hd v1) (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
Vector_zip_eq v3 v4
    rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v1, Vector_hd v2)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
Vector_zip_eq v3 v4
    rewrite (Vector_surjective_pairing2 (v := v3)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v1, Vector_hd v2)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
Vector_zip_eq (vcons n (Vector_hd v3) (Vector_tl v3))
  v4
    rewrite (Vector_surjective_pairing2 (v := v4)).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v1, Vector_hd v2)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
Vector_zip_eq (vcons n (Vector_hd v3) (Vector_tl v3))
  (vcons n (Vector_hd v4) (Vector_tl v4))
    rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v1, Vector_hd v2)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
vcons n (Vector_hd v3, Vector_hd v4)
  (Vector_zip_eq (Vector_tl v3) (Vector_tl v4))
    rewrite (Vector_hd_sim Hsim1).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v3, Vector_hd v2)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
vcons n (Vector_hd v3, Vector_hd v4)
  (Vector_zip_eq (Vector_tl v3) (Vector_tl v4))
    rewrite (Vector_hd_sim Hsim2).A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
vcons n (Vector_hd v3, Vector_hd v4)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) =
vcons n (Vector_hd v3, Vector_hd v4)
  (Vector_zip_eq (Vector_tl v3) (Vector_tl v4))
    fequal.A, B: Type
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
v3: Vector (S n) A
v4: Vector (S n) B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
IHn: forall (v1 : Vector n A) 
  (v2 : Vector n B) (v3 : Vector n A)
  (v4 : Vector n B),
v1 ~~ v3 ->
v2 ~~ v4 ->
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v4
Vector_zip_eq (Vector_tl v1) (Vector_tl v2) =
Vector_zip_eq (Vector_tl v3) (Vector_tl v4)
    apply IHn;
    auto using Vector_tl_sim.
Qed.

Corollary Vector_zip_eq_sim1:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector n A),
    v1 ~~ v3 ->
    Vector_zip_eq v1 v2 =
      Vector_zip_eq v3 v2.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector n A),
v1 ~~ v3 -> Vector_zip_eq v1 v2 = Vector_zip_eq v3 v2
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector n A),
v1 ~~ v3 -> Vector_zip_eq v1 v2 = Vector_zip_eq v3 v2
  introv Hsim.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
v3: Vector n A
Hsim: v1 ~~ v3
Vector_zip_eq v1 v2 = Vector_zip_eq v3 v2
  now apply Vector_zip_eq_sim_both.
Qed.

Corollary Vector_zip_eq_sim2:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector n B),
    v2 ~~ v3 ->
    Vector_zip_eq v1 v2 =
      Vector_zip_eq v1 v3.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 v3 : Vector n B),
v2 ~~ v3 -> Vector_zip_eq v1 v2 = Vector_zip_eq v1 v3
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 v3 : Vector n B),
v2 ~~ v3 -> Vector_zip_eq v1 v2 = Vector_zip_eq v1 v3
  introv Hsim.A, B: Type
n: nat
v1: Vector n A
v2, v3: Vector n B
Hsim: v2 ~~ v3
Vector_zip_eq v1 v2 = Vector_zip_eq v1 v3
  now apply Vector_zip_eq_sim_both.
Qed.

(** ** <<_sim>> Properties for <<n <> m>> *)
(******************************************************************************)
Lemma Vector_zip_eq_sim_poly_both:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector m A)
    (v4: Vector m B),
    v1 ~~ v3 ->
    v2 ~~ v4 ->
    Vector_zip_eq v1 v2 ~~
      Vector_zip_eq v3 v4.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m A)
  (v4 : Vector m B),
v1 ~~ v3 ->
v2 ~~ v4 -> Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m A)
  (v4 : Vector m B),
v1 ~~ v3 ->
v2 ~~ v4 -> Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
  introv Hsim1 Hsim2.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
  assert (n = m).A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
n = m
A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
H: n = m
Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
  {A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
n = m eapply Vector_sim_length.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
?v1 ~~ ?v2
    eassumption. }A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
v4: Vector m B
Hsim1: v1 ~~ v3
Hsim2: v2 ~~ v4
H: n = m
Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
  subst.A, B: Type
m: nat
v2: Vector m B
v1, v3: Vector m A
v4: Vector m B
Hsim2: v2 ~~ v4
Hsim1: v1 ~~ v3
Vector_zip_eq v1 v2 ~~ Vector_zip_eq v3 v4
  erewrite Vector_zip_eq_sim_both; eauto.A, B: Type
m: nat
v2: Vector m B
v1, v3: Vector m A
v4: Vector m B
Hsim2: v2 ~~ v4
Hsim1: v1 ~~ v3
Vector_zip_eq v3 v4 ~~ Vector_zip_eq v3 v4
  reflexivity.
Qed.

Corollary Vector_zip_eq_sim_poly1:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector m A)
    (Hsim: v1 ~~ v3),
    Vector_zip_eq v1 v2 ~~
      Vector_zip_eq v3 (coerce (Vector_sim_length v1 v3 Hsim) in v2).forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m A)
  (Hsim : v1 ~~ v3),
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v3
  (coerce Vector_sim_length v1 v3 Hsim in v2)
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m A)
  (Hsim : v1 ~~ v3),
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v3
  (coerce Vector_sim_length v1 v3 Hsim in v2)
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
Hsim: v1 ~~ v3
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v3
  (coerce Vector_sim_length v1 v3 Hsim in v2)
  apply Vector_zip_eq_sim_poly_both.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
Hsim: v1 ~~ v3
v1 ~~ v3
A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
Hsim: v1 ~~ v3
v2 ~~ coerce Vector_sim_length v1 v3 Hsim in v2
  eauto.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m A
Hsim: v1 ~~ v3
v2 ~~ coerce Vector_sim_length v1 v3 Hsim in v2
  vector_sim.
Qed.


Corollary Vector_zip_eq_sim_poly2:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (v3: Vector m B)
    (Hsim: v3 ~~ v2),
    Vector_zip_eq v1 v2 ~~
      Vector_zip_eq v1 (coerce (Vector_sim_length v3 v2 Hsim) in v3).forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m B)
  (Hsim : v3 ~~ v2),
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v1
  (coerce Vector_sim_length v3 v2 Hsim in v3)
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector n B) (v3 : Vector m B)
  (Hsim : v3 ~~ v2),
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v1
  (coerce Vector_sim_length v3 v2 Hsim in v3)
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
Vector_zip_eq v1 v2 ~~
Vector_zip_eq v1
  (coerce Vector_sim_length v3 v2 Hsim in v3)
  apply Vector_zip_eq_sim_poly_both.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
v1 ~~ v1
A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
v2 ~~ coerce Vector_sim_length v3 v2 Hsim in v3
  reflexivity.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
v2 ~~ coerce Vector_sim_length v3 v2 Hsim in v3
  vector_sim.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
v2 ~~ v3
  symmetry.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector n B
v3: Vector m B
Hsim: v3 ~~ v2
proj1_sig v3 = proj1_sig v2
  assumption.
Qed.

(** ** Naturality Properties *)
(******************************************************************************)
From Tealeaves Require Import Functors.Pair.

Section zipped_vector_naturality.

  Lemma natural_Vector_zip_eq
    {A1 A2 B1 B2: Type} {n: nat}:
    forall (v1: Vector n A1)
      (v2: Vector n B1)
      (f: A1 -> A2) (g: B1 -> B2),
      map (map_pair f g) (Vector_zip_eq v1 v2) =
        Vector_zip_eq (map f v1) (map g v2).A1, A2, B1, B2: Type
n: nat
forall (v1 : Vector n A1) (v2 : Vector n B1)
  (f : A1 -> A2) (g : B1 -> B2),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
  Proof.A1, A2, B1, B2: Type
n: nat
forall (v1 : Vector n A1) (v2 : Vector n B1)
  (f : A1 -> A2) (g : B1 -> B2),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
    intros.A1, A2, B1, B2: Type
n: nat
v1: Vector n A1
v2: Vector n B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
    induction n as [| m].A1, A2, B1, B2: Type
v1: Vector 0 A1
v2: Vector 0 B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
    -A1, A2, B1, B2: Type
v1: Vector 0 A1
v2: Vector 0 B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2) rewrite (Vector_nil_eq v1).A1, A2, B1, B2: Type
v1: Vector 0 A1
v2: Vector 0 B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq vnil v2) =
Vector_zip_eq (map f vnil) (map g v2)
      rewrite (Vector_nil_eq v2).A1, A2, B1, B2: Type
v1: Vector 0 A1
v2: Vector 0 B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq vnil vnil) =
Vector_zip_eq (map f vnil) (map g vnil)
      apply Vector_sim_eq.A1, A2, B1, B2: Type
v1: Vector 0 A1
v2: Vector 0 B1
f: A1 -> A2
g: B1 -> B2
map (map_pair f g) (Vector_zip_eq vnil vnil) ~~
Vector_zip_eq (map f vnil) (map g vnil)
      reflexivity.
    -A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2) rewrite (Vector_surjective_pairing2 (v := v1)).A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (Vector_zip_eq
     (vcons m (Vector_hd v1) (Vector_tl v1)) v2) =
Vector_zip_eq
  (map f (vcons m (Vector_hd v1) (Vector_tl v1)))
  (map g v2)
      rewrite (Vector_surjective_pairing2 (v := v2)).A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (Vector_zip_eq
     (vcons m (Vector_hd v1) (Vector_tl v1))
     (vcons m (Vector_hd v2) (Vector_tl v2))) =
Vector_zip_eq
  (map f (vcons m (Vector_hd v1) (Vector_tl v1)))
  (map g (vcons m (Vector_hd v2) (Vector_tl v2)))
      rewrite map_Vector_vcons.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (Vector_zip_eq
     (vcons m (Vector_hd v1) (Vector_tl v1))
     (vcons m (Vector_hd v2) (Vector_tl v2))) =
Vector_zip_eq
  (vcons m (f (Vector_hd v1)) (map f (Vector_tl v1)))
  (map g (vcons m (Vector_hd v2) (Vector_tl v2)))
      rewrite map_Vector_vcons.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (Vector_zip_eq
     (vcons m (Vector_hd v1) (Vector_tl v1))
     (vcons m (Vector_hd v2) (Vector_tl v2))) =
Vector_zip_eq
  (vcons m (f (Vector_hd v1)) (map f (Vector_tl v1)))
  (vcons m (g (Vector_hd v2)) (map g (Vector_tl v2)))
      rewrite Vector_zip_eq_vcons.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (vcons m (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
Vector_zip_eq
  (vcons m (f (Vector_hd v1)) (map f (Vector_tl v1)))
  (vcons m (g (Vector_hd v2)) (map g (Vector_tl v2)))
      rewrite Vector_zip_eq_vcons.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
map (map_pair f g)
  (vcons m (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons m (f (Vector_hd v1), g (Vector_hd v2))
  (Vector_zip_eq (map f (Vector_tl v1))
     (map g (Vector_tl v2)))
      rewrite map_Vector_vcons.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
vcons m (map_pair f g (Vector_hd v1, Vector_hd v2))
  (map (map_pair f g)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))) =
vcons m (f (Vector_hd v1), g (Vector_hd v2))
  (Vector_zip_eq (map f (Vector_tl v1))
     (map g (Vector_tl v2)))
      rewrite IHm.A1, A2, B1, B2: Type
m: nat
v1: Vector (S m) A1
v2: Vector (S m) B1
f: A1 -> A2
g: B1 -> B2
IHm: forall (v1 : Vector m A1) (v2 : Vector m B1),
map (map_pair f g) (Vector_zip_eq v1 v2) =
Vector_zip_eq (map f v1) (map g v2)
vcons m (map_pair f g (Vector_hd v1, Vector_hd v2))
  (Vector_zip_eq (map f (Vector_tl v1))
     (map g (Vector_tl v2))) =
vcons m (f (Vector_hd v1), g (Vector_hd v2))
  (Vector_zip_eq (map f (Vector_tl v1))
     (map g (Vector_tl v2)))
      reflexivity.
  Qed.

  Corollary natural_fst_Vector_zip_eq
    {A1 A2 B: Type} {n: nat}:
    forall (v1: Vector n A1)
      (v2: Vector n B)
      (f: A1 -> A2),
      Vector_zip_eq (map f v1) v2 =
        map (map_fst f) (Vector_zip_eq v1 v2).A1, A2, B: Type
n: nat
forall (v1 : Vector n A1) (v2 : Vector n B)
  (f : A1 -> A2),
Vector_zip_eq (map f v1) v2 =
map (map_fst f) (Vector_zip_eq v1 v2)
  Proof.A1, A2, B: Type
n: nat
forall (v1 : Vector n A1) (v2 : Vector n B)
  (f : A1 -> A2),
Vector_zip_eq (map f v1) v2 =
map (map_fst f) (Vector_zip_eq v1 v2)
    intros.A1, A2, B: Type
n: nat
v1: Vector n A1
v2: Vector n B
f: A1 -> A2
Vector_zip_eq (map f v1) v2 =
map (map_fst f) (Vector_zip_eq v1 v2)
    rewrite map_fst_to_pair.A1, A2, B: Type
n: nat
v1: Vector n A1
v2: Vector n B
f: A1 -> A2
Vector_zip_eq (map f v1) v2 =
map (map_pair f id) (Vector_zip_eq v1 v2)
    rewrite natural_Vector_zip_eq.A1, A2, B: Type
n: nat
v1: Vector n A1
v2: Vector n B
f: A1 -> A2
Vector_zip_eq (map f v1) v2 =
Vector_zip_eq (map f v1) (map id v2)
    rewrite fun_map_id.A1, A2, B: Type
n: nat
v1: Vector n A1
v2: Vector n B
f: A1 -> A2
Vector_zip_eq (map f v1) v2 =
Vector_zip_eq (map f v1) (id v2)
    reflexivity.
  Qed.

  Corollary natural_snd_Vector_zip_eq
    {A B1 B2: Type} {n: nat}:
    forall (v1: Vector n A)
      (v2: Vector n B1)
      (g: B1 -> B2),
      Vector_zip_eq v1 (map g v2) =
        map (map_snd g) (Vector_zip_eq v1 v2).A, B1, B2: Type
n: nat
forall (v1 : Vector n A) (v2 : Vector n B1)
  (g : B1 -> B2),
Vector_zip_eq v1 (map g v2) =
map (map_snd g) (Vector_zip_eq v1 v2)
  Proof.A, B1, B2: Type
n: nat
forall (v1 : Vector n A) (v2 : Vector n B1)
  (g : B1 -> B2),
Vector_zip_eq v1 (map g v2) =
map (map_snd g) (Vector_zip_eq v1 v2)
    intros.A, B1, B2: Type
n: nat
v1: Vector n A
v2: Vector n B1
g: B1 -> B2
Vector_zip_eq v1 (map g v2) =
map (map_snd g) (Vector_zip_eq v1 v2)
    rewrite map_snd_to_pair.A, B1, B2: Type
n: nat
v1: Vector n A
v2: Vector n B1
g: B1 -> B2
Vector_zip_eq v1 (map g v2) =
map (map_pair id g) (Vector_zip_eq v1 v2)
    rewrite natural_Vector_zip_eq.A, B1, B2: Type
n: nat
v1: Vector n A
v2: Vector n B1
g: B1 -> B2
Vector_zip_eq v1 (map g v2) =
Vector_zip_eq (map id v1) (map g v2)
    rewrite fun_map_id.A, B1, B2: Type
n: nat
v1: Vector n A
v2: Vector n B1
g: B1 -> B2
Vector_zip_eq v1 (map g v2) =
Vector_zip_eq (id v1) (map g v2)
    reflexivity.
  Qed.

End zipped_vector_naturality.

(** ** Diagonal *)
(******************************************************************************)
Lemma Vector_zip_diagonal:
  forall (A: Type) (n: nat)
    (v: Vector n A),
    Vector_zip_eq v v = map (fun a => (a, a)) v.forall (A : Type) (n : nat) (v : Vector n A),
Vector_zip_eq v v = map (fun a : A => (a, a)) v
Proof.forall (A : Type) (n : nat) (v : Vector n A),
Vector_zip_eq v v = map (fun a : A => (a, a)) v
  intros.A: Type
n: nat
v: Vector n A
Vector_zip_eq v v = map (fun a : A => (a, a)) v
  induction v using Vector_induction.A: Type
n: nat
Vector_zip_eq vnil vnil =
map (fun a : A => (a, a)) vnil
A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_zip_eq v v = map (fun a : A => (a, a)) v
Vector_zip_eq (vcons m a v) (vcons m a v) =
map (fun a : A => (a, a)) (vcons m a v)
  -A: Type
n: nat
Vector_zip_eq vnil vnil =
map (fun a : A => (a, a)) vnil rewrite Vector_zip_eq_vnil.A: Type
n: nat
vnil = map (fun a : A => (a, a)) vnil
    rewrite map_Vector_vnil.A: Type
n: nat
vnil = vnil
    reflexivity.
  -A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_zip_eq v v = map (fun a : A => (a, a)) v
Vector_zip_eq (vcons m a v) (vcons m a v) =
map (fun a : A => (a, a)) (vcons m a v) rewrite Vector_zip_eq_vcons.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_zip_eq v v = map (fun a : A => (a, a)) v
vcons m (a, a) (Vector_zip_eq v v) =
map (fun a : A => (a, a)) (vcons m a v)
    rewrite map_Vector_vcons.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_zip_eq v v = map (fun a : A => (a, a)) v
vcons m (a, a) (Vector_zip_eq v v) =
vcons m (a, a) (map (fun a : A => (a, a)) v)
    rewrite IHv.A: Type
n: nat
a: A
m: nat
v: Vector m A
IHv: Vector_zip_eq v v = map (fun a : A => (a, a)) v
vcons m (a, a) (map (fun a : A => (a, a)) v) =
vcons m (a, a) (map (fun a : A => (a, a)) v)
    reflexivity.
Qed.

(** ** Traversing a Zip by A Relation *)
(******************************************************************************)
Section traverse_zipped_vector.

  Lemma traverse_zipped_vector
    {A B: Type} {R: A -> B -> Prop}:
    forall (n: nat) (v1: Vector n A) (v2: Vector n B),
      traverse R v1 v2 =
        mapReduce (uncurry R)
          (Vector_zip_eq v1 v2).A, B: Type
R: A -> B -> Prop
forall (n : nat) (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
  Proof.A, B: Type
R: A -> B -> Prop
forall (n : nat) (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
    intros.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector n A
v2: Vector n B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
    induction n.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
    -A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2) rewrite (Vector_nil_eq v1).A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R vnil v2 =
mapReduce (uncurry R) (Vector_zip_eq vnil v2)
      rewrite (Vector_nil_eq v2).A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R vnil vnil =
mapReduce (uncurry R) (Vector_zip_eq vnil vnil)
      rewrite Vector_zip_eq_vnil.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R vnil vnil = mapReduce (uncurry R) vnil
      rewrite traverse_Vector_vnil.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
pure vnil vnil = mapReduce (uncurry R) vnil
      rewrite mapReduce_Vector_vnil.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
pure vnil vnil = Ƶ
      unfold_ops @Pure_subset @Monoid_unit_true.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
(vnil = vnil) = True
      now propext.
    -A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2) rewrite (Vector_surjective_pairing2 (v := v1)).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R (vcons n (Vector_hd v1) (Vector_tl v1)) v2 =
mapReduce (uncurry R)
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1)) v2)
      rewrite (Vector_surjective_pairing2 (v := v2)).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R (vcons n (Vector_hd v1) (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1))
     (vcons n (Vector_hd v2) (Vector_tl v2)))
      rewrite traverse_Vector_vcons.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1))
     (vcons n (Vector_hd v2) (Vector_tl v2)))
      rewrite Vector_zip_eq_vcons.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (vcons n (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
      rewrite mapReduce_Vector_vcons.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      unfold_ops @Monoid_op_and.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
(uncurry R (Vector_hd v1, Vector_hd v2) /\
 mapReduce (uncurry R)
   (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
      unfold uncurry at 1.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
(R (Vector_hd v1) (Vector_hd v2) /\
 mapReduce (uncurry R)
   (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
      rewrite subset_ap_spec.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) =
(R (Vector_hd v1) (Vector_hd v2) /\
 mapReduce (uncurry R)
   (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
      propext.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) ->
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) ->
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2)
      +A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) ->
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) intros [vcons' [vb [rest1 [rest2 rest3]]]].A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vcons': Vector n B -> Vector (S n) B
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
rest2: (pure (vcons n) <⋆> R (Vector_hd v1)) vcons'
rest3: vcons' vb =
vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        rewrite subset_ap_spec in rest2.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vcons': Vector n B -> Vector (S n) B
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
rest2: exists
  (f : B -> Vector n B -> Vector (S n) B) 
(a : B),
  R (Vector_hd v1) a /\
  pure (vcons n) f /\ f a = vcons'
rest3: vcons' vb =
vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        destruct rest2 as [f [a [rest4 [rest5 rest6]]]].A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vcons': Vector n B -> Vector (S n) B
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
f: B -> Vector n B -> Vector (S n) B
a: B
rest4: R (Vector_hd v1) a
rest5: pure (vcons n) f
rest6: f a = vcons'
rest3: vcons' vb =
vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        subst.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
f: B -> Vector n B -> Vector (S n) B
a: B
rest4: R (Vector_hd v1) a
rest5: pure (vcons n) f
rest3: f a vb = vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        unfold pure, Pure_subset in rest5.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
f: B -> Vector n B -> Vector (S n) B
a: B
rest4: R (Vector_hd v1) a
rest5: vcons n = f
rest3: f a vb = vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        subst.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
a: B
rest4: R (Vector_hd v1) a
rest3: vcons n a vb =
vcons n (Vector_hd v2) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        apply vcons_eq_inv_both in rest3.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
a: B
rest4: R (Vector_hd v1) a
rest3: a = Vector_hd v2 /\ vb = Vector_tl v2
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        destruct rest3 as [rest7 rest8].A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
vb: Vector n B
rest1: traverse R (Vector_tl v1) vb
a: B
rest4: R (Vector_hd v1) a
rest7: a = Vector_hd v2
rest8: vb = Vector_tl v2
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        subst.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        split.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
R (Vector_hd v1) (Vector_hd v2)
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
        *A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
R (Vector_hd v1) (Vector_hd v2) assumption.
        *A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) rewrite <- IHn.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
rest1: traverse R (Vector_tl v1) (Vector_tl v2)
rest4: R (Vector_hd v1) (Vector_hd v2)
traverse R (Vector_tl v1) (Vector_tl v2) assumption.
      +A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
R (Vector_hd v1) (Vector_hd v2) /\
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) ->
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2) intros [H_R_hd H_R_rest].A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2)
        exists (vcons (A := B) n (Vector_hd v2)).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
exists a : Vector n B,
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1))
    (vcons n (Vector_hd v2)) /\
  vcons n (Vector_hd v2) a =
  vcons n (Vector_hd v2) (Vector_tl v2)
        exists (Vector_tl v2).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
traverse R (Vector_tl v1) (Vector_tl v2) /\
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) /\
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2) split.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
traverse R (Vector_tl v1) (Vector_tl v2)
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) /\
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2)
        *A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
traverse R (Vector_tl v1) (Vector_tl v2) rewrite IHn.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) assumption.
        *A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) /\
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2) split.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2))
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2)
          {A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) rewrite subset_ap_spec.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
exists
  (f : B -> Vector n B -> Vector (S n) B) (a : B),
  R (Vector_hd v1) a /\
  pure (vcons n) f /\ f a = vcons n (Vector_hd v2)
            exists (vcons (A := B) n).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
exists a : B,
  R (Vector_hd v1) a /\
  pure (vcons n) (vcons n) /\
  vcons n a = vcons n (Vector_hd v2)
            exists (Vector_hd v2).A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
R (Vector_hd v1) (Vector_hd v2) /\
pure (vcons n) (vcons n) /\
vcons n (Vector_hd v2) = vcons n (Vector_hd v2)
            split.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
R (Vector_hd v1) (Vector_hd v2)
A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
pure (vcons n) (vcons n) /\
vcons n (Vector_hd v2) = vcons n (Vector_hd v2)
            assumption.A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
pure (vcons n) (vcons n) /\
vcons n (Vector_hd v2) = vcons n (Vector_hd v2) easy. }A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2)
          {A, B: Type
R: A -> B -> Prop
n: nat
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
H_R_hd: R (Vector_hd v1) (Vector_hd v2)
H_R_rest: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1)
     (Vector_tl v2))
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2) reflexivity. }
  Qed.

  Corollary traverse_zipped_diagonal {A R}:
    forall (n: nat) (v: Vector n A),
      traverse R v v =
        mapReduce (fun a => R a a) v.A: Type
R: A -> subset A
forall (n : nat) (v : Vector n A),
traverse R v v = mapReduce (fun a : A => R a a) v
  Proof.A: Type
R: A -> subset A
forall (n : nat) (v : Vector n A),
traverse R v v = mapReduce (fun a : A => R a a) v
    intros.A: Type
R: A -> subset A
n: nat
v: Vector n A
traverse R v v = mapReduce (fun a : A => R a a) v
    rewrite traverse_zipped_vector.A: Type
R: A -> subset A
n: nat
v: Vector n A
mapReduce (uncurry R) (Vector_zip_eq v v) =
mapReduce (fun a : A => R a a) v
    rewrite Vector_zip_diagonal.A: Type
R: A -> subset A
n: nat
v: Vector n A
mapReduce (uncurry R) (map (fun a : A => (a, a)) v) =
mapReduce (fun a : A => R a a) v
    compose near v on left.A: Type
R: A -> subset A
n: nat
v: Vector n A
(mapReduce (uncurry R) ∘ map (fun a : A => (a, a))) v =
mapReduce (fun a : A => R a a) v
    rewrite (mapReduce_map).A: Type
R: A -> subset A
n: nat
v: Vector n A
mapReduce (uncurry R ∘ (fun a : A => (a, a))) v =
mapReduce (fun a : A => R a a) v
    reflexivity.
  Qed.

End traverse_zipped_vector.

(** ** Generalized zip operation *)
(******************************************************************************)
Definition Vector_zip
  (A B: Type) (n m: nat)
  (v1: Vector n A)
  (v2: Vector m B)
  (Heq: n = m): Vector n (A * B) :=
  Vector_zip_eq v1 (coerce (eq_sym Heq) in v2).

(* This verison is less convenient than the above one in some
 respects because it cannot reduce unless the proof of equality is
 eq_refl. *)
Definition Vector_zip_alt
  (A B: Type) (n m: nat)
  (v1: Vector n A)
  (v2: Vector m B)
  (Heq: n = m): Vector n (A * B) :=
    (match Heq in (_ = m) return Vector m B -> Vector n (A * B) with
     | eq_refl => Vector_zip_eq v1
     end) v2.

Lemma Vector_zip_eq_spec:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B),
    Vector_zip_eq v1 v2 =
      Vector_zip A B n n v1 v2 eq_refl.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
Vector_zip_eq v1 v2 = Vector_zip A B n n v1 v2 eq_refl
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B),
Vector_zip_eq v1 v2 = Vector_zip A B n n v1 v2 eq_refl
  intros.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Vector_zip_eq v1 v2 = Vector_zip A B n n v1 v2 eq_refl
  unfold Vector_zip.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Vector_zip_eq v1 v2 =
Vector_zip_eq v1 (coerce eq_sym eq_refl in v2)
  change (@eq_sym nat n n (@eq_refl nat n))
    with (@eq_refl nat n).A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Vector_zip_eq v1 v2 =
Vector_zip_eq v1 (coerce eq_refl in v2)
  rewrite coerce_Vector_eq_refl.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Vector_zip_eq v1 v2 = Vector_zip_eq v1 v2
  reflexivity.
Qed.

(* This lemma is not (apparently?) provable for Vector_zip_alt.
It is only provable here because the applied lemmas already depend on proof irrelevance internally *)
Lemma Vector_zip_proof_irrelevance:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector m B)
    (Heq1: n = m)
    (Heq2: n = m),
    Vector_zip A B n m v1 v2 Heq1 =
      Vector_zip A B n m v1 v2 Heq2.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq1 Heq2 : n = m),
Vector_zip A B n m v1 v2 Heq1 =
Vector_zip A B n m v1 v2 Heq2
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq1 Heq2 : n = m),
Vector_zip A B n m v1 v2 Heq1 =
Vector_zip A B n m v1 v2 Heq2
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
Vector_zip A B n m v1 v2 Heq1 =
Vector_zip A B n m v1 v2 Heq2
  unfold Vector_zip.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
Vector_zip_eq v1 (coerce eq_sym Heq1 in v2) =
Vector_zip_eq v1 (coerce eq_sym Heq2 in v2)
  apply Vector_zip_eq_sim2.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
coerce eq_sym Heq1 in v2 ~~ coerce eq_sym Heq2 in v2
  apply (transitive_Vector_sim (v2 := v2)).A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
coerce eq_sym Heq1 in v2 ~~ v2
A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
v2 ~~ coerce eq_sym Heq2 in v2
  apply Vector_coerce_sim_l.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq1, Heq2: n = m
v2 ~~ coerce eq_sym Heq2 in v2
  apply Vector_coerce_sim_r.
Qed.

Lemma Vector_zip_proof_irrelevance2:
  forall (A B: Type) (n: nat)
    (v1: Vector n A)
    (v2: Vector n B)
    (Heq: n = n),
    Vector_zip A B n n v1 v2 Heq =
      Vector_zip_eq v1 v2.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (Heq : n = n),
Vector_zip A B n n v1 v2 Heq = Vector_zip_eq v1 v2
Proof.forall (A B : Type) (n : nat) (v1 : Vector n A)
  (v2 : Vector n B) (Heq : n = n),
Vector_zip A B n n v1 v2 Heq = Vector_zip_eq v1 v2
  intros.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Heq: n = n
Vector_zip A B n n v1 v2 Heq = Vector_zip_eq v1 v2
  unfold Vector_zip.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Heq: n = n
Vector_zip_eq v1 (coerce eq_sym Heq in v2) =
Vector_zip_eq v1 v2
  apply Vector_zip_eq_sim2.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
Heq: n = n
coerce eq_sym Heq in v2 ~~ v2
  apply Vector_coerce_sim_l.
Qed.

Lemma Vector_zip_fst:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector m B)
    (Heq: n = m),
    map fst (Vector_zip A B n m v1 v2 Heq) = v1.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m),
map fst (Vector_zip A B n m v1 v2 Heq) = v1
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m),
map fst (Vector_zip A B n m v1 v2 Heq) = v1
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq: n = m
map fst (Vector_zip A B n m v1 v2 Heq) = v1
  subst.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
map fst (Vector_zip A B m m v1 v2 eq_refl) = v1
  apply Vector_zip_eq_fst.
Qed.

Lemma Vector_zip_snd:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector m B)
    (Heq: n = m),
    map snd (Vector_zip A B n m v1 v2 Heq) ~~ v2.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m),
map snd (Vector_zip A B n m v1 v2 Heq) ~~ v2
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m),
map snd (Vector_zip A B n m v1 v2 Heq) ~~ v2
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq: n = m
map snd (Vector_zip A B n m v1 v2 Heq) ~~ v2
  subst.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
map snd (Vector_zip A B m m v1 v2 eq_refl) ~~ v2
  rewrite <- Vector_zip_eq_spec.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
map snd (Vector_zip_eq v1 v2) ~~ v2
  rewrite Vector_zip_eq_snd.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
v2 ~~ v2
  reflexivity.
Qed.

Lemma Vector_zip_vcons1:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector m B)
    (Heq: n = m)
    (a: A) (b: B),
    Vector_zip A B (S n) (S m)
      (vcons n a v1) (vcons m b v2) (f_equal S Heq) =
      vcons n (a, b) (Vector_zip A B n m v1 v2 Heq).forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m) (a : A) (b : B),
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) (f_equal S Heq) =
vcons n (a, b) (Vector_zip A B n m v1 v2 Heq)
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : n = m) (a : A) (b : B),
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) (f_equal S Heq) =
vcons n (a, b) (Vector_zip A B n m v1 v2 Heq)
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq: n = m
a: A
b: B
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) (f_equal S Heq) =
vcons n (a, b) (Vector_zip A B n m v1 v2 Heq) destruct Heq.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
Vector_zip A B (S n) (S n) (vcons n a v1)
  (vcons n b v2) (f_equal S eq_refl) =
vcons n (a, b) (Vector_zip A B n n v1 v2 eq_refl)
  rewrite <- Vector_zip_eq_spec.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
Vector_zip_eq (vcons n a v1) (vcons n b v2) =
vcons n (a, b) (Vector_zip A B n n v1 v2 eq_refl)
  rewrite Vector_zip_proof_irrelevance2.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
Vector_zip_eq (vcons n a v1) (vcons n b v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
v1: Vector n A
v2: Vector n B
a: A
b: B
vcons n (a, b) (Vector_zip_eq v1 v2) =
vcons n (a, b) (Vector_zip_eq v1 v2)
  reflexivity.
Qed.

Lemma Vector_zip_vcons2:
  forall (A B: Type) (n m: nat)
    (v1: Vector n A)
    (v2: Vector m B)
    (Heq: S n = S m)
    (a: A) (b: B),
    Vector_zip A B (S n) (S m)
      (vcons n a v1) (vcons m b v2) Heq =
      vcons n (a, b) (Vector_zip A B n m v1 v2 (S_uncons Heq)).forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : S n = S m) (a : A) (b : B),
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) Heq =
vcons n (a, b)
  (Vector_zip A B n m v1 v2 (S_uncons Heq))
Proof.forall (A B : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m B) (Heq : S n = S m) (a : A) (b : B),
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) Heq =
vcons n (a, b)
  (Vector_zip A B n m v1 v2 (S_uncons Heq))
  intros.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq: S n = S m
a: A
b: B
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) Heq =
vcons n (a, b)
  (Vector_zip A B n m v1 v2 (S_uncons Heq))
  inversion Heq.A, B: Type
n, m: nat
v1: Vector n A
v2: Vector m B
Heq: S n = S m
a: A
b: B
H0: n = m
Vector_zip A B (S n) (S m) (vcons n a v1)
  (vcons m b v2) Heq =
vcons n (a, b)
  (Vector_zip A B n m v1 v2 (S_uncons Heq))
  subst.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
Heq: S m = S m
a: A
b: B
Vector_zip A B (S m) (S m) (vcons m a v1)
  (vcons m b v2) Heq =
vcons m (a, b)
  (Vector_zip A B m m v1 v2 (S_uncons Heq))
  rewrite Vector_zip_proof_irrelevance2.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
Heq: S m = S m
a: A
b: B
Vector_zip_eq (vcons m a v1) (vcons m b v2) =
vcons m (a, b)
  (Vector_zip A B m m v1 v2 (S_uncons Heq))
  rewrite Vector_zip_proof_irrelevance2.A, B: Type
m: nat
v1: Vector m A
v2: Vector m B
Heq: S m = S m
a: A
b: B
Vector_zip_eq (vcons m a v1) (vcons m b v2) =
vcons m (a, b) (Vector_zip_eq v1 v2)
  apply Vector_zip_eq_vcons.
Qed.

(** ** Relating vectors *)
(******************************************************************************)
Lemma vcons_eq_inv: forall (n: nat) (A: Type) (a1 a2: A) (v1 v2: Vector n A),
    vcons n a1 v1 = vcons n a2 v2 ->
    a1 = a2 /\ v1 = v2.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2 /\ v1 = v2
Proof.forall (n : nat) (A : Type) (a1 a2 : A)
  (v1 v2 : Vector n A),
vcons n a1 v1 = vcons n a2 v2 -> a1 = a2 /\ v1 = v2
  intros.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
a1 = a2 /\ v1 = v2
  assert (proj1_sig (vcons n a1 v1) = proj1_sig (vcons n a2 v2)).n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
proj1_sig (vcons n a1 v1) = proj1_sig (vcons n a2 v2)
n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: proj1_sig (vcons n a1 v1) =
proj1_sig (vcons n a2 v2)
a1 = a2 /\ v1 = v2
  {n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
proj1_sig (vcons n a1 v1) = proj1_sig (vcons n a2 v2) now rewrite H. }n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: proj1_sig (vcons n a1 v1) =
proj1_sig (vcons n a2 v2)
a1 = a2 /\ v1 = v2
  rewrite proj_vcons in *.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = proj1_sig (vcons n a2 v2)
a1 = a2 /\ v1 = v2
  rewrite proj_vcons in *.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
a1 = a2 /\ v1 = v2
  inversion H0.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
H2: a1 = a2
H3: proj1_sig v1 = proj1_sig v2
a2 = a2 /\ v1 = v2 split.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
H2: a1 = a2
H3: proj1_sig v1 = proj1_sig v2
a2 = a2
n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
H2: a1 = a2
H3: proj1_sig v1 = proj1_sig v2
v1 = v2 auto.n: nat
A: Type
a1, a2: A
v1, v2: Vector n A
H: vcons n a1 v1 = vcons n a2 v2
H0: a1 :: proj1_sig v1 = a2 :: proj1_sig v2
H2: a1 = a2
H3: proj1_sig v1 = proj1_sig v2
v1 = v2
  apply Vector_sim_eq; auto.
Qed.

Lemma Forall_zip_spec:
  forall (A B: Type) (n: nat) (R: A -> B -> Prop)
    (v1: Vector n A) (v2: Vector n B),
    traverse (G := subset) (T := Vector n) R v1 v2 =
      mapReduce (M := Prop)
        (op := Monoid_op_and) (unit := Monoid_unit_true)
        (uncurry R) (Vector_zip_eq v1 v2).forall (A B : Type) (n : nat) (R : A -> B -> Prop)
  (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
Proof.forall (A B : Type) (n : nat) (R : A -> B -> Prop)
  (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
  intros.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector n A
v2: Vector n B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
  induction n.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2)
  -A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2) rewrite (Vector_nil_eq v1).A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R vnil v2 =
mapReduce (uncurry R) (Vector_zip_eq vnil v2)
    rewrite (Vector_nil_eq v2).A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
traverse R vnil vnil =
mapReduce (uncurry R) (Vector_zip_eq vnil vnil)
    cbn.A, B: Type
R: A -> B -> Prop
v1: Vector 0 A
v2: Vector 0 B
pure
  (exist (fun l : list B => length l = 0) nil eq_refl)
  vnil =
pure
  (exist (fun l : list False => length l = 0) nil
     eq_refl) propext; easy.
  -A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R v1 v2 =
mapReduce (uncurry R) (Vector_zip_eq v1 v2) rewrite (Vector_surjective_pairing2 (v := v1)).A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R (vcons n (Vector_hd v1) (Vector_tl v1)) v2 =
mapReduce (uncurry R)
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1)) v2)
    rewrite (Vector_surjective_pairing2 (v := v2)).A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R (vcons n (Vector_hd v1) (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (Vector_zip_eq
     (vcons n (Vector_hd v1) (Vector_tl v1))
     (vcons n (Vector_hd v2) (Vector_tl v2)))
    rewrite Vector_zip_eq_vcons.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
traverse R (vcons n (Vector_hd v1) (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (vcons n (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
    rewrite traverse_Vector_vcons.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
mapReduce (uncurry R)
  (vcons n (Vector_hd v1, Vector_hd v2)
     (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)))
    rewrite mapReduce_Vector_vcons.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(pure (vcons n) <⋆> R (Vector_hd v1) <⋆>
 traverse R (Vector_tl v1))
  (vcons n (Vector_hd v2) (Vector_tl v2)) =
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
    rewrite subset_ap_spec.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) =
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
    propext.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) ->
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) ->
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2)
    +A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
(exists
   (f : Vector n B -> Vector (S n) B) (a : Vector n B),
   traverse R (Vector_tl v1) a /\
   (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
   f a = vcons n (Vector_hd v2) (Vector_tl v2)) ->
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) intros [f_vcons [a_hdv2 [hyp1 [hyp2 hyp3]]]].A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
f_vcons: Vector n B -> Vector (S n) B
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
hyp2: (pure (vcons n) <⋆> R (Vector_hd v1)) f_vcons
hyp3: f_vcons a_hdv2 =
vcons n (Vector_hd v2) (Vector_tl v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      rewrite <- map_to_ap in hyp2.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
f_vcons: Vector n B -> Vector (S n) B
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
hyp2: map (vcons n) (R (Vector_hd v1)) f_vcons
hyp3: f_vcons a_hdv2 =
vcons n (Vector_hd v2) (Vector_tl v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      unfold map, Map_subset in hyp2.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
f_vcons: Vector n B -> Vector (S n) B
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
hyp2: exists a : B,
  R (Vector_hd v1) a /\ vcons n a = f_vcons
hyp3: f_vcons a_hdv2 =
vcons n (Vector_hd v2) (Vector_tl v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      destruct hyp2 as [b [hyp21 hyp22]].A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
f_vcons: Vector n B -> Vector (S n) B
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
b: B
hyp21: R (Vector_hd v1) b
hyp22: vcons n b = f_vcons
hyp3: f_vcons a_hdv2 =
vcons n (Vector_hd v2) (Vector_tl v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      subst.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
b: B
hyp21: R (Vector_hd v1) b
hyp3: vcons n b a_hdv2 =
vcons n (Vector_hd v2) (Vector_tl v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      apply vcons_eq_inv in hyp3.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
a_hdv2: Vector n B
hyp1: traverse R (Vector_tl v1) a_hdv2
b: B
hyp21: R (Vector_hd v1) b
hyp3: b = Vector_hd v2 /\ a_hdv2 = Vector_tl v2
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      destruct hyp3; subst.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: traverse R (Vector_tl v1) (Vector_tl v2)
hyp21: R (Vector_hd v1) (Vector_hd v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
      rewrite <- IHn.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: traverse R (Vector_tl v1) (Vector_tl v2)
hyp21: R (Vector_hd v1) (Vector_hd v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● traverse R (Vector_tl v1) (Vector_tl v2)
      split; auto.
    +A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
uncurry R (Vector_hd v1, Vector_hd v2)
● mapReduce (uncurry R)
    (Vector_zip_eq (Vector_tl v1) (Vector_tl v2)) ->
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2) intros [hyp1 hyp2].A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: mapReduce (uncurry R)
  (Vector_zip_eq (Vector_tl v1) (Vector_tl v2))
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2)
      rewrite <- IHn in hyp2.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
exists
  (f : Vector n B -> Vector (S n) B) (a : Vector n B),
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1)) f /\
  f a = vcons n (Vector_hd v2) (Vector_tl v2)
      exists (vcons n (Vector_hd v2)).A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
exists a : Vector n B,
  traverse R (Vector_tl v1) a /\
  (pure (vcons n) <⋆> R (Vector_hd v1))
    (vcons n (Vector_hd v2)) /\
  vcons n (Vector_hd v2) a =
  vcons n (Vector_hd v2) (Vector_tl v2)
      exists (Vector_tl v2).A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
traverse R (Vector_tl v1) (Vector_tl v2) /\
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) /\
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2) split; auto.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) /\
vcons n (Vector_hd v2) (Vector_tl v2) =
vcons n (Vector_hd v2) (Vector_tl v2)
      split; auto.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
(pure (vcons n) <⋆> R (Vector_hd v1))
  (vcons n (Vector_hd v2)) rewrite <- map_to_ap.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
map (vcons n) (R (Vector_hd v1))
  (vcons n (Vector_hd v2))
      unfold_ops @Map_subset.A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
exists a : B,
  R (Vector_hd v1) a /\
  vcons n a = vcons n (Vector_hd v2)
      exists (Vector_hd v2).A, B: Type
n: nat
R: A -> B -> Prop
v1: Vector (S n) A
v2: Vector (S n) B
IHn: forall (v1 : Vector n A) (v2 : Vector n B),
traverse R v1 v2 = mapReduce (uncurry R) (Vector_zip_eq v1 v2)
hyp1: uncurry R (Vector_hd v1, Vector_hd v2)
hyp2: traverse R (Vector_tl v1) (Vector_tl v2)
R (Vector_hd v1) (Vector_hd v2) /\
vcons n (Vector_hd v2) = vcons n (Vector_hd v2) auto.
Qed.

(** * Appending Vectors *)
(******************************************************************************)
Definition Vector_append:
  forall {A: Type} {n m: nat} (v1: Vector n A) (v2: Vector m A),
    Vector (n + m) A.forall (A : Type) (n m : nat),
Vector n A -> Vector m A -> Vector (n + m) A
Proof.forall (A : Type) (n m : nat),
Vector n A -> Vector m A -> Vector (n + m) A
  intros.A: Type
n, m: nat
v1: Vector n A
v2: Vector m A
Vector (n + m) A
  destruct v1 as [l1 H1].A: Type
n, m: nat
l1: list A
H1: length l1 = n
v2: Vector m A
Vector (n + m) A
  destruct v2 as [l2 H2].A: Type
n, m: nat
l1: list A
H1: length l1 = n
l2: list A
H2: length l2 = m
Vector (n + m) A
  exists (l1 ++ l2).A: Type
n, m: nat
l1: list A
H1: length l1 = n
l2: list A
H2: length l2 = m
length (l1 ++ l2) = (n + m)%nat
  rewrite List.app_length.A: Type
n, m: nat
l1: list A
H1: length l1 = n
l2: list A
H2: length l2 = m
(length l1 + length l2)%nat = (n + m)%nat
  subst.A: Type
l1, l2: list A
(length l1 + length l2)%nat =
(length l1 + length l2)%nat
  reflexivity.
Defined.

Lemma Vector_append_vnil_l: forall (A: Type) (n: nat) (v: Vector n A),
    Vector_append vnil v ~~ v.forall (A : Type) (n : nat) (v : Vector n A),
Vector_append vnil v ~~ v
Proof.forall (A : Type) (n : nat) (v : Vector n A),
Vector_append vnil v ~~ v
  intros.A: Type
n: nat
v: Vector n A
Vector_append vnil v ~~ v
  unfold Vector_sim.A: Type
n: nat
v: Vector n A
proj1_sig (Vector_append vnil v) = proj1_sig v
  destruct v as [l Hlen].A: Type
n: nat
l: list A
Hlen: length l = n
proj1_sig
  (Vector_append vnil
     (exist (fun l : list A => length l = n) l Hlen)) =
proj1_sig
  (exist (fun l : list A => length l = n) l Hlen)
  reflexivity.
Qed.

Lemma Vector_append_vnil_r: forall (A: Type) (n: nat) (v: Vector n A),
    Vector_append v vnil ~~ v.forall (A : Type) (n : nat) (v : Vector n A),
Vector_append v vnil ~~ v
Proof.forall (A : Type) (n : nat) (v : Vector n A),
Vector_append v vnil ~~ v
  intros.A: Type
n: nat
v: Vector n A
Vector_append v vnil ~~ v
  unfold Vector_sim.A: Type
n: nat
v: Vector n A
proj1_sig (Vector_append v vnil) = proj1_sig v
  destruct v as [l Hlen].A: Type
n: nat
l: list A
Hlen: length l = n
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l Hlen)
     vnil) =
proj1_sig
  (exist (fun l : list A => length l = n) l Hlen)
  cbn.A: Type
n: nat
l: list A
Hlen: length l = n
l ++ nil = l
  now rewrite List.app_nil_end.
Qed.

Lemma Vector_append_assoc:
  forall (A: Type) (n m p: nat)
    (v1: Vector n A)
    (v2: Vector m A)
    (v3: Vector p A),
    Vector_append (Vector_append v1 v2) v3 ~~
      Vector_append v1 (Vector_append v2 v3).forall (A : Type) (n m p : nat) (v1 : Vector n A)
  (v2 : Vector m A) (v3 : Vector p A),
Vector_append (Vector_append v1 v2) v3 ~~
Vector_append v1 (Vector_append v2 v3)
Proof.forall (A : Type) (n m p : nat) (v1 : Vector n A)
  (v2 : Vector m A) (v3 : Vector p A),
Vector_append (Vector_append v1 v2) v3 ~~
Vector_append v1 (Vector_append v2 v3)
  intros.A: Type
n, m, p: nat
v1: Vector n A
v2: Vector m A
v3: Vector p A
Vector_append (Vector_append v1 v2) v3 ~~
Vector_append v1 (Vector_append v2 v3)
  unfold Vector_sim.A: Type
n, m, p: nat
v1: Vector n A
v2: Vector m A
v3: Vector p A
proj1_sig (Vector_append (Vector_append v1 v2) v3) =
proj1_sig (Vector_append v1 (Vector_append v2 v3))
  destruct v1 as [l1 Hlen1].A: Type
n, m, p: nat
l1: list A
Hlen1: length l1 = n
v2: Vector m A
v3: Vector p A
proj1_sig
  (Vector_append
     (Vector_append
        (exist (fun l : list A => length l = n) l1
           Hlen1) v2) v3) =
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l1 Hlen1)
     (Vector_append v2 v3))
  destruct v2 as [l2 Hlen2].A: Type
n, m, p: nat
l1: list A
Hlen1: length l1 = n
l2: list A
Hlen2: length l2 = m
v3: Vector p A
proj1_sig
  (Vector_append
     (Vector_append
        (exist (fun l : list A => length l = n) l1
           Hlen1)
        (exist (fun l : list A => length l = m) l2
           Hlen2)) v3) =
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l1 Hlen1)
     (Vector_append
        (exist (fun l : list A => length l = m) l2
           Hlen2) v3))
  destruct v3 as [l3 Hlen3].A: Type
n, m, p: nat
l1: list A
Hlen1: length l1 = n
l2: list A
Hlen2: length l2 = m
l3: list A
Hlen3: length l3 = p
proj1_sig
  (Vector_append
     (Vector_append
        (exist (fun l : list A => length l = n) l1
           Hlen1)
        (exist (fun l : list A => length l = m) l2
           Hlen2))
     (exist (fun l : list A => length l = p) l3 Hlen3)) =
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l1 Hlen1)
     (Vector_append
        (exist (fun l : list A => length l = m) l2
           Hlen2)
        (exist (fun l : list A => length l = p) l3
           Hlen3)))
  cbn.A: Type
n, m, p: nat
l1: list A
Hlen1: length l1 = n
l2: list A
Hlen2: length l2 = m
l3: list A
Hlen3: length l3 = p
(l1 ++ l2) ++ l3 = l1 ++ l2 ++ l3
  now rewrite List.app_assoc.
Qed.

Lemma proj_Vector_append:
  forall {A: Type} {n m: nat} (v1: Vector n A) (v2: Vector m A),
    proj1_sig (Vector_append v1 v2) =
      proj1_sig v1 ++ proj1_sig v2.forall (A : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m A),
proj1_sig (Vector_append v1 v2) =
proj1_sig v1 ++ proj1_sig v2
Proof.forall (A : Type) (n m : nat) (v1 : Vector n A)
  (v2 : Vector m A),
proj1_sig (Vector_append v1 v2) =
proj1_sig v1 ++ proj1_sig v2
  intros.A: Type
n, m: nat
v1: Vector n A
v2: Vector m A
proj1_sig (Vector_append v1 v2) =
proj1_sig v1 ++ proj1_sig v2
  destruct v1 as [l1 Hlen1].A: Type
n, m: nat
l1: list A
Hlen1: length l1 = n
v2: Vector m A
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l1 Hlen1)
     v2) =
proj1_sig
  (exist (fun l : list A => length l = n) l1 Hlen1) ++
proj1_sig v2
  destruct v2 as [l2 Hlen2].A: Type
n, m: nat
l1: list A
Hlen1: length l1 = n
l2: list A
Hlen2: length l2 = m
proj1_sig
  (Vector_append
     (exist (fun l : list A => length l = n) l1 Hlen1)
     (exist (fun l : list A => length l = m) l2 Hlen2)) =
proj1_sig
  (exist (fun l : list A => length l = n) l1 Hlen1) ++
proj1_sig
  (exist (fun l : list A => length l = m) l2 Hlen2)
  reflexivity.
Qed.

(** * Reversing Vectors *)
(******************************************************************************)
Lemma reverse_Vector
  {A: Type} {n: nat} (v: Vector n A): Vector n A.A: Type
n: nat
v: Vector n A
Vector n A
Proof.A: Type
n: nat
v: Vector n A
Vector n A
  destruct v as [l len].A: Type
n: nat
l: list A
len: length l = n
Vector n A
  exists (List.rev l).A: Type
n: nat
l: list A
len: length l = n
length (List.rev l) = n
  rewrite List.rev_length.A: Type
n: nat
l: list A
len: length l = n
length l = n
  assumption.
Defined.

Lemma proj_reverse_Vector
  {A: Type} {n: nat} (v: Vector n A):
  proj1_sig (reverse_Vector v) =
    List.rev (proj1_sig v).A: Type
n: nat
v: Vector n A
proj1_sig (reverse_Vector v) = List.rev (proj1_sig v)
Proof.A: Type
n: nat
v: Vector n A
proj1_sig (reverse_Vector v) = List.rev (proj1_sig v)
  now destruct v.
Qed.

(** * Notations *)
(******************************************************************************)
Module Notations.
  #[global] Infix "~~" := (Vector_sim) (at level 30).
  #[global] Infix "~!~" := (Vector_fun_sim) (at level 30).
End Notations.