From Tealeaves Require Export
  Classes.Monoid
  Classes.Categorical.Applicative
  Classes.Categorical.Monad
  Classes.Categorical.ShapelyFunctor
  Classes.Kleisli.TraversableFunctor
  Functors.Early.Batch.

From Tealeaves.Functors Require Import
  Early.List
  Constant
  VectorRefinement.

Import Early.Batch.Notations.
Import Monoid.Notations.
Import Applicative.Notations.
Import Kleisli.TraversableFunctor.Notations.
Import VectorRefinement.Notations.

#[local] Generalizable Variables ψ ϕ W F G M A B C D X Y O.
#[local] Arguments map F%function_scope {Map} {A B}%type_scope f%function_scope _.
#[local] Arguments ret T%function_scope {Return} (A)%type_scope _.
#[local] Arguments pure F%function_scope {Pure} {A}%type_scope _.
#[local] Arguments mult F%function_scope {Mult} {A B}%type_scope _.

(** * <<mapReduce>> Rewriting Lemmas *)
(******************************************************************************)
Section Batch_mapReduce_rewriting.

  Context {A B C: Type}.

  Lemma mapReduce_Batch_rw2:
    forall `{Monoid M}
      (f: A -> M) (a: A) (rest: Batch A B (B -> C)),
      mapReduce (T := BATCH1 B C) f (rest ⧆ a) =
        mapReduce f rest ● f a.
A, B, C: Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (a : A)
  (rest : Batch A B (B -> C)),
mapReduce f (rest ⧆ a) = mapReduce f rest ● f a
  Proof.
A, B, C: Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (a : A)
  (rest : Batch A B (B -> C)),
mapReduce f (rest ⧆ a) = mapReduce f rest ● f a
    intros.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
a: A
rest: Batch A B (B -> C)
mapReduce f (rest ⧆ a) = mapReduce f rest ● f a
    unfold mapReduce.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
a: A
rest: Batch A B (B -> C)
traverse f (rest ⧆ a) = traverse f rest ● f a
    rewrite traverse_Batch_rw2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
a: A
rest: Batch A B (B -> C)
map (const M) Step (traverse f rest) <⋆> f a =
traverse f rest ● f a
    reflexivity.
  Qed.

End Batch_mapReduce_rewriting.

(** ** <<mapReduce>> Rewriting for << <⋆> >> *)
(******************************************************************************)
Lemma mapReduce_Batch_map {A B C C': Type}:
  forall `{Monoid M}
    (f: A -> M)
    (g: C -> C')
    (b: Batch A B C),
    mapReduce (T := BATCH1 B C) f b =
      mapReduce (T := BATCH1 B C') f (map (Batch A B) g b).
A, B, C, C': Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (g : C -> C') (b : Batch A B C),
mapReduce f b = mapReduce f (map (Batch A B) g b)
Proof.
A, B, C, C': Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (g : C -> C') (b : Batch A B C),
mapReduce f b = mapReduce f (map (Batch A B) g b)
  intros.
A, B, C, C', M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
g: C -> C'
b: Batch A B C
mapReduce f b = mapReduce f (map (Batch A B) g b)
  generalize dependent C'.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b: Batch A B C
forall (C' : Type) (g : C -> C'),
mapReduce f b = mapReduce f (map (Batch A B) g b)
  induction b; intros.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C': Type
g: C -> C'
mapReduce f (Done c) =
mapReduce f (map (Batch A B) g (Done c))
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (g : (B -> C) -> C'),
mapReduce f b =
mapReduce f (map (Batch A B) g b)
C': Type
g: C -> C'
mapReduce f (b ⧆ a) =
mapReduce f (map (Batch A B) g (b ⧆ a))
  -
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C': Type
g: C -> C'
mapReduce f (Done c) =
mapReduce f (map (Batch A B) g (Done c)) reflexivity.
  -
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (g : (B -> C) -> C'),
mapReduce f b =
mapReduce f (map (Batch A B) g b)
C': Type
g: C -> C'
mapReduce f (b ⧆ a) =
mapReduce f (map (Batch A B) g (b ⧆ a)) rewrite mapReduce_Batch_rw2.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (g : (B -> C) -> C'),
mapReduce f b =
mapReduce f (map (Batch A B) g b)
C': Type
g: C -> C'
mapReduce f b ● f a =
mapReduce f (map (Batch A B) g (b ⧆ a))
    rewrite map_Batch_rw2.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (g : (B -> C) -> C'),
mapReduce f b =
mapReduce f (map (Batch A B) g b)
C': Type
g: C -> C'
mapReduce f b ● f a =
mapReduce f (map (Batch A B) (compose g) b ⧆ a)
    rewrite mapReduce_Batch_rw2.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (g : (B -> C) -> C'),
mapReduce f b =
mapReduce f (map (Batch A B) g b)
C': Type
g: C -> C'
mapReduce f b ● f a =
mapReduce f (map (Batch A B) (compose g) b) ● f a
    specialize (IHb _ (compose g)).
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
C': Type
g: C -> C'
IHb: mapReduce f b =
mapReduce f (map (Batch A B) (compose g) b)
mapReduce f b ● f a =
mapReduce f (map (Batch A B) (compose g) b) ● f a
    rewrite IHb.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b: Batch A B (B -> C)
a: A
C': Type
g: C -> C'
IHb: mapReduce f b =
mapReduce f (map (Batch A B) (compose g) b)
mapReduce f (map (Batch A B) (compose g) b) ● f a =
mapReduce f (map (Batch A B) (compose g) b) ● f a
    reflexivity.
Qed.

Lemma mapReduce_Batch_mult_Done {A B C D: Type}
  `{Monoid M}(f: A -> M):
  forall (c: C) (b2: Batch A B D),
    mapReduce (T := BATCH1 B (C * D))
      f (Done c ⊗ b2) = mapReduce f b2.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
forall (c : C) (b2 : Batch A B D),
mapReduce f (Done c ⊗ b2) = mapReduce f b2
Proof.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
forall (c : C) (b2 : Batch A B D),
mapReduce f (Done c ⊗ b2) = mapReduce f b2
  intros.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
b2: Batch A B D
mapReduce f (Done c ⊗ b2) = mapReduce f b2
  induction b2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
c0: C0
mapReduce f (Done c ⊗ Done c0) = mapReduce f (Done c0)
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f (Done c ⊗ (b2 ⧆ a)) = mapReduce f (b2 ⧆ a)
  -
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
c0: C0
mapReduce f (Done c ⊗ Done c0) = mapReduce f (Done c0) reflexivity.
  -
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f (Done c ⊗ (b2 ⧆ a)) = mapReduce f (b2 ⧆ a) rewrite mapReduce_Batch_rw2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f (Done c ⊗ (b2 ⧆ a)) = mapReduce f b2 ● f a
    rewrite <- IHb2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f (Done c ⊗ (b2 ⧆ a)) =
mapReduce f (Done c ⊗ b2) ● f a
    cbn.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
(pure (const M) Step
 ● Traverse_Batch1 B (B -> C * C0) (const M) Map_const
     Pure_const Mult_const A False f
     (map (Batch A B) strength_arrow
        (mult_Batch (Done c) b2))) ● f a =
mapReduce f (mult_Batch (Done c) b2) ● f a
    unfold_ops @Pure_const.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
(Ƶ
 ● Traverse_Batch1 B (B -> C * C0) (const M) Map_const
     (fun (X : Type) (_ : X) => Ƶ) Mult_const A False
     f
     (map (Batch A B) strength_arrow
        (mult_Batch (Done c) b2))) ● f a =
mapReduce f (mult_Batch (Done c) b2) ● f a
    rewrite monoid_id_l.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
Traverse_Batch1 B (B -> C * C0) (const M) Map_const
  (fun (X : Type) (_ : X) => Ƶ) Mult_const A False f
  (map (Batch A B) strength_arrow
     (mult_Batch (Done c) b2)) ● f a =
mapReduce f (mult_Batch (Done c) b2) ● f a
    change (Traverse_Batch1 B (B -> C * C0) (const M) Map_const
              (fun (X : Type) (_ : X) => Ƶ) Mult_const A False f)
      with (mapReduce (T := BATCH1 B (B -> C * C0)) f).
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f
  (map (Batch A B) strength_arrow
     (mult_Batch (Done c) b2)) ● f a =
mapReduce f (mult_Batch (Done c) b2) ● f a
    rewrite <- mapReduce_Batch_map.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (Done c ⊗ b2) = mapReduce f b2
mapReduce f (mult_Batch (Done c) b2) ● f a =
mapReduce f (mult_Batch (Done c) b2) ● f a
    reflexivity.
Qed.

Lemma mapReduce_Batch_mult {A B C D: Type}
  `{Monoid M}(f: A -> M):
  forall (b1: Batch A B C) (b2: Batch A B D),
    mapReduce (T := BATCH1 B (C * D))
      f (b1 ⊗ b2) =
      mapReduce f b1 ● mapReduce f b2.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
forall (b1 : Batch A B C) (b2 : Batch A B D),
mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
Proof.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
forall (b1 : Batch A B C) (b2 : Batch A B D),
mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
  intros.
A, B, C, D, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
b2: Batch A B D
mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
  induction b2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f (b1 ⊗ Done c) =
mapReduce f b1 ● mapReduce f (Done c)
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f b1 ● mapReduce f (b2 ⧆ a)
  -
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f (b1 ⊗ Done c) =
mapReduce f b1 ● mapReduce f (Done c) cbn.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f
  (map (Batch A B) (fun c0 : C => (c0, c)) b1) =
mapReduce f b1 ● pure (const M) (Done c)
    rewrite <- mapReduce_Batch_map.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f b1 =
mapReduce f b1 ● pure (const M) (Done c)
    unfold_ops @Pure_const.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f b1 = mapReduce f b1 ● Ƶ
    rewrite monoid_id_r.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
c: C0
mapReduce f b1 = mapReduce f b1
    reflexivity.
  -
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f b1 ● mapReduce f (b2 ⧆ a) rewrite mapReduce_Batch_rw2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f b1 ● (mapReduce f b2 ● f a)
    rewrite <- monoid_assoc.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb2: mapReduce f (b1 ⊗ b2) =
mapReduce f b1 ● mapReduce f b2
mapReduce f (b1 ⊗ (b2 ⧆ a)) =
(mapReduce f b1 ● mapReduce f b2) ● f a
    rewrite <- IHb2; clear IHb2.
A, B, C, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
b1: Batch A B C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
    induction b1.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f (Done c ⊗ (b2 ⧆ a)) =
mapReduce f (Done c ⊗ b2) ● f a
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
mapReduce f ((b1 ⧆ a0) ⊗ (b2 ⧆ a)) =
mapReduce f ((b1 ⧆ a0) ⊗ b2) ● f a
    +
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f (Done c ⊗ (b2 ⧆ a)) =
mapReduce f (Done c ⊗ b2) ● f a rewrite mapReduce_Batch_mult_Done.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f (b2 ⧆ a) = mapReduce f (Done c ⊗ b2) ● f a
      rewrite mapReduce_Batch_mult_Done.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f (b2 ⧆ a) = mapReduce f b2 ● f a
      rewrite mapReduce_Batch_rw2.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
c: C
C0: Type
b2: Batch A B (B -> C0)
a: A
mapReduce f b2 ● f a = mapReduce f b2 ● f a
      reflexivity.
    +
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
mapReduce f ((b1 ⧆ a0) ⊗ (b2 ⧆ a)) =
mapReduce f ((b1 ⧆ a0) ⊗ b2) ● f a cbn.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
(pure (const M) Step
 ● Traverse_Batch1 B (B -> C * C0) (const M) Map_const
     Pure_const Mult_const A False f
     (map (Batch A B) strength_arrow
        (mult_Batch (b1 ⧆ a0) b2))) ● f a =
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a
      unfold_ops @Pure_const.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
(Ƶ
 ● Traverse_Batch1 B (B -> C * C0) (const M) Map_const
     (fun (X : Type) (_ : X) => Ƶ) Mult_const A False
     f
     (map (Batch A B) strength_arrow
        (mult_Batch (b1 ⧆ a0) b2))) ● f a =
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a
      rewrite monoid_id_l.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
Traverse_Batch1 B (B -> C * C0) (const M) Map_const
  (fun (X : Type) (_ : X) => Ƶ) Mult_const A False f
  (map (Batch A B) strength_arrow
     (mult_Batch (b1 ⧆ a0) b2)) ● f a =
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a
      change (Traverse_Batch1 B (B -> C * C0) (const M) Map_const
                (fun (X : Type) (_ : X) => Ƶ) Mult_const A False f)
        with (mapReduce (T := BATCH1 B (B -> C * C0)) f).
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
mapReduce f
  (map (Batch A B) strength_arrow
     (mult_Batch (b1 ⧆ a0) b2)) ● f a =
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a
      rewrite <- mapReduce_Batch_map.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
C: Type
b1: Batch A B (B -> C)
a0: A
C0: Type
b2: Batch A B (B -> C0)
a: A
IHb1: mapReduce f (b1 ⊗ (b2 ⧆ a)) =
mapReduce f (b1 ⊗ b2) ● f a
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a =
mapReduce f (mult_Batch (b1 ⧆ a0) b2) ● f a
      reflexivity.
Qed.

Lemma mapReduce_Batch_ap_rw2 {A B: Type}:
  forall `{Monoid M}
    (f: A -> M)
    {X Y: Type}
    (lhs: Batch A B (X -> Y))
    (rhs: Batch A B X),
    mapReduce (T := BATCH1 B Y) f (lhs <⋆> rhs) =
      mapReduce (T := BATCH1 B (X -> Y)) f lhs
        ● mapReduce (T := BATCH1 B X) f rhs.
A, B: Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (X Y : Type)
  (lhs : Batch A B (X -> Y)) (rhs : Batch A B X),
mapReduce f (lhs <⋆> rhs) =
mapReduce f lhs ● mapReduce f rhs
Proof.
A, B: Type
forall (M : Type) (op : Monoid_op M)
  (unit0 : Monoid_unit M),
Monoid M ->
forall (f : A -> M) (X Y : Type)
  (lhs : Batch A B (X -> Y)) (rhs : Batch A B X),
mapReduce f (lhs <⋆> rhs) =
mapReduce f lhs ● mapReduce f rhs
  intros.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
X, Y: Type
lhs: Batch A B (X -> Y)
rhs: Batch A B X
mapReduce f (lhs <⋆> rhs) =
mapReduce f lhs ● mapReduce f rhs
  unfold ap.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
X, Y: Type
lhs: Batch A B (X -> Y)
rhs: Batch A B X
mapReduce f
  (map (Batch A B) (fun '(f, a) => f a) (lhs ⊗ rhs)) =
mapReduce f lhs ● mapReduce f rhs
  rewrite <- mapReduce_Batch_map.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
X, Y: Type
lhs: Batch A B (X -> Y)
rhs: Batch A B X
mapReduce f (lhs ⊗ rhs) =
mapReduce f lhs ● mapReduce f rhs
  rewrite mapReduce_Batch_mult.
A, B, M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
f: A -> M
X, Y: Type
lhs: Batch A B (X -> Y)
rhs: Batch A B X
mapReduce f lhs ● mapReduce f rhs =
mapReduce f lhs ● mapReduce f rhs
  reflexivity.
Qed.

Section Batch_mapReduce_rewriting_derived.

  Context {A B C: Type}.

  (** ** <<tolist>> *)
  (******************************************************************************)
  Import List.ListNotations.

  Lemma tolist_Batch_rw2: forall (b: Batch A B (B -> C)) (a: A),
      tolist (b ⧆ a) = tolist b ++ [a].
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
tolist (b ⧆ a) = tolist b ++ [a]
  Proof.
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
tolist (b ⧆ a) = tolist b ++ [a]
    intros.
A, B, C: Type
b: Batch A B (B -> C)
a: A
tolist (b ⧆ a) = tolist b ++ [a]
    reflexivity.
  Qed.

  (** ** <<tosubset>> *)
  (******************************************************************************)
  Import Subset.Notations.
  #[export] Instance ToSubset_Batch1 {B C}: ToSubset (BATCH1 B C) :=
    ToSubset_Traverse.

  Lemma tosubset_Batch_rw2: forall (b: Batch A B (B -> C)) (a: A),
      tosubset (b ⧆ a) = tosubset b ∪ {{a}}.
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
tosubset (b ⧆ a) = tosubset b ∪ {{a}}
  Proof.
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
tosubset (b ⧆ a) = tosubset b ∪ {{a}}
    intros.
A, B, C: Type
b: Batch A B (B -> C)
a: A
tosubset (b ⧆ a) = tosubset b ∪ {{a}}
    rewrite tosubset_to_mapReduce.
A, B, C: Type
b: Batch A B (B -> C)
a: A
mapReduce (ret subset A) (b ⧆ a) = tosubset b ∪ {{a}}
    rewrite mapReduce_Batch_rw2.
A, B, C: Type
b: Batch A B (B -> C)
a: A
mapReduce (ret subset A) b ● ret subset A a =
tosubset b ∪ {{a}}
    reflexivity.
  Qed.

  (** ** <<a ∈ _>> *)
  (******************************************************************************)
  Import ContainerFunctor.Notations.

  Lemma element_of_Batch_rw2: forall `(b: Batch A B (B -> C)) a a',
      a' ∈ (b ⧆ a) = (a' ∈ b \/ a' = a).
A, B, C: Type
forall (b : Batch A B (B -> C)) (a a' : A),
a' ∈ (b ⧆ a) = (a' ∈ b \/ a' = a)
  Proof.
A, B, C: Type
forall (b : Batch A B (B -> C)) (a a' : A),
a' ∈ (b ⧆ a) = (a' ∈ b \/ a' = a)
    intros.
A, B, C: Type
b: Batch A B (B -> C)
a, a': A
a' ∈ (b ⧆ a) = (a' ∈ b \/ a' = a)
    rewrite element_of_to_mapReduce.
A, B, C: Type
b: Batch A B (B -> C)
a, a': A
mapReduce {{a'}} (b ⧆ a) = (a' ∈ b \/ a' = a)
    rewrite element_of_to_mapReduce.
A, B, C: Type
b: Batch A B (B -> C)
a, a': A
mapReduce {{a'}} (b ⧆ a) =
(mapReduce {{a'}} b \/ a' = a)
    rewrite mapReduce_Batch_rw2.
A, B, C: Type
b: Batch A B (B -> C)
a, a': A
mapReduce {{a'}} b ● {{a'}} a =
(mapReduce {{a'}} b \/ a' = a)
    reflexivity.
  Qed.

End Batch_mapReduce_rewriting_derived.

(** * Simultaneous Induction on Two <<Batch>>es of the Same Shape *)
(******************************************************************************)
Section shape_induction.

  Context
    {A1 A2 B C : Type}
      {b1: Batch A1 B C}
      {b2: Batch A2 B C}
      (Hshape: shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2)
      (P : forall C : Type,
          Batch A1 B C ->
          Batch A2 B C ->
          Prop)
      (IHdone:
        forall (C : Type) (c : C), P C (Done c) (Done c))
      (IHstep:
        forall (C : Type)
          (b1 : Batch A1 B (B -> C))
          (b2 : Batch A2 B (B -> C)),
          P (B -> C) b1 b2 ->
          forall (a1 : A1) (a2: A2)
            (Hshape: shape (F := BATCH1 B C)  (Step b1 a1) =
                       shape (F := BATCH1 B C) (Step b2 a2)),
            P C (Step b1 a1) (Step b2 a2)).

  Lemma Batch_simultaneous_ind: P C b1 b2.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
Hshape: shape b1 = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C b1 b2
  Proof.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
Hshape: shape b1 = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C b1 b2
    induction b1 as [C c | C rest IHrest a].
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c: C
Hshape: shape (Done c) = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) b2
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
Hshape: shape (rest ⧆ a) = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) b2
    -
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c: C
Hshape: shape (Done c) = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) b2 destruct b2.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c, c0: C
Hshape: shape (Done c) = shape (Done c0)
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) (Done c0)
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c: C
b: Batch A2 B (B -> C)
a: A2
Hshape: shape (Done c) = shape (b ⧆ a)
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) (b ⧆ a)
      +
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c, c0: C
Hshape: shape (Done c) = shape (Done c0)
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) (Done c0) now inversion Hshape.
      +
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
c: C
b: Batch A2 B (B -> C)
a: A2
Hshape: shape (Done c) = shape (b ⧆ a)
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
P C (Done c) (b ⧆ a) false.
    -
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
Hshape: shape (rest ⧆ a) = shape b2
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) b2 destruct b2 as [c' | rest' a'].
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
c': C
Hshape: shape (rest ⧆ a) = shape (Done c')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) (Done c')
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) (rest' ⧆ a')
      +
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
c': C
Hshape: shape (rest ⧆ a) = shape (Done c')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) (Done c') false.
      +
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P C (rest ⧆ a) (rest' ⧆ a') apply IHstep.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P (B -> C) rest rest'
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
shape (rest ⧆ a) = shape (rest' ⧆ a')
        *
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
P (B -> C) rest rest' apply IHrest.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
Batch A1 B (B -> C)
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
shape rest = shape rest'
          auto.
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
shape rest = shape rest'
          now inversion Hshape.
        *
A1, A2, B, C: Type
b1: Batch A1 B C
b2: Batch A2 B C
rest: Batch A1 B (B -> C)
a: A1
rest': Batch A2 B (B -> C)
a': A2
Hshape: shape (rest ⧆ a) = shape (rest' ⧆ a')
P: forall C : Type,
Batch A1 B C -> Batch A2 B C -> Prop
IHdone: forall (C : Type) (c : C),
P C (Done c) (Done c)
IHstep: forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
P (B -> C) b1 b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
P C (b1 ⧆ a1) (b2 ⧆ a2)
IHrest: Batch A1 B (B -> C) ->
forall b2 : Batch A2 B (B -> C),
shape rest = shape b2 -> P (B -> C) rest b2
shape (rest ⧆ a) = shape (rest' ⧆ a') apply Hshape.
  Qed.

End shape_induction.

(*
(** * Miscellaneous *)
(******************************************************************************)

Instance: forall B, Pure (BATCH1 B B).
Proof.
  unfold Pure.
  intros B A.
  apply batch.
Defined.

Instance: forall B, Mult (BATCH1 B B).
Proof.
  unfold Mult.
  intros B A A'.
  apply batch.
Defined.
 *)

(** * <<runBatch>> specialized to monoids *)
(******************************************************************************)
Section runBatch_monoid.

  Context
    `{Monoid M}.

  Fixpoint runBatch_monoid
    {A B: Type} `(ϕ: A -> M) `(b: Batch A B C): M :=
    match b with
    | Done c => monoid_unit M
    | Step rest a => runBatch_monoid (ϕ: A -> M) rest ● ϕ a
    end.

  Lemma runBatch_monoid1
    {A B: Type}:
    forall (ϕ: A -> M) `(b: Batch A B C),
      runBatch_monoid ϕ b =
        unconst (runBatch (G := Const M)
                   (mkConst (tag := B) ∘ ϕ) b).
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
forall (ϕ : A -> M) (C : Type) (b : Batch A B C),
runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b)
  Proof.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
forall (ϕ : A -> M) (C : Type) (b : Batch A B C),
runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b)
    intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B C
runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b) induction b.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
runBatch_monoid ϕ (Done c) =
unconst (runBatch (mkConst ∘ ϕ) (Done c))
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b)
runBatch_monoid ϕ (b ⧆ a) =
unconst (runBatch (mkConst ∘ ϕ) (b ⧆ a))
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
runBatch_monoid ϕ (Done c) =
unconst (runBatch (mkConst ∘ ϕ) (Done c)) easy.
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b)
runBatch_monoid ϕ (b ⧆ a) =
unconst (runBatch (mkConst ∘ ϕ) (b ⧆ a)) cbn.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b =
unconst (runBatch (mkConst ∘ ϕ) b)
runBatch_monoid ϕ b ● ϕ a =
unconst (runBatch (mkConst ∘ ϕ) b) ● ϕ a now rewrite IHb.
  Qed.

  Lemma runBatch_monoid2 {A B}:
    forall (ϕ: A -> M)
      `(b: Batch A B C),
      runBatch_monoid ϕ b =
        runBatch (G := const M) (ϕ: A -> const M B) b.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
forall (ϕ : A -> M) (C : Type) (b : Batch A B C),
runBatch_monoid ϕ b = runBatch (ϕ : A -> const M B) b
  Proof.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
forall (ϕ : A -> M) (C : Type) (b : Batch A B C),
runBatch_monoid ϕ b = runBatch (ϕ : A -> const M B) b
    intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B C
runBatch_monoid ϕ b = runBatch (ϕ : A -> const M B) b induction b.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
runBatch_monoid ϕ (Done c) = runBatch ϕ (Done c)
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b = runBatch ϕ b
runBatch_monoid ϕ (b ⧆ a) = runBatch ϕ (b ⧆ a)
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
runBatch_monoid ϕ (Done c) = runBatch ϕ (Done c) easy.
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b = runBatch ϕ b
runBatch_monoid ϕ (b ⧆ a) = runBatch ϕ (b ⧆ a) cbn.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch_monoid ϕ b = runBatch ϕ b
runBatch_monoid ϕ b ● ϕ a = runBatch ϕ b ● ϕ a now rewrite IHb.
  Qed.

  Lemma runBatch_monoid_map
          {A B C C'}: forall (ϕ: A -> M) `(f: C -> C') (b: Batch A B C),
      runBatch_monoid ϕ b =
        runBatch_monoid ϕ (map (Batch A B) f b).
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, C, C': Type
forall (ϕ : A -> M) (f : C -> C') (b : Batch A B C),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
  Proof.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, C, C': Type
forall (ϕ : A -> M) (f : C -> C') (b : Batch A B C),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
    intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, C, C': Type
ϕ: A -> M
f: C -> C'
b: Batch A B C
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
    generalize dependent C'.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, C: Type
ϕ: A -> M
b: Batch A B C
forall (C' : Type) (f : C -> C'),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
    induction b; intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
C': Type
f: C -> C'
runBatch_monoid ϕ (Done c) =
runBatch_monoid ϕ (map (Batch A B) f (Done c))
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
C': Type
f: C -> C'
runBatch_monoid ϕ (b ⧆ a) =
runBatch_monoid ϕ (map (Batch A B) f (b ⧆ a))
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
c: C
C': Type
f: C -> C'
runBatch_monoid ϕ (Done c) =
runBatch_monoid ϕ (map (Batch A B) f (Done c)) reflexivity.
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
C': Type
f: C -> C'
runBatch_monoid ϕ (b ⧆ a) =
runBatch_monoid ϕ (map (Batch A B) f (b ⧆ a)) cbn.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
C': Type
f: C -> C'
runBatch_monoid ϕ b ● ϕ a =
runBatch_monoid ϕ (map (Batch A B) (compose f) b)
● ϕ a
      rewrite <- IHb.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B: Type
ϕ: A -> M
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (map (Batch A B) f b)
C': Type
f: C -> C'
runBatch_monoid ϕ b ● ϕ a = runBatch_monoid ϕ b ● ϕ a
      reflexivity.
  Qed.

  Lemma runBatch_monoid_mapsnd
    {A B B'}: forall (ϕ: A -> M) `(f: B' -> B) `(b: Batch A B C),
      runBatch_monoid ϕ b =
        runBatch_monoid ϕ (mapsnd_Batch f b).
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
forall (ϕ : A -> M) (f : B' -> B) (C : Type)
  (b : Batch A B C),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (mapsnd_Batch f b)
  Proof.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
forall (ϕ : A -> M) (f : B' -> B) (C : Type)
  (b : Batch A B C),
runBatch_monoid ϕ b =
runBatch_monoid ϕ (mapsnd_Batch f b)
    intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B C
runBatch_monoid ϕ b =
runBatch_monoid ϕ (mapsnd_Batch f b)
    rewrite runBatch_monoid2.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B C
runBatch ϕ b = runBatch_monoid ϕ (mapsnd_Batch f b)
    rewrite runBatch_monoid2.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B C
runBatch ϕ b = runBatch ϕ (mapsnd_Batch f b)
    rewrite <- runBatch_mapsnd.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B C
runBatch ϕ b = runBatch (map (const M) f ∘ ϕ) b
    intros.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B C
runBatch ϕ b = runBatch (map (const M) f ∘ ϕ) b induction b.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
c: C
runBatch ϕ (Done c) =
runBatch (map (const M) f ∘ ϕ) (Done c)
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch ϕ b = runBatch (map (const M) f ∘ ϕ) b
runBatch ϕ (b ⧆ a) =
runBatch (map (const M) f ∘ ϕ) (b ⧆ a)
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
c: C
runBatch ϕ (Done c) =
runBatch (map (const M) f ∘ ϕ) (Done c) easy.
    -
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch ϕ b = runBatch (map (const M) f ∘ ϕ) b
runBatch ϕ (b ⧆ a) =
runBatch (map (const M) f ∘ ϕ) (b ⧆ a) cbn.
M: Type
op: Monoid_op M
unit0: Monoid_unit M
H: Monoid M
A, B, B': Type
ϕ: A -> M
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: runBatch ϕ b = runBatch (map (const M) f ∘ ϕ) b
runBatch ϕ b ● ϕ a =
runBatch (map (const M) f ∘ ϕ) b
● (map (const M) f ∘ ϕ) a now rewrite IHb.
  Qed.

End runBatch_monoid.

(** * The <<length_Batch>> Operation *)
(** This function is introduced because using <<plength>> has less desirable
    simplification behavior, which makes programming functions like <<Batch_make>>  difficult *)
(******************************************************************************)
From Tealeaves Require Import Misc.NaturalNumbers.

Section length.

  Fixpoint length_Batch {A B C: Type} (b: Batch A B C): nat :=
    match b with
    | Done _  => 0
    | Step rest a => S (length_Batch (C := B -> C) rest)
    end.

  Lemma length_Batch_spec {A B C: Type} (b: Batch A B C):
    length_Batch b =
      plength (T := BATCH1 B C) b.
A, B, C: Type
b: Batch A B C
length_Batch b = plength b
  Proof.
A, B, C: Type
b: Batch A B C
length_Batch b = plength b
    induction b.
A, B, C: Type
c: C
length_Batch (Done c) = plength (Done c)
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
length_Batch (b ⧆ a) = plength (b ⧆ a)
    -
A, B, C: Type
c: C
length_Batch (Done c) = plength (Done c) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
length_Batch (b ⧆ a) = plength (b ⧆ a) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
S (length_Batch b) =
Traverse_Batch1 B (B -> C) (const nat) Map_const
  Pure_const Mult_const A False (fun _ : A => 1) b ● 1 rewrite IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
S (plength b) =
Traverse_Batch1 B (B -> C) (const nat) Map_const
  Pure_const Mult_const A False (fun _ : A => 1) b ● 1
      unfold_all_transparent_tcs.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
S (plength b) =
(Traverse_Batch1 B (B -> C) (const nat) Map_const
   Pure_const Mult_const A False (fun _ : A => 1) b +
 1)%nat
      rewrite PeanoNat.Nat.add_1_r.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = plength b
S (plength b) =
S
  (Traverse_Batch1 B (B -> C) (const nat) Map_const
     Pure_const Mult_const A False (fun _ : A => 1) b)
      reflexivity.
  Qed.

  Lemma length_Batch_spec2 {A B C: Type} (b: Batch A B C):
    length_Batch b =
      runBatch (G := @const Type Type nat) (fun _ => 1) b.
A, B, C: Type
b: Batch A B C
length_Batch b = runBatch (fun _ : A => 1) b
  Proof.
A, B, C: Type
b: Batch A B C
length_Batch b = runBatch (fun _ : A => 1) b
    rewrite length_Batch_spec.
A, B, C: Type
b: Batch A B C
plength b = runBatch (fun _ : A => 1) b
    induction b.
A, B, C: Type
c: C
plength (Done c) = runBatch (fun _ : A => 1) (Done c)
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: plength b = runBatch (fun _ : A => 1) b
plength (b ⧆ a) = runBatch (fun _ : A => 1) (b ⧆ a)
    -
A, B, C: Type
c: C
plength (Done c) = runBatch (fun _ : A => 1) (Done c) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: plength b = runBatch (fun _ : A => 1) b
plength (b ⧆ a) = runBatch (fun _ : A => 1) (b ⧆ a) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: plength b = runBatch (fun _ : A => 1) b
Traverse_Batch1 B (B -> C) (const nat) Map_const
  Pure_const Mult_const A False (fun _ : A => 1) b ● 1 =
runBatch (fun _ : A => 1) b ● 1 rewrite <- IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: plength b = runBatch (fun _ : A => 1) b
Traverse_Batch1 B (B -> C) (const nat) Map_const
  Pure_const Mult_const A False (fun _ : A => 1) b ● 1 =
plength b ● 1
      reflexivity.
  Qed.

  (** ** Rewriting Rules *)
  (** TODO *)
  (******************************************************************************)
  Lemma length_Batch_rw2 {A B C: Type}:
    forall (b: Batch A B (B -> C)) (a: A),
      length_Batch (b ⧆ a) = S (length_Batch b).
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
length_Batch (b ⧆ a) = S (length_Batch b)
  Proof.
A, B, C: Type
forall (b : Batch A B (B -> C)) (a : A),
length_Batch (b ⧆ a) = S (length_Batch b)
    reflexivity.
  Qed.

  (** ** Length is the Same as the Underlying <<list>> *)
  (* The length of a <<Batch>> is the same as the length of the
    list we can extract from it *)
  (******************************************************************************)
  Lemma batch_length1:
    forall {A B C: Type} (b: Batch A B C),
      length_Batch b =
        length (runBatch (G := const (list A))
                  (ret list A) b).
forall (A B C : Type) (b : Batch A B C),
length_Batch b = length (runBatch (ret list A) b)
  Proof.
forall (A B C : Type) (b : Batch A B C),
length_Batch b = length (runBatch (ret list A) b)
    intros.
A, B, C: Type
b: Batch A B C
length_Batch b = length (runBatch (ret list A) b)
    induction b as [C c | C b IHb a].
A, B, C: Type
c: C
length_Batch (Done c) =
length (runBatch (ret list A) (Done c))
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
length_Batch (b ⧆ a) =
length (runBatch (ret list A) (b ⧆ a))
    -
A, B, C: Type
c: C
length_Batch (Done c) =
length (runBatch (ret list A) (Done c)) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
length_Batch (b ⧆ a) =
length (runBatch (ret list A) (b ⧆ a)) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
S (length_Batch b) =
length (runBatch (ret list A) b ● ret list A a) rewrite IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
S (length (runBatch (ret list A) b)) =
length (runBatch (ret list A) b ● ret list A a)
      unfold_ops @Monoid_op_list.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
S (length (runBatch (ret list A) b)) =
length (runBatch (ret list A) b ++ ret list A a)
      rewrite List.app_length.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
S (length (runBatch (ret list A) b)) =
(length (runBatch (ret list A) b) +
 length (ret list A a))%nat
      cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length (runBatch (ret list A) b)
S (length (runBatch (ret list A) b)) =
(length (runBatch (ret list A) b) + 1)%nat lia.
  Qed.

  (** ** Length is Preserved By <<map>> *)
  (******************************************************************************)
  Lemma batch_length_map:
    forall {A B C C': Type}
      (f: C -> C') (b: Batch A B C),
      length_Batch b =
        length_Batch (map (Batch A B) f b).
forall (A B C C' : Type) (f : C -> C')
  (b : Batch A B C),
length_Batch b = length_Batch (map (Batch A B) f b)
  Proof.
forall (A B C C' : Type) (f : C -> C')
  (b : Batch A B C),
length_Batch b = length_Batch (map (Batch A B) f b)
    intros.
A, B, C, C': Type
f: C -> C'
b: Batch A B C
length_Batch b = length_Batch (map (Batch A B) f b)
    generalize dependent C'.
A, B, C: Type
b: Batch A B C
forall (C' : Type) (f : C -> C'),
length_Batch b = length_Batch (map (Batch A B) f b)
    induction b as [C c | C b IHb a]; intros.
A, B, C: Type
c: C
C': Type
f: C -> C'
length_Batch (Done c) =
length_Batch (map (Batch A B) f (Done c))
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
length_Batch b = length_Batch (map (Batch A B) f b)
C': Type
f: C -> C'
length_Batch (b ⧆ a) =
length_Batch (map (Batch A B) f (b ⧆ a))
    -
A, B, C: Type
c: C
C': Type
f: C -> C'
length_Batch (Done c) =
length_Batch (map (Batch A B) f (Done c)) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
length_Batch b = length_Batch (map (Batch A B) f b)
C': Type
f: C -> C'
length_Batch (b ⧆ a) =
length_Batch (map (Batch A B) f (b ⧆ a)) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
length_Batch b = length_Batch (map (Batch A B) f b)
C': Type
f: C -> C'
S (length_Batch b) =
S (length_Batch (map (Batch A B) (compose f) b))
      fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C' : Type) (f : (B -> C) -> C'),
length_Batch b = length_Batch (map (Batch A B) f b)
C': Type
f: C -> C'
length_Batch b =
length_Batch (map (Batch A B) (compose f) b)
      specialize (IHb _ (compose f)).
A, B, C: Type
b: Batch A B (B -> C)
a: A
C': Type
f: C -> C'
IHb: length_Batch b = length_Batch (map (Batch A B) (compose f) b)
length_Batch b =
length_Batch (map (Batch A B) (compose f) b)
      auto.
  Qed.

  Lemma batch_length_mapfst:
    forall {A A' B C: Type}
      (f: A -> A') (b: Batch A B C),
      length_Batch b =
        length_Batch (mapfst_Batch f b).
forall (A A' B C : Type) (f : A -> A')
  (b : Batch A B C),
length_Batch b = length_Batch (mapfst_Batch f b)
  Proof.
forall (A A' B C : Type) (f : A -> A')
  (b : Batch A B C),
length_Batch b = length_Batch (mapfst_Batch f b)
    intros.
A, A', B, C: Type
f: A -> A'
b: Batch A B C
length_Batch b = length_Batch (mapfst_Batch f b)
    induction b as [C c | C b IHb a].
A, A', B: Type
f: A -> A'
C: Type
c: C
length_Batch (Done c) =
length_Batch (mapfst_Batch f (Done c))
A, A', B: Type
f: A -> A'
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapfst_Batch f b)
length_Batch (b ⧆ a) =
length_Batch (mapfst_Batch f (b ⧆ a))
    -
A, A', B: Type
f: A -> A'
C: Type
c: C
length_Batch (Done c) =
length_Batch (mapfst_Batch f (Done c)) reflexivity.
    -
A, A', B: Type
f: A -> A'
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapfst_Batch f b)
length_Batch (b ⧆ a) =
length_Batch (mapfst_Batch f (b ⧆ a)) cbn.
A, A', B: Type
f: A -> A'
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapfst_Batch f b)
S (length_Batch b) =
S (length_Batch (mapfst_Batch f b)) rewrite IHb.
A, A', B: Type
f: A -> A'
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapfst_Batch f b)
S (length_Batch (mapfst_Batch f b)) =
S (length_Batch (mapfst_Batch f b))
      reflexivity.
  Qed.

  Lemma batch_length_mapsnd:
    forall {A B B' C: Type}
      (f: B' -> B) (b: Batch A B C),
      length_Batch b =
        length_Batch (mapsnd_Batch f b).
forall (A B B' C : Type) (f : B' -> B)
  (b : Batch A B C),
length_Batch b = length_Batch (mapsnd_Batch f b)
  Proof.
forall (A B B' C : Type) (f : B' -> B)
  (b : Batch A B C),
length_Batch b = length_Batch (mapsnd_Batch f b)
    intros.
A, B, B', C: Type
f: B' -> B
b: Batch A B C
length_Batch b = length_Batch (mapsnd_Batch f b)
    induction b as [C c | C b IHb a]; intros.
A, B, B': Type
f: B' -> B
C: Type
c: C
length_Batch (Done c) =
length_Batch (mapsnd_Batch f (Done c))
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
length_Batch (b ⧆ a) =
length_Batch (mapsnd_Batch f (b ⧆ a))
    -
A, B, B': Type
f: B' -> B
C: Type
c: C
length_Batch (Done c) =
length_Batch (mapsnd_Batch f (Done c)) reflexivity.
    -
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
length_Batch (b ⧆ a) =
length_Batch (mapsnd_Batch f (b ⧆ a)) cbn.
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
S (length_Batch b) =
S
  (length_Batch
     (map (Batch A B') (precompose f)
        (mapsnd_Batch f b)))
      fequal.
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
length_Batch b =
length_Batch
  (map (Batch A B') (precompose f) (mapsnd_Batch f b))
      rewrite IHb.
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
length_Batch (mapsnd_Batch f b) =
length_Batch
  (map (Batch A B') (precompose f) (mapsnd_Batch f b))
      rewrite (batch_length_map ((precompose f))).
A, B, B': Type
f: B' -> B
C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (mapsnd_Batch f b)
length_Batch
  (map (Batch A B') (precompose f) (mapsnd_Batch f b)) =
length_Batch
  (map (Batch A B') (precompose f) (mapsnd_Batch f b))
      reflexivity.
  Qed.

  (** ** Length is Preserved by <<cojoin_Batch>> *)
  (******************************************************************************)
  Lemma length_cojoin_Batch:
    forall {A A' B C} (b: Batch A B C),
      length_Batch b = length_Batch (cojoin_Batch (B := A') b).
forall (A A' B C : Type) (b : Batch A B C),
length_Batch b = length_Batch (cojoin_Batch b)
  Proof.
forall (A A' B C : Type) (b : Batch A B C),
length_Batch b = length_Batch (cojoin_Batch b)
    induction b.
A, A', B, C: Type
c: C
length_Batch (Done c) =
length_Batch (cojoin_Batch (Done c))
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
length_Batch (b ⧆ a) =
length_Batch (cojoin_Batch (b ⧆ a))
    -
A, A', B, C: Type
c: C
length_Batch (Done c) =
length_Batch (cojoin_Batch (Done c)) reflexivity.
    -
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
length_Batch (b ⧆ a) =
length_Batch (cojoin_Batch (b ⧆ a)) cbn.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
S (length_Batch b) =
S
  (length_Batch
     (map (Batch A A') Step (cojoin_Batch b))) fequal.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
length_Batch b =
length_Batch (map (Batch A A') Step (cojoin_Batch b))
      rewrite IHb.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
length_Batch (cojoin_Batch b) =
length_Batch (map (Batch A A') Step (cojoin_Batch b))
      rewrite <- batch_length_map.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: length_Batch b = length_Batch (cojoin_Batch b)
length_Batch (cojoin_Batch b) =
length_Batch (cojoin_Batch b)
      reflexivity.
  Qed.

  (** ** Two Same-Shaped <<Batch>>es Have the Same Length*)
  (******************************************************************************)
  Lemma length_Batch_shape:
    forall `(b1: Batch A1 B C)
      `(b2: Batch A2 B C),
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2 ->
      length_Batch b1 = length_Batch b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
    introv Hshape.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
length_Batch b1 = length_Batch b2
    induction b1.
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B C
Hshape: shape (Done c) = shape b2
length_Batch (Done c) = length_Batch b2
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B C
Hshape: shape (b1 ⧆ a) = shape b2
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch b2
    -
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B C
Hshape: shape (Done c) = shape b2
length_Batch (Done c) = length_Batch b2 destruct b2.
A1, B, C: Type
c: C
A2: Type
c0: C
Hshape: shape (Done c) = shape (Done c0)
length_Batch (Done c) = length_Batch (Done c0)
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B (B -> C)
a: A2
Hshape: shape (Done c) = shape (b2 ⧆ a)
length_Batch (Done c) = length_Batch (b2 ⧆ a)
      +
A1, B, C: Type
c: C
A2: Type
c0: C
Hshape: shape (Done c) = shape (Done c0)
length_Batch (Done c) = length_Batch (Done c0) now inversion Hshape.
      +
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B (B -> C)
a: A2
Hshape: shape (Done c) = shape (b2 ⧆ a)
length_Batch (Done c) = length_Batch (b2 ⧆ a) false.
    -
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B C
Hshape: shape (b1 ⧆ a) = shape b2
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch b2 destruct b2.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
c: C
Hshape: shape (b1 ⧆ a) = shape (Done c)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch (Done c)
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hshape: shape (b1 ⧆ a) = shape (b2 ⧆ a0)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
      +
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
c: C
Hshape: shape (b1 ⧆ a) = shape (Done c)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch (Done c) false.
      +
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hshape: shape (b1 ⧆ a) = shape (b2 ⧆ a0)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0) cbn.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hshape: shape (b1 ⧆ a) = shape (b2 ⧆ a0)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
S (length_Batch b1) = S (length_Batch b2) fequal.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hshape: shape (b1 ⧆ a) = shape (b2 ⧆ a0)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
length_Batch b1 = length_Batch b2
        apply IHb1.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hshape: shape (b1 ⧆ a) = shape (b2 ⧆ a0)
IHb1: forall b2 : Batch A2 B (B -> C),
shape b1 = shape b2 ->
length_Batch b1 = length_Batch b2
shape b1 = shape b2
        now inversion Hshape.
  Qed.

End length.

(** * Specification for <<traverse>> via <<runBatch>> *)
(******************************************************************************)
Lemma traverse_via_runBatch
  (G: Type -> Type) `{Map G} `{Mult G} `{Pure G} `{! Applicative G}
  `(ϕ: A -> G A') (B C: Type) :
  traverse (T := BATCH1 B C) (G := G) ϕ =
    runBatch (G := G ∘ Batch A' B) (map G (batch A' B) ∘ ϕ).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
traverse ϕ = runBatch (map G (batch A' B) ∘ ϕ)
Proof.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
traverse ϕ = runBatch (map G (batch A' B) ∘ ϕ)
  intros.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
traverse ϕ = runBatch (map G (batch A' B) ∘ ϕ)
  ext b.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
b: Batch A B C
traverse ϕ b = runBatch (map G (batch A' B) ∘ ϕ) b
  induction b as [C c | C rest IHrest].
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
c: C
traverse ϕ (Done c) =
runBatch (map G (batch A' B) ∘ ϕ) (Done c)
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
traverse ϕ (rest ⧆ a) =
runBatch (map G (batch A' B) ∘ ϕ) (rest ⧆ a)
  -
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
c: C
traverse ϕ (Done c) =
runBatch (map G (batch A' B) ∘ ϕ) (Done c) rewrite runBatch_rw1.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
c: C
traverse ϕ (Done c) = pure (G ∘ Batch A' B) c
    rewrite traverse_Batch_rw1.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
c: C
pure G (Done c) = pure (G ∘ Batch A' B) c
    reflexivity.
  -
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
traverse ϕ (rest ⧆ a) =
runBatch (map G (batch A' B) ∘ ϕ) (rest ⧆ a) rewrite runBatch_rw2.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
traverse ϕ (rest ⧆ a) =
runBatch (map G (batch A' B) ∘ ϕ) rest <⋆>
(map G (batch A' B) ∘ ϕ) a
    rewrite traverse_Batch_rw2'.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (traverse ϕ rest) <⋆> ϕ a =
runBatch (map G (batch A' B) ∘ ϕ) rest <⋆>
(map G (batch A' B) ∘ ϕ) a
    rewrite IHrest.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
runBatch (map G (batch A' B) ∘ ϕ) rest <⋆>
(map G (batch A' B) ∘ ϕ) a
    unfold compose at 6.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
runBatch (map G (batch A' B) ∘ ϕ) rest <⋆>
map G (batch A' B) (ϕ a)
    rewrite (ap_compose2 (Batch A' B) G).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
map G (ap (Batch A' B))
  (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
map G (batch A' B) (ϕ a)
    rewrite <- ap_map.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
map G (precompose (batch A' B))
  (map G (ap (Batch A' B))
     (runBatch (map G (batch A' B) ∘ ϕ) rest)) <⋆> 
ϕ a
    compose near (runBatch (G := G ∘ Batch A' B)
                    (map G (batch A' B) ∘ ϕ) rest) on right.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
(map G (precompose (batch A' B))
 ∘ map G (ap (Batch A' B)))
  (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆> ϕ a
    rewrite (fun_map_map (F := G)).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
map G Step (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆>
ϕ a =
map G (precompose (batch A' B) ∘ ap (Batch A' B))
  (runBatch (map G (batch A' B) ∘ ϕ) rest) <⋆> ϕ a
    repeat fequal.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
Step = precompose (batch A' B) ∘ ap (Batch A' B)
    ext b.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b = (precompose (batch A' B) ∘ ap (Batch A' B)) b
    unfold precompose, ap, compose.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B) (fun '(f, a) => f a)
   (b ⊗ batch A' B X))
    cbn.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B) (compose (fun '(f, a) => f a))
   (map (Batch A' B) strength_arrow
      (map (Batch A' B) (fun c : B -> C => (c, id)) b))
 ⧆ X)
    compose near b on right.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B) (compose (fun '(f, a) => f a))
   ((map (Batch A' B) strength_arrow
     ∘ map (Batch A' B) (fun c : B -> C => (c, id))) b)
 ⧆ X)
    rewrite (fun_map_map (F := Batch A' B)).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B) (compose (fun '(f, a) => f a))
   (map (Batch A' B)
      (strength_arrow ∘ (fun c : B -> C => (c, id))) b)
 ⧆ X)
    compose near b on right.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 (map (Batch A' B) (compose (fun '(f, a) => f a))
  ∘ map (Batch A' B)
      (strength_arrow ∘ (fun c : B -> C => (c, id))))
   b ⧆ X)
    rewrite (fun_map_map (F := Batch A' B)).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B)
   (compose (fun '(f, a) => f a)
    ∘ (strength_arrow ∘ (fun c : B -> C => (c, id))))
   b ⧆ X)
    unfold compose.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B)
   (fun (a : B -> C) (a0 : B) =>
    let '(f, a1) := strength_arrow (a, id) a0 in f a1)
   b ⧆ X) cbn.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
Step b =
(fun X : A' =>
 map (Batch A' B) (fun a : B -> C => a ○ id) b ⧆ X)
    fequal.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
b = map (Batch A' B) (fun a : B -> C => a ○ id) b
    change (?f ○ id) with f.
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
b = map (Batch A' B) (fun a : B -> C => a) b
    rewrite (fun_map_id).
G: Type -> Type
H: Map G
H0: Mult G
H1: Pure G
Applicative0: Applicative G
A, A': Type
ϕ: A -> G A'
B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse ϕ rest =
runBatch (map G (batch A' B) ∘ ϕ) rest
b: Batch A' B (B -> C)
b = id b
    reflexivity.
Qed.

(** * <<Batch _ B C>> is a traversable monad *)
(******************************************************************************)

(** ** Operation *)
(******************************************************************************)
Definition bindt_Batch (B C: Type) (G: Type -> Type)
  `{Map G} `{Pure G} `{Mult G} (A A': Type) (f: A -> G (Batch A' B B))
  (b: Batch A B B): G (Batch A' B B) :=
  map G join_Batch (traverse (T := BATCH1 B B) f b).

(** ** Traversable Monad Laws *)
(** TODO *)


(** * Deconstructing <<Batch A B C>> into Shape and Contents *)
(******************************************************************************)
Section deconstruction.

  #[local] Generalizable Variables n v a.

  (** ** <<Batch_make>> and <<Batch_contents>> *)
  (******************************************************************************)
  (** Extract the contents of <<Batch>> as a vector *)
  Fixpoint Batch_contents `(b: Batch A B C):
    Vector (length_Batch b) A :=
    match b with
    | Done c => vnil
    | Step b a => vcons (length_Batch b) a (Batch_contents b)
    end.

  (** Obtain the build function of <<Batch>>. Note that
 <<Batch_make b v>> in general has type <<C>>, not another <<Batch>>.
 That is, this is not <<make>> in the sense of <<put>> *)
  Fixpoint Batch_make `(b: Batch A B C):
    Vector (length_Batch b) B -> C :=
    match b return Vector (length_Batch b) B -> C with
    | Done c => fun v => c
    | Step b a => fun v =>
                   Batch_make b (Vector_tl v) (Vector_hd v)
    end.

  (** ** <<Batch_replace_contents>> *)
  (** This is <<make>> in the sense of <<put>>. *)
  (******************************************************************************)
  Fixpoint Batch_replace_contents
             `(b: Batch A B C)
             `(v: Vector (length_Batch b) A')
    : Batch A' B C :=
    match b return (Vector (length_Batch b) A' -> Batch A' B C) with
    | Done c =>
        fun v => Done c
    | Step rest a =>
        fun v =>
          Step (Batch_replace_contents rest (Vector_tl v))
               (Vector_hd v)
    end v.

  (** ** Rewriting rules *)
  (******************************************************************************)
  Section rw.

    Context {A B C: Type}.

    Implicit Types (a: A) (b: Batch A B (B -> C)) (c: C).

    Lemma Batch_contents_rw1 {c}:
      Batch_contents (@Done A B C c) = vnil.
A, B, C: Type
c: C
Batch_contents (Done c) = vnil
    Proof.
A, B, C: Type
c: C
Batch_contents (Done c) = vnil
      reflexivity.
    Qed.

    Lemma Batch_contents_rw2 {b a}:
      Batch_contents (Step b a) =
        vcons (length_Batch b) a (Batch_contents b).
A, B, C: Type
b: Batch A B (B -> C)
a: A
Batch_contents (b ⧆ a) =
vcons (length_Batch b) a (Batch_contents b)
    Proof.
A, B, C: Type
b: Batch A B (B -> C)
a: A
Batch_contents (b ⧆ a) =
vcons (length_Batch b) a (Batch_contents b)
      reflexivity.
    Qed.

    Lemma Batch_make_rw1 {c}:
      Batch_make (@Done A B C c) = const c.
A, B, C: Type
c: C
Batch_make (Done c) = const c
    Proof.
A, B, C: Type
c: C
Batch_make (Done c) = const c
      reflexivity.
    Qed.

    Lemma Batch_make_rw2 {b a}:
      Batch_make (Step b a) =
        fun v => Batch_make b (Vector_tl v) (Vector_hd v).
A, B, C: Type
b: Batch A B (B -> C)
a: A
Batch_make (b ⧆ a) =
(fun v : Vector (length_Batch (b ⧆ a)) B =>
 Batch_make b (Vector_tl v) (Vector_hd v))
    Proof.
A, B, C: Type
b: Batch A B (B -> C)
a: A
Batch_make (b ⧆ a) =
(fun v : Vector (length_Batch (b ⧆ a)) B =>
 Batch_make b (Vector_tl v) (Vector_hd v))
      reflexivity.
    Qed.

    Lemma Batch_replace_rw1 {c} `{v: Vector _ A'}:
      Batch_replace_contents (@Done A B C c) v = Done c.
A, B, C: Type
c: C
A': Type
v: Vector (length_Batch (Done c)) A'
Batch_replace_contents (Done c) v = Done c
    Proof.
A, B, C: Type
c: C
A': Type
v: Vector (length_Batch (Done c)) A'
Batch_replace_contents (Done c) v = Done c
      reflexivity.
    Qed.

    Lemma Batch_replace_rw2 {b a} `{v: Vector _ A'}:
      Batch_replace_contents (Step b a) v =
        Step (Batch_replace_contents b (Vector_tl v)) (Vector_hd v).
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
Batch_replace_contents (b ⧆ a) v =
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v
    Proof.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
Batch_replace_contents (b ⧆ a) v =
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v
      reflexivity.
    Qed.

  End rw.

  (** ** Relating <<tolist>> and <<Batch_contents>> *)
  (******************************************************************************)
  Ltac hide_rhs :=
    match goal with
    | |- ?lhs = ?rhs =>
        let name := fresh "rhs" in
        remember rhs as name
    end.

  Lemma tolist_Batch_contents {A B C}: forall (b: Batch A B C),
      proj1_sig (Batch_contents b) = List.rev (tolist b).
A, B, C: Type
forall b : Batch A B C,
proj1_sig (Batch_contents b) = List.rev (tolist b)
  Proof.
A, B, C: Type
forall b : Batch A B C,
proj1_sig (Batch_contents b) = List.rev (tolist b)
    intros.
A, B, C: Type
b: Batch A B C
proj1_sig (Batch_contents b) = List.rev (tolist b)
    induction b.
A, B, C: Type
c: C
proj1_sig (Batch_contents (Done c)) =
List.rev (tolist (Done c))
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
proj1_sig (Batch_contents (b ⧆ a)) =
List.rev (tolist (b ⧆ a))
    -
A, B, C: Type
c: C
proj1_sig (Batch_contents (Done c)) =
List.rev (tolist (Done c)) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
proj1_sig (Batch_contents (b ⧆ a)) =
List.rev (tolist (b ⧆ a)) rewrite Batch_contents_rw2.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
proj1_sig
  (vcons (length_Batch b) a (Batch_contents b)) =
List.rev (tolist (b ⧆ a))
      hide_rhs; cbn; rewrite Heqrhs; clear Heqrhs.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
rhs: list A
proj1_sig
  (vcons (length_Batch b) a (Batch_contents b)) =
List.rev (tolist (b ⧆ a))
      (* ^^ Simplify a hidden (length_Batch (b ⧆ a) without affecting RHS. *)
      (* ^^ rewrite Batch_contents_rw2 fails due to binders *)
      rewrite proj_vcons.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
rhs: list A
a :: proj1_sig (Batch_contents b) =
List.rev (tolist (b ⧆ a))
      rewrite tolist_Batch_rw2.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
rhs: list A
a :: proj1_sig (Batch_contents b) =
List.rev (tolist b ++ a :: nil)
      rewrite List.rev_unit.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
rhs: list A
a :: proj1_sig (Batch_contents b) =
a :: List.rev (tolist b)
      rewrite <- IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: proj1_sig (Batch_contents b) = List.rev (tolist b)
rhs: list A
a :: proj1_sig (Batch_contents b) =
a :: proj1_sig (Batch_contents b)
      reflexivity.
  Qed.

  (** ** Rewriting Rules for << <⋆> >> *)
  (******************************************************************************)
  Section rewrite_Batch_contents.

    Context {A B: Type}.

    Lemma Batch_contents_rw_pure:
      forall X (x: X), Batch_contents (pure (Batch A B) x) = vnil.
A, B: Type
forall (X : Type) (x : X),
Batch_contents (pure (Batch A B) x) = vnil
    Proof.
A, B: Type
forall (X : Type) (x : X),
Batch_contents (pure (Batch A B) x) = vnil
      intros.
A, B, X: Type
x: X
Batch_contents (pure (Batch A B) x) = vnil
      reflexivity.
    Qed.

    Lemma Batch_contents_rw_mult:
      forall {C D} (x: Batch A B C) (y: Batch A B D),
        Batch_contents (x ⊗ y) ~~
          Vector_append (Batch_contents y)
          (Batch_contents x).
A, B: Type
forall (C D : Type) (x : Batch A B C)
  (y : Batch A B D),
Batch_contents (x ⊗ y) ~~
Vector_append (Batch_contents y) (Batch_contents x)
    Proof.
A, B: Type
forall (C D : Type) (x : Batch A B C)
  (y : Batch A B D),
Batch_contents (x ⊗ y) ~~
Vector_append (Batch_contents y) (Batch_contents x)
      intros.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
Batch_contents (x ⊗ y) ~~
Vector_append (Batch_contents y) (Batch_contents x)
      unfold Vector_sim.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
proj1_sig (Batch_contents (x ⊗ y)) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      rewrite tolist_Batch_contents.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (tolist (x ⊗ y)) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      rewrite tolist_to_mapReduce.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (mapReduce (ret list A) (x ⊗ y)) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      rewrite mapReduce_Batch_mult.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev
  (mapReduce (ret list A) x ● mapReduce (ret list A) y) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      unfold_ops @Monoid_op_list.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev
  (mapReduce (ret list A) x ++
   mapReduce (ret list A) y) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      rewrite List.rev_app_distr.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (mapReduce (ret list A) y) ++
List.rev (mapReduce (ret list A) x) =
proj1_sig
  (Vector_append (Batch_contents y) (Batch_contents x))
      rewrite proj_Vector_append.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (mapReduce (ret list A) y) ++
List.rev (mapReduce (ret list A) x) =
proj1_sig (Batch_contents y) ++
proj1_sig (Batch_contents x)
      rewrite tolist_Batch_contents.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (mapReduce (ret list A) y) ++
List.rev (mapReduce (ret list A) x) =
List.rev (tolist y) ++ proj1_sig (Batch_contents x)
      rewrite tolist_Batch_contents.
A, B, C, D: Type
x: Batch A B C
y: Batch A B D
List.rev (mapReduce (ret list A) y) ++
List.rev (mapReduce (ret list A) x) =
List.rev (tolist y) ++ List.rev (tolist x)
      reflexivity.
    Qed.

    Lemma Batch_contents_rw_app:
      forall X Y (f: Batch A B (X -> Y)) (x: Batch A B X),
        Batch_contents (f <⋆> x) ~~
          Vector_append (Batch_contents x) (Batch_contents f).
A, B: Type
forall (X Y : Type) (f : Batch A B (X -> Y))
  (x : Batch A B X),
Batch_contents (f <⋆> x) ~~
Vector_append (Batch_contents x) (Batch_contents f)
    Proof.
A, B: Type
forall (X Y : Type) (f : Batch A B (X -> Y))
  (x : Batch A B X),
Batch_contents (f <⋆> x) ~~
Vector_append (Batch_contents x) (Batch_contents f)
      intros.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
Batch_contents (f <⋆> x) ~~
Vector_append (Batch_contents x) (Batch_contents f)
      unfold Vector_sim.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
proj1_sig (Batch_contents (f <⋆> x)) =
proj1_sig
  (Vector_append (Batch_contents x) (Batch_contents f))
      rewrite tolist_Batch_contents.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (tolist (f <⋆> x)) =
proj1_sig
  (Vector_append (Batch_contents x) (Batch_contents f))
      rewrite tolist_to_mapReduce.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (mapReduce (ret list A) (f <⋆> x)) =
proj1_sig
  (Vector_append (Batch_contents x) (Batch_contents f))
      rewrite proj_Vector_append.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (mapReduce (ret list A) (f <⋆> x)) =
proj1_sig (Batch_contents x) ++
proj1_sig (Batch_contents f)
      rewrite mapReduce_Batch_ap_rw2.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev
  (mapReduce (ret list A) f ● mapReduce (ret list A) x) =
proj1_sig (Batch_contents x) ++
proj1_sig (Batch_contents f)
      unfold_ops @Monoid_op_list.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev
  (mapReduce (ret list A) f ++
   mapReduce (ret list A) x) =
proj1_sig (Batch_contents x) ++
proj1_sig (Batch_contents f)
      rewrite List.rev_app_distr.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (mapReduce (ret list A) x) ++
List.rev (mapReduce (ret list A) f) =
proj1_sig (Batch_contents x) ++
proj1_sig (Batch_contents f)
      rewrite tolist_Batch_contents.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (mapReduce (ret list A) x) ++
List.rev (mapReduce (ret list A) f) =
List.rev (tolist x) ++ proj1_sig (Batch_contents f)
      rewrite tolist_Batch_contents.
A, B, X, Y: Type
f: Batch A B (X -> Y)
x: Batch A B X
List.rev (mapReduce (ret list A) x) ++
List.rev (mapReduce (ret list A) f) =
List.rev (tolist x) ++ List.rev (tolist f)
      reflexivity.
    Qed.

  End rewrite_Batch_contents.

  (** ** Same Shape Iff Same <<Batch_make>> *)
  (******************************************************************************)
  Lemma Batch_make_shape:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2 ->
      Batch_make b1 ~!~ Batch_make b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 -> Batch_make b1 ~!~ Batch_make b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 -> Batch_make b1 ~!~ Batch_make b2
    introv Hshape.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
Batch_make b1 ~!~ Batch_make b2
    apply (Batch_simultaneous_ind Hshape).
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C),
Batch_make (Done c) ~!~ Batch_make (Done c)
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
Batch_make b1 ~!~ Batch_make b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
Batch_make (b1 ⧆ a1) ~!~ Batch_make (b2 ⧆ a2)
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C),
Batch_make (Done c) ~!~ Batch_make (Done c) split; auto.
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
Batch_make b1 ~!~ Batch_make b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
Batch_make (b1 ⧆ a1) ~!~ Batch_make (b2 ⧆ a2) clear.
A1, B, A2: Type
forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
Batch_make b1 ~!~ Batch_make b2 ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
Batch_make (b1 ⧆ a1) ~!~ Batch_make (b2 ⧆ a2)
      introv Hsim; introv Hshape.
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
Batch_make (b1 ⧆ a1) ~!~ Batch_make (b2 ⧆ a2)
      split.
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
length_Batch (b1 ⧆ a1) = length_Batch (b2 ⧆ a2)
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
forall (v1 : Vector (length_Batch (b1 ⧆ a1)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a2)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a1) v1 = Batch_make (b2 ⧆ a2) v2
      +
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
length_Batch (b1 ⧆ a1) = length_Batch (b2 ⧆ a2) auto using length_Batch_shape.
      +
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
forall (v1 : Vector (length_Batch (b1 ⧆ a1)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a2)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a1) v1 = Batch_make (b2 ⧆ a2) v2 introv Hsim'.
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
v1: Vector (length_Batch (b1 ⧆ a1)) B
v2: Vector (length_Batch (b2 ⧆ a2)) B
Hsim': v1 ~~ v2
Batch_make (b1 ⧆ a1) v1 = Batch_make (b2 ⧆ a2) v2
        do 2 rewrite Batch_make_rw2.
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
v1: Vector (length_Batch (b1 ⧆ a1)) B
v2: Vector (length_Batch (b2 ⧆ a2)) B
Hsim': v1 ~~ v2
Batch_make b1 (Vector_tl v1) (Vector_hd v1) =
Batch_make b2 (Vector_tl v2) (Vector_hd v2)
        rewrite (Vector_hd_sim Hsim').
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
v1: Vector (length_Batch (b1 ⧆ a1)) B
v2: Vector (length_Batch (b2 ⧆ a2)) B
Hsim': v1 ~~ v2
Batch_make b1 (Vector_tl v1) (Vector_hd v2) =
Batch_make b2 (Vector_tl v2) (Vector_hd v2)
        enough
          (cut: Batch_make b1 (Vector_tl v1) =
                  Batch_make b2 (Vector_tl v2))
          by now rewrite cut.
A1, B, A2, C: Type
b1: Batch A1 B (B -> C)
b2: Batch A2 B (B -> C)
Hsim: Batch_make b1 ~!~ Batch_make b2
a1: A1
a2: A2
Hshape: shape (b1 ⧆ a1) = shape (b2 ⧆ a2)
v1: Vector (length_Batch (b1 ⧆ a1)) B
v2: Vector (length_Batch (b2 ⧆ a2)) B
Hsim': v1 ~~ v2
Batch_make b1 (Vector_tl v1) =
Batch_make b2 (Vector_tl v2)
        auto using Vector_fun_sim_eq, Vector_tl_sim.
  Qed.

  Lemma Batch_make_shape_rev:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      Batch_make b1 ~!~ Batch_make b2 ->
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
Batch_make b1 ~!~ Batch_make b2 -> shape b1 = shape b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
Batch_make b1 ~!~ Batch_make b2 -> shape b1 = shape b2
      intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: Batch_make b1 ~!~ Batch_make b2
shape b1 = shape b2
      unfold Vector_fun_sim in *.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: length_Batch b1 = length_Batch b2 /\
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 -> Batch_make b1 v1 = Batch_make b2 v2)
shape b1 = shape b2
      destruct H as [Hlen Hsim].
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hlen: length_Batch b1 = length_Batch b2
Hsim: forall (v1 : Vector (length_Batch b1) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 -> Batch_make b1 v1 = Batch_make b2 v2
shape b1 = shape b2
      induction b1.
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B C
Hlen: length_Batch (Done c) = length_Batch b2
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 = Batch_make b2 v2
shape (Done c) = shape b2
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B C
Hlen: length_Batch (b1 ⧆ a) = length_Batch b2
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 = Batch_make b2 v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape b2
      -
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B C
Hlen: length_Batch (Done c) = length_Batch b2
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 = Batch_make b2 v2
shape (Done c) = shape b2 destruct b2.
A1, B, C: Type
c: C
A2: Type
c0: C
Hlen: length_Batch (Done c) = length_Batch (Done c0)
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch (Done c0)) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 =
Batch_make (Done c0) v2
shape (Done c) = shape (Done c0)
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B (B -> C)
a: A2
Hlen: length_Batch (Done c) = length_Batch (b2 ⧆ a)
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a)) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 = Batch_make (b2 ⧆ a) v2
shape (Done c) = shape (b2 ⧆ a)
        *
A1, B, C: Type
c: C
A2: Type
c0: C
Hlen: length_Batch (Done c) = length_Batch (Done c0)
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch (Done c0)) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 =
Batch_make (Done c0) v2
shape (Done c) = shape (Done c0) cbn in *.
A1, B, C: Type
c: C
A2: Type
c0: C
Hlen: 0 = 0
Hsim: forall v1 v2 : Vector 0 B, v1 ~~ v2 -> c = c0
Done c = Done c0
          specialize (Hsim vnil vnil ltac:(reflexivity)).
A1, B, C: Type
c: C
A2: Type
c0: C
Hlen: 0 = 0
Hsim: c = c0
Done c = Done c0
          now inversion Hsim.
        *
A1, B, C: Type
c: C
A2: Type
b2: Batch A2 B (B -> C)
a: A2
Hlen: length_Batch (Done c) = length_Batch (b2 ⧆ a)
Hsim: forall (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a)) B),
v1 ~~ v2 ->
Batch_make (Done c) v1 = Batch_make (b2 ⧆ a) v2
shape (Done c) = shape (b2 ⧆ a) false.
      -
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B C
Hlen: length_Batch (b1 ⧆ a) = length_Batch b2
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 = Batch_make b2 v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape b2 destruct b2.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
c: C
Hlen: length_Batch (b1 ⧆ a) = length_Batch (Done c)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (Done c)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 = Batch_make (Done c) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape (Done c)
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape (b2 ⧆ a0)
        +
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
c: C
Hlen: length_Batch (b1 ⧆ a) = length_Batch (Done c)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (Done c)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 = Batch_make (Done c) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape (Done c) false.
        +
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
shape (b1 ⧆ a) = shape (b2 ⧆ a0) cbn.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
mapfst_Batch (const tt) b1 ⧆ const tt a =
mapfst_Batch (const tt) b2 ⧆ const tt a0 fequal.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
mapfst_Batch (const tt) b1 =
mapfst_Batch (const tt) b2 apply IHb1.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
length_Batch b1 = length_Batch b2
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
forall (v1 : Vector (length_Batch b1) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 -> Batch_make b1 v1 = Batch_make b2 v2
          *
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
length_Batch b1 = length_Batch b2 now inversion Hlen.
          *
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
forall (v1 : Vector (length_Batch b1) B)
  (v2 : Vector (length_Batch b2) B),
v1 ~~ v2 -> Batch_make b1 v1 = Batch_make b2 v2 intros v1 v2 Vsim.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Vsim: v1 ~~ v2
Batch_make b1 v1 = Batch_make b2 v2
            ext b.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Vsim: v1 ~~ v2
b: B
Batch_make b1 v1 b = Batch_make b2 v2 b
            assert (Vsim': vcons _ b v1 ~~ vcons _ b v2).
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Vsim: v1 ~~ v2
b: B
vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Vsim: v1 ~~ v2
b: B
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            now apply vcons_sim.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
Hsim: forall (v1 : Vector (length_Batch (b1 ⧆ a)) B)
  (v2 : Vector (length_Batch (b2 ⧆ a0)) B),
v1 ~~ v2 ->
Batch_make (b1 ⧆ a) v1 =
Batch_make (b2 ⧆ a0) v2
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Vsim: v1 ~~ v2
b: B
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            specialize (Hsim _ _ Vsim').
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
b: B
Hsim: Batch_make (b1 ⧆ a)
  (vcons (length_Batch b1) b v1) =
Batch_make (b2 ⧆ a0)
  (vcons (length_Batch b2) b v2)
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
Vsim: v1 ~~ v2
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            cbn in Hsim.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
b: B
Hsim: Batch_make b1
  (Vector_tl (vcons (length_Batch b1) b v1))
  (Vector_hd (vcons (length_Batch b1) b v1)) =
Batch_make b2
  (Vector_tl (vcons (length_Batch b2) b v2))
  (Vector_hd (vcons (length_Batch b2) b v2))
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
Vsim: v1 ~~ v2
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            do 2 rewrite Vector_tl_vcons in Hsim.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
b: B
Hsim: Batch_make b1 v1
  (Vector_hd (vcons (length_Batch b1) b v1)) =
Batch_make b2 v2
  (Vector_hd (vcons (length_Batch b2) b v2))
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
Vsim: v1 ~~ v2
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            do 2 rewrite Vector_hd_vcons in Hsim.
A1, B, C: Type
b1: Batch A1 B (B -> C)
a: A1
A2: Type
b2: Batch A2 B (B -> C)
a0: A2
Hlen: length_Batch (b1 ⧆ a) = length_Batch (b2 ⧆ a0)
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
b: B
Hsim: Batch_make b1 v1 b = Batch_make b2 v2 b
IHb1: forall b2 : Batch A2 B (B -> C),
length_Batch b1 = length_Batch b2 ->
(forall (v1 : Vector (length_Batch b1) B)
   (v2 : Vector (length_Batch b2) B),
 v1 ~~ v2 ->
 Batch_make b1 v1 = Batch_make b2 v2) ->
shape b1 = shape b2
Vsim: v1 ~~ v2
Vsim': vcons (length_Batch b1) b v1 ~~
vcons (length_Batch b2) b v2
Batch_make b1 v1 b = Batch_make b2 v2 b
            assumption.
  Qed.

  Corollary Batch_make_shape_iff:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2 <->
        Batch_make b1 ~!~ Batch_make b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 <->
Batch_make b1 ~!~ Batch_make b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 <->
Batch_make b1 ~!~ Batch_make b2
    intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
shape b1 = shape b2 <->
Batch_make b1 ~!~ Batch_make b2
    split; auto using Batch_make_shape,
      Batch_make_shape_rev.
  Qed.

  (** ** Two Lemmas for <<shape>> and <<length_Batch>> *)
  (******************************************************************************)
  Lemma Batch_shape_spec:
    forall `(b: Batch A B C),
      shape (F := BATCH1 B C) b =
        Batch_replace_contents b (Vector_tt (length_Batch b)).
forall (A B C : Type) (b : Batch A B C),
shape b =
Batch_replace_contents b (Vector_tt (length_Batch b))
  Proof.
forall (A B C : Type) (b : Batch A B C),
shape b =
Batch_replace_contents b (Vector_tt (length_Batch b))
    intros.
A, B, C: Type
b: Batch A B C
shape b =
Batch_replace_contents b (Vector_tt (length_Batch b))
    induction b.
A, B, C: Type
c: C
shape (Done c) =
Batch_replace_contents (Done c)
  (Vector_tt (length_Batch (Done c)))
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
shape (b ⧆ a) =
Batch_replace_contents (b ⧆ a)
  (Vector_tt (length_Batch (b ⧆ a)))
    -
A, B, C: Type
c: C
shape (Done c) =
Batch_replace_contents (Done c)
  (Vector_tt (length_Batch (Done c))) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
shape (b ⧆ a) =
Batch_replace_contents (b ⧆ a)
  (Vector_tt (length_Batch (b ⧆ a))) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
mapfst_Batch (const tt) b ⧆ const tt a =
Batch_replace_contents b
  (Vector_tl
     (vcons (length_Batch b) tt
        (Vector_repeat (length_Batch b) tt)))
⧆ Vector_hd
    (vcons (length_Batch b) tt
       (Vector_repeat (length_Batch b) tt))
      rewrite Vector_tl_vcons.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
mapfst_Batch (const tt) b ⧆ const tt a =
Batch_replace_contents b
  (Vector_repeat (length_Batch b) tt)
⧆ Vector_hd
    (vcons (length_Batch b) tt
       (Vector_repeat (length_Batch b) tt))
      rewrite Vector_hd_vcons.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
mapfst_Batch (const tt) b ⧆ const tt a =
Batch_replace_contents b
  (Vector_repeat (length_Batch b) tt) ⧆ tt
      fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: shape b = Batch_replace_contents b (Vector_tt (length_Batch b))
mapfst_Batch (const tt) b =
Batch_replace_contents b
  (Vector_repeat (length_Batch b) tt)
      apply IHb.
  Qed.

  Corollary Batch_make_sim_length:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      (forall (A': Type),
          Batch_make b1
            ~!~ Batch_make b2) ->
      length_Batch b1 = length_Batch b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(Type -> Batch_make b1 ~!~ Batch_make b2) ->
length_Batch b1 = length_Batch b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(Type -> Batch_make b1 ~!~ Batch_make b2) ->
length_Batch b1 = length_Batch b2
    intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: Type -> Batch_make b1 ~!~ Batch_make b2
length_Batch b1 = length_Batch b2
    eapply Vector_fun_sim_length.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: Type -> Batch_make b1 ~!~ Batch_make b2
?f ~!~ ?g
    apply (H False).
  Qed.

  Corollary Batch_replace_contents_sim_length:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      (forall (A': Type),
          Batch_replace_contents
            (A' := A') b1
            ~!~ Batch_replace_contents
            (A' := A') b2) ->
      length_Batch b1 = length_Batch b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) ->
length_Batch b1 = length_Batch b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) ->
length_Batch b1 = length_Batch b2
    intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
length_Batch b1 = length_Batch b2
    eapply Vector_fun_sim_length.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
?f ~!~ ?g
    apply (H False).
  Qed.

  (** ** Same Shape Implies Same <<Batch_replace_contents>> *)
  (******************************************************************************)
  Lemma Batch_replace_contents_shape:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2 ->
      forall (A': Type),
        Batch_replace_contents
          (A' := A') b1
          ~!~ Batch_replace_contents
          (A' := A') b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 ->
forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
shape b1 = shape b2 ->
forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
    introv Hshape.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
    apply (Batch_simultaneous_ind Hshape).
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C) (A' : Type),
Batch_replace_contents (Done c) ~!~
Batch_replace_contents (Done c)
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
forall A' : Type,
Batch_replace_contents (b1 ⧆ a1) ~!~
Batch_replace_contents (b2 ⧆ a2)
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C) (A' : Type),
Batch_replace_contents (Done c) ~!~
Batch_replace_contents (Done c) clear.
A1, B, A2: Type
forall (C : Type) (c : C) (A' : Type),
Batch_replace_contents (Done c) ~!~
Batch_replace_contents (Done c) intros.
A1, B, A2, C: Type
c: C
A': Type
Batch_replace_contents (Done c) ~!~
Batch_replace_contents (Done c) now split.
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 : Batch A1 B (B -> C))
  (b2 : Batch A2 B (B -> C)),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) ->
forall (a1 : A1) (a2 : A2),
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
forall A' : Type,
Batch_replace_contents (b1 ⧆ a1) ~!~
Batch_replace_contents (b2 ⧆ a2) intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
Batch_replace_contents (b0 ⧆ a1) ~!~
Batch_replace_contents (b3 ⧆ a2) split.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
length_Batch (b0 ⧆ a1) = length_Batch (b3 ⧆ a2)
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
forall (v1 : Vector (length_Batch (b0 ⧆ a1)) A')
  (v2 : Vector (length_Batch (b3 ⧆ a2)) A'),
v1 ~~ v2 ->
Batch_replace_contents (b0 ⧆ a1) v1 =
Batch_replace_contents (b3 ⧆ a2) v2
      +
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
length_Batch (b0 ⧆ a1) = length_Batch (b3 ⧆ a2) auto using length_Batch_shape.
      +
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
forall (v1 : Vector (length_Batch (b0 ⧆ a1)) A')
  (v2 : Vector (length_Batch (b3 ⧆ a2)) A'),
v1 ~~ v2 ->
Batch_replace_contents (b0 ⧆ a1) v1 =
Batch_replace_contents (b3 ⧆ a2) v2 introv Hsim.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
v1: Vector (length_Batch (b0 ⧆ a1)) A'
v2: Vector (length_Batch (b3 ⧆ a2)) A'
Hsim: v1 ~~ v2
Batch_replace_contents (b0 ⧆ a1) v1 =
Batch_replace_contents (b3 ⧆ a2) v2
        do 2 rewrite Batch_replace_rw2.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
v1: Vector (length_Batch (b0 ⧆ a1)) A'
v2: Vector (length_Batch (b3 ⧆ a2)) A'
Hsim: v1 ~~ v2
Batch_replace_contents b0 (Vector_tl v1)
⧆ Vector_hd v1 =
Batch_replace_contents b3 (Vector_tl v2)
⧆ Vector_hd v2
        rewrite (Vector_hd_sim Hsim).
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
v1: Vector (length_Batch (b0 ⧆ a1)) A'
v2: Vector (length_Batch (b3 ⧆ a2)) A'
Hsim: v1 ~~ v2
Batch_replace_contents b0 (Vector_tl v1)
⧆ Vector_hd v2 =
Batch_replace_contents b3 (Vector_tl v2)
⧆ Vector_hd v2
        fequal.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
v1: Vector (length_Batch (b0 ⧆ a1)) A'
v2: Vector (length_Batch (b3 ⧆ a2)) A'
Hsim: v1 ~~ v2
Batch_replace_contents b0 (Vector_tl v1) =
Batch_replace_contents b3 (Vector_tl v2)
        apply H.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hshape: shape b1 = shape b2
C0: Type
b0: Batch A1 B (B -> C0)
b3: Batch A2 B (B -> C0)
H: forall A' : Type,
Batch_replace_contents b0 ~!~
Batch_replace_contents b3
a1: A1
a2: A2
Hshape0: shape (b0 ⧆ a1) = shape (b3 ⧆ a2)
A': Type
v1: Vector (length_Batch (b0 ⧆ a1)) A'
v2: Vector (length_Batch (b3 ⧆ a2)) A'
Hsim: v1 ~~ v2
Vector_tl v1 ~~ Vector_tl v2
        auto using Vector_tl_sim.
  Qed.

  Corollary Batch_replace_contents_shape_rev:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
    (forall (A': Type),
      Batch_replace_contents
        (A' := A') b1
        ~!~ Batch_replace_contents
        (A' := A') b2) ->
    shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) -> shape b1 = shape b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) -> shape b1 = shape b2
    introv Hsim.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
shape b1 = shape b2
    rewrite Batch_shape_spec.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
Batch_replace_contents b1
  (Vector_tt (length_Batch b1)) = shape b2
    rewrite Batch_shape_spec.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
Batch_replace_contents b1
  (Vector_tt (length_Batch b1)) =
Batch_replace_contents b2
  (Vector_tt (length_Batch b2))
    apply Hsim.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
Vector_tt (length_Batch b1) ~~
Vector_tt (length_Batch b2)
    enough (length_Batch b1 = length_Batch b2).
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
H: length_Batch b1 = length_Batch b2
Vector_tt (length_Batch b1) ~~
Vector_tt (length_Batch b2)
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
length_Batch b1 = length_Batch b2
    {
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
H: length_Batch b1 = length_Batch b2
Vector_tt (length_Batch b1) ~~
Vector_tt (length_Batch b2) rewrite H.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
H: length_Batch b1 = length_Batch b2
Vector_tt (length_Batch b2) ~~
Vector_tt (length_Batch b2) reflexivity. }
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Hsim: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
length_Batch b1 = length_Batch b2
    now apply Batch_replace_contents_sim_length.
  Qed.

  Corollary Batch_replace_contents_shape_iff:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
    (forall (A': Type),
      Batch_replace_contents
        (A' := A') b1
        ~!~ Batch_replace_contents
        (A' := A') b2) <->
      shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) <-> shape b1 = shape b2
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) <-> shape b1 = shape b2
    intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) <-> shape b1 = shape b2 split.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) -> shape b1 = shape b2
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
shape b1 = shape b2 ->
forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) -> shape b1 = shape b2 intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
shape b1 = shape b2 now apply Batch_replace_contents_shape_rev.
    -
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
shape b1 = shape b2 ->
forall A' : Type,
Batch_replace_contents b1 ~!~
Batch_replace_contents b2 intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
H: shape b1 = shape b2
A': Type
Batch_replace_contents b1 ~!~
Batch_replace_contents b2 now apply Batch_replace_contents_shape.
  Qed.

  (** ** <<Batch_make>> Equal Iff <<Batch_replace_contents>> Equal *)
  (******************************************************************************)
  Lemma Batch_replace_sim_iff_make_sim:
    forall `(b1: Batch A1 B C) `(b2: Batch A2 B C),
      Batch_make b1 ~!~ Batch_make b2 <->
      forall A', Batch_replace_contents (A' := A') b1 ~!~
              Batch_replace_contents b2.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
Batch_make b1 ~!~ Batch_make b2 <->
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2)
  Proof.
forall (A1 B C : Type) (b1 : Batch A1 B C) (A2 : Type)
  (b2 : Batch A2 B C),
Batch_make b1 ~!~ Batch_make b2 <->
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2)
    intros.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
Batch_make b1 ~!~ Batch_make b2 <->
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2)
    rewrite <- Batch_make_shape_iff.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
shape b1 = shape b2 <->
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2)
    rewrite <- Batch_replace_contents_shape_iff.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2) <->
(forall A' : Type,
 Batch_replace_contents b1 ~!~
 Batch_replace_contents b2)
    reflexivity.
  Qed.

  (** ** Similarity Lemmas for <<Batch_make>> *)
  (******************************************************************************)
  Lemma Batch_make_sim1
    `(b: Batch A B C)
    `{v1: Vector (length_Batch b) B}
    `{v2: Vector (length_Batch b) B}
    (Hsim: v1 ~~ v2):
    Batch_make b v1 = Batch_make b v2.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
Hsim: v1 ~~ v2
Batch_make b v1 = Batch_make b v2
  Proof.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
Hsim: v1 ~~ v2
Batch_make b v1 = Batch_make b v2
    apply Vector_sim_eq in Hsim.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
Hsim: v1 = v2
Batch_make b v1 = Batch_make b v2
    now subst.
  Qed.

  (* This sort of lemma is very useful when the complexity of expression
     <<v1>> and <<v2>> obstructs tactics like <<rewrite>> *)
  Lemma Batch_make_sim2
    `(b1: Batch A B C)
    `(b2: Batch A B C)
    `{v1: Vector (length_Batch b1) B}
    `{v2: Vector (length_Batch b2) B}
    (Heq: b1 = b2)
    (Hsim: v1 ~~ v2):
    Batch_make b1 v1 = Batch_make b2 v2.
A, B, C: Type
b1, b2: Batch A B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: b1 = b2
Hsim: v1 ~~ v2
Batch_make b1 v1 = Batch_make b2 v2
  Proof.
A, B, C: Type
b1, b2: Batch A B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: b1 = b2
Hsim: v1 ~~ v2
Batch_make b1 v1 = Batch_make b2 v2
    subst.
A, B, C: Type
b2: Batch A B C
v1, v2: Vector (length_Batch b2) B
Hsim: v1 ~~ v2
Batch_make b2 v1 = Batch_make b2 v2
    now (subst; apply Batch_make_sim1).
  Qed.

  Lemma Batch_make_sim3
    `(b1: Batch A1 B C)
    `(b2: Batch A2 B C)
    `{v1: Vector (length_Batch b1) B}
    `{v2: Vector (length_Batch b2) B}
    (Heq: shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2)
    (Hsim: v1 ~~ v2):
    Batch_make b1 v1 = Batch_make b2 v2.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_make b1 v1 = Batch_make b2 v2
  Proof.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_make b1 v1 = Batch_make b2 v2
    apply Vector_fun_sim_eq.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_make b1 ~!~ Batch_make b2
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
v1 ~~ v2
    apply Batch_make_shape.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
shape b1 = shape b2
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
v1 ~~ v2
    auto.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
v1: Vector (length_Batch b1) B
v2: Vector (length_Batch b2) B
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
v1 ~~ v2 assumption.
  Qed.

  Lemma Batch_make_coerce
    `(b: Batch A B C)
    `{v1: Vector (length_Batch b) B}
    `{v2: Vector n B}
    (Heq: n = length_Batch b):
    v1 ~~ v2 ->
    Batch_make b v1 = Batch_make b (coerce Heq in v2).
A, B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) B
n: nat
v2: Vector n B
Heq: n = length_Batch b
v1 ~~ v2 ->
Batch_make b v1 = Batch_make b (coerce Heq in v2)
  Proof.
A, B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) B
n: nat
v2: Vector n B
Heq: n = length_Batch b
v1 ~~ v2 ->
Batch_make b v1 = Batch_make b (coerce Heq in v2)
    subst.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
v1 ~~ v2 ->
Batch_make b v1 = Batch_make b (coerce eq_refl in v2)
    intros.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
H: v1 ~~ v2
Batch_make b v1 = Batch_make b (coerce eq_refl in v2)
    rewrite coerce_Vector_eq_refl.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
H: v1 ~~ v2
Batch_make b v1 = Batch_make b v2
    apply Batch_make_sim1.
A, B, C: Type
b: Batch A B C
v1, v2: Vector (length_Batch b) B
H: v1 ~~ v2
v1 ~~ v2
    assumption.
  Qed.

  (** Rewrite the <<Batch>> argument to an equal one by
      coercing the length proof in the vector. *)
  Lemma Batch_make_rw_alt
    `(b1: Batch A B C)
    `(b2: Batch A B C)
    `{v: Vector (length_Batch b1) B}
    (Heq: b1 = b2):
    Batch_make b1 v =
      Batch_make b2 (rew [fun b => Vector (length_Batch b) B]
                       Heq in v).
A, B, C: Type
b1, b2: Batch A B C
v: Vector (length_Batch b1) B
Heq: b1 = b2
Batch_make b1 v =
Batch_make b2
  (rew [fun b : Batch A B C =>
        Vector (length_Batch b) B] Heq in v)
  Proof.
A, B, C: Type
b1, b2: Batch A B C
v: Vector (length_Batch b1) B
Heq: b1 = b2
Batch_make b1 v =
Batch_make b2
  (rew [fun b : Batch A B C =>
        Vector (length_Batch b) B] Heq in v)
    now (subst; apply Batch_make_sim1).
  Qed.

  Lemma Batch_make_rw
    `(b1: Batch A B C)
    `(b2: Batch A B C)
    `{v: Vector (length_Batch b1) B}
    (Heq: b1 = b2):
    Batch_make b1 v =
      Batch_make b2
        (coerce
           (eq_ind_r
              (fun z => length_Batch z = length_Batch b2) eq_refl Heq)
          in v).
A, B, C: Type
b1, b2: Batch A B C
v: Vector (length_Batch b1) B
Heq: b1 = b2
Batch_make b1 v =
Batch_make b2
  (coerce eq_ind_r
            (fun z : Batch A B C =>
             length_Batch z = length_Batch b2) eq_refl
            Heq in v)
  Proof.
A, B, C: Type
b1, b2: Batch A B C
v: Vector (length_Batch b1) B
Heq: b1 = b2
Batch_make b1 v =
Batch_make b2
  (coerce eq_ind_r
            (fun z : Batch A B C =>
             length_Batch z = length_Batch b2) eq_refl
            Heq in v)
    subst.
A, B, C: Type
b2: Batch A B C
v: Vector (length_Batch b2) B
Batch_make b2 v =
Batch_make b2
  (coerce eq_ind_r
            (fun z : Batch A B C =>
             length_Batch z = length_Batch b2) eq_refl
            eq_refl in v) cbn.
A, B, C: Type
b2: Batch A B C
v: Vector (length_Batch b2) B
Batch_make b2 v = Batch_make b2 (coerce eq_refl in v)
    now rewrite coerce_Vector_eq_refl.
  Qed.

  (** ** Similarity Laws for <<Batch_replace_contents>> *)
  (******************************************************************************)
  Lemma Batch_replace_sim1
    `(b: Batch A B C)
    `{v1: Vector (length_Batch b) A'}
    `{v2: Vector (length_Batch b) A'}
    (Hsim: v1 ~~ v2):
    Batch_replace_contents b v1 = Batch_replace_contents b v2.
A, B, C: Type
b: Batch A B C
A': Type
v1, v2: Vector (length_Batch b) A'
Hsim: v1 ~~ v2
Batch_replace_contents b v1 =
Batch_replace_contents b v2
  Proof.
A, B, C: Type
b: Batch A B C
A': Type
v1, v2: Vector (length_Batch b) A'
Hsim: v1 ~~ v2
Batch_replace_contents b v1 =
Batch_replace_contents b v2
    induction b.
A, B, C: Type
c: C
A': Type
v1, v2: Vector (length_Batch (Done c)) A'
Hsim: v1 ~~ v2
Batch_replace_contents (Done c) v1 =
Batch_replace_contents (Done c) v2
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v1, v2: Vector (length_Batch (b ⧆ a)) A'
Hsim: v1 ~~ v2
IHb: forall v1 v2 : Vector (length_Batch b) A',
v1 ~~ v2 ->
Batch_replace_contents b v1 =
Batch_replace_contents b v2
Batch_replace_contents (b ⧆ a) v1 =
Batch_replace_contents (b ⧆ a) v2
    -
A, B, C: Type
c: C
A': Type
v1, v2: Vector (length_Batch (Done c)) A'
Hsim: v1 ~~ v2
Batch_replace_contents (Done c) v1 =
Batch_replace_contents (Done c) v2 reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v1, v2: Vector (length_Batch (b ⧆ a)) A'
Hsim: v1 ~~ v2
IHb: forall v1 v2 : Vector (length_Batch b) A',
v1 ~~ v2 ->
Batch_replace_contents b v1 =
Batch_replace_contents b v2
Batch_replace_contents (b ⧆ a) v1 =
Batch_replace_contents (b ⧆ a) v2 do 2 rewrite Batch_replace_rw2.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v1, v2: Vector (length_Batch (b ⧆ a)) A'
Hsim: v1 ~~ v2
IHb: forall v1 v2 : Vector (length_Batch b) A',
v1 ~~ v2 ->
Batch_replace_contents b v1 =
Batch_replace_contents b v2
Batch_replace_contents b (Vector_tl v1) ⧆ Vector_hd v1 =
Batch_replace_contents b (Vector_tl v2) ⧆ Vector_hd v2
      rewrite (IHb _ _ (Vector_tl_sim Hsim)).
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v1, v2: Vector (length_Batch (b ⧆ a)) A'
Hsim: v1 ~~ v2
IHb: forall v1 v2 : Vector (length_Batch b) A',
v1 ~~ v2 ->
Batch_replace_contents b v1 =
Batch_replace_contents b v2
Batch_replace_contents b (Vector_tl v2) ⧆ Vector_hd v1 =
Batch_replace_contents b (Vector_tl v2) ⧆ Vector_hd v2
      rewrite (Vector_hd_sim Hsim).
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v1, v2: Vector (length_Batch (b ⧆ a)) A'
Hsim: v1 ~~ v2
IHb: forall v1 v2 : Vector (length_Batch b) A',
v1 ~~ v2 ->
Batch_replace_contents b v1 =
Batch_replace_contents b v2
Batch_replace_contents b (Vector_tl v2) ⧆ Vector_hd v2 =
Batch_replace_contents b (Vector_tl v2) ⧆ Vector_hd v2
      reflexivity.
  Qed.

  Lemma Batch_replace_sim2
    `(b1: Batch A B C)
    `(b2: Batch A B C)
    `{v1: Vector (length_Batch b1) A'}
    `{v2: Vector (length_Batch b2) A'}
    (Heq: b1 = b2)
    (Hsim: Vector_sim v1 v2):
    Batch_replace_contents b1 v1 = Batch_replace_contents b2 v2.
A, B, C: Type
b1, b2: Batch A B C
A': Type
v1: Vector (length_Batch b1) A'
v2: Vector (length_Batch b2) A'
Heq: b1 = b2
Hsim: v1 ~~ v2
Batch_replace_contents b1 v1 =
Batch_replace_contents b2 v2
  Proof.
A, B, C: Type
b1, b2: Batch A B C
A': Type
v1: Vector (length_Batch b1) A'
v2: Vector (length_Batch b2) A'
Heq: b1 = b2
Hsim: v1 ~~ v2
Batch_replace_contents b1 v1 =
Batch_replace_contents b2 v2
    now (subst; apply Batch_replace_sim1).
  Qed.

  Lemma Batch_replace_sim3
    `(b1: Batch A1 B C)
    `(b2: Batch A2 B C)
    `{v1: Vector (length_Batch b1) A'}
    `{v2: Vector (length_Batch b2) A'}
    (Heq: shape (F := BATCH1 B C) b1 = shape (F := BATCH1 B C) b2)
    (Hsim: v1 ~~ v2):
    Batch_replace_contents b1 v1 = Batch_replace_contents b2 v2.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
A': Type
v1: Vector (length_Batch b1) A'
v2: Vector (length_Batch b2) A'
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_replace_contents b1 v1 =
Batch_replace_contents b2 v2
  Proof.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
A': Type
v1: Vector (length_Batch b1) A'
v2: Vector (length_Batch b2) A'
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_replace_contents b1 v1 =
Batch_replace_contents b2 v2
    apply Vector_fun_sim_eq; auto.
A1, B, C: Type
b1: Batch A1 B C
A2: Type
b2: Batch A2 B C
A': Type
v1: Vector (length_Batch b1) A'
v2: Vector (length_Batch b2) A'
Heq: shape b1 = shape b2
Hsim: v1 ~~ v2
Batch_replace_contents b1 ~!~
Batch_replace_contents b2
    now apply Batch_replace_contents_shape_iff.
  Qed.

  (** ** Naturality of <<Batch_make>> *)
  (******************************************************************************)
  Lemma Batch_make_natural
    `(b: Batch A B C)
    `(f: C -> D)
    `(Hsim: v1 ~~ v2):
    f (Batch_make b v1) =
      Batch_make (map (Batch A B) f b) v2.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v1: Vector (length_Batch b) B
v2: Vector (length_Batch (map (Batch A B) f b)) B
Hsim: v1 ~~ v2
f (Batch_make b v1) =
Batch_make (map (Batch A B) f b) v2
  Proof.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v1: Vector (length_Batch b) B
v2: Vector (length_Batch (map (Batch A B) f b)) B
Hsim: v1 ~~ v2
f (Batch_make b v1) =
Batch_make (map (Batch A B) f b) v2
    generalize dependent v2.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v1: Vector (length_Batch b) B
forall
  v2 : Vector (length_Batch (map (Batch A B) f b)) B,
v1 ~~ v2 ->
f (Batch_make b v1) =
Batch_make (map (Batch A B) f b) v2
    generalize dependent v1.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
forall (v1 : Vector (length_Batch b) B)
  (v2 : Vector (length_Batch (map (Batch A B) f b)) B),
v1 ~~ v2 ->
f (Batch_make b v1) =
Batch_make (map (Batch A B) f b) v2
    generalize dependent D.
A, B, C: Type
b: Batch A B C
forall (D : Type) (f : C -> D)
  (v1 : Vector (length_Batch b) B)
  (v2 : Vector (length_Batch (map (Batch A B) f b)) B),
v1 ~~ v2 ->
f (Batch_make b v1) =
Batch_make (map (Batch A B) f b) v2
    induction b as [C c | C rest IHrest].
A, B, C: Type
c: C
forall (D : Type) (f : C -> D)
  (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector
          (length_Batch (map (Batch A B) f (Done c)))
          B),
v1 ~~ v2 ->
f (Batch_make (Done c) v1) =
Batch_make (map (Batch A B) f (Done c)) v2
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
forall (D : Type) (f : C -> D)
  (v1 : Vector (length_Batch (rest ⧆ a)) B)
  (v2 : Vector
          (length_Batch (map (Batch A B) f (rest ⧆ a)))
          B),
v1 ~~ v2 ->
f (Batch_make (rest ⧆ a) v1) =
Batch_make (map (Batch A B) f (rest ⧆ a)) v2
    -
A, B, C: Type
c: C
forall (D : Type) (f : C -> D)
  (v1 : Vector (length_Batch (Done c)) B)
  (v2 : Vector
          (length_Batch (map (Batch A B) f (Done c)))
          B),
v1 ~~ v2 ->
f (Batch_make (Done c) v1) =
Batch_make (map (Batch A B) f (Done c)) v2 reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
forall (D : Type) (f : C -> D)
  (v1 : Vector (length_Batch (rest ⧆ a)) B)
  (v2 : Vector
          (length_Batch (map (Batch A B) f (rest ⧆ a)))
          B),
v1 ~~ v2 ->
f (Batch_make (rest ⧆ a) v1) =
Batch_make (map (Batch A B) f (rest ⧆ a)) v2 intros D f v1 v2 Hsim.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (length_Batch (rest ⧆ a)) B
v2: Vector
  (length_Batch (map (Batch A B) f (rest ⧆ a))) B
Hsim: v1 ~~ v2
f (Batch_make (rest ⧆ a) v1) =
Batch_make (map (Batch A B) f (rest ⧆ a)) v2
      change (map (Batch A B) f (Step rest a)) with
        (Step (map (Batch A B) (compose f) rest) a) in *.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (length_Batch (rest ⧆ a)) B
v2: Vector
  (length_Batch
     (map (Batch A B) (compose f) rest ⧆ a)) B
Hsim: v1 ~~ v2
f (Batch_make (rest ⧆ a) v1) =
Batch_make (map (Batch A B) (compose f) rest ⧆ a) v2
      cbn in v2, v1.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
f (Batch_make (rest ⧆ a) v1) =
Batch_make (map (Batch A B) (compose f) rest ⧆ a) v2
      do 2 rewrite Batch_make_rw2.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
f (Batch_make rest (Vector_tl v1) (Vector_hd v1)) =
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v2)
      rewrite <- (Vector_hd_sim Hsim).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
f (Batch_make rest (Vector_tl v1) (Vector_hd v1)) =
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v1)
      change_left ((f ∘ Batch_make rest (Vector_tl v1)) (Vector_hd v1)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: forall (D : Type) (f : (B -> C) -> D)
  (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) f rest)) B),
v1 ~~ v2 ->
f (Batch_make rest v1) =
Batch_make (map (Batch A B) f rest) v2
D: Type
f: C -> D
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
(f ∘ Batch_make rest (Vector_tl v1)) (Vector_hd v1) =
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v1)
      specialize (IHrest _ (compose f)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
D: Type
f: C -> D
IHrest: forall (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) 
                (compose f) rest)) B),
v1 ~~ v2 ->
f ∘ Batch_make rest v1 =
Batch_make (map (Batch A B) (compose f) rest)
  v2
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
(f ∘ Batch_make rest (Vector_tl v1)) (Vector_hd v1) =
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v1)
      rewrite (IHrest (Vector_tl v1) (Vector_tl v2) (Vector_tl_sim Hsim)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
D: Type
f: C -> D
IHrest: forall (v1 : Vector (length_Batch rest) B)
  (v2 : Vector
          (length_Batch
             (map (Batch A B) 
                (compose f) rest)) B),
v1 ~~ v2 ->
f ∘ Batch_make rest v1 =
Batch_make (map (Batch A B) (compose f) rest)
  v2
v1: Vector (S (length_Batch rest)) B
v2: Vector
  (S
     (length_Batch
        (map (Batch A B) (compose f) rest))) B
Hsim: v1 ~~ v2
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v1) =
Batch_make (map (Batch A B) (compose f) rest)
  (Vector_tl v2) (Vector_hd v1)
      reflexivity.
  Qed.

  Lemma Batch_make_natural_rw1
    `(b: Batch A B C)
    `(f: C -> D)
    (v: Vector (length_Batch b) B):
    f (Batch_make b v) =
      Batch_make (map (Batch A B) f b)
        (coerce (batch_length_map _ _) in v).
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch b) B
f (Batch_make b v) =
Batch_make (map (Batch A B) f b)
  (coerce batch_length_map f b in v)
  Proof.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch b) B
f (Batch_make b v) =
Batch_make (map (Batch A B) f b)
  (coerce batch_length_map f b in v)
    now rewrite (
        Batch_make_natural
          b f
          (v1 := v)
          (v2 :=coerce_Vector_length (batch_length_map _ _) v)
      ) by vector_sim.
  Qed.

  Lemma Batch_make_natural_rw2 `(b: Batch A B C) `(f: C -> D) v:
    Batch_make (map (Batch A B) f b) v =
      f (Batch_make b (coerce_Vector_length (eq_sym (batch_length_map _ _)) v)).
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch (map (Batch A B) f b)) B
Batch_make (map (Batch A B) f b) v =
f
  (Batch_make b
     (coerce eq_sym (batch_length_map f b) in v))
  Proof.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch (map (Batch A B) f b)) B
Batch_make (map (Batch A B) f b) v =
f
  (Batch_make b
     (coerce eq_sym (batch_length_map f b) in v))
    rewrite (Batch_make_natural_rw1 b f).
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch (map (Batch A B) f b)) B
Batch_make (map (Batch A B) f b) v =
Batch_make (map (Batch A B) f b)
  (coerce batch_length_map f b
   in coerce eq_sym (batch_length_map f b) in v)
    apply Batch_make_sim1.
A, B, C: Type
b: Batch A B C
D: Type
f: C -> D
v: Vector (length_Batch (map (Batch A B) f b)) B
v ~~
coerce batch_length_map f b
in coerce eq_sym (batch_length_map f b) in v
    vector_sim.
  Qed.

  (** ** Naturality of <<Batch_contents>> *)
  (******************************************************************************)
  Lemma Batch_contents_natural: forall `(b: Batch A B C) `(f: A -> A'),
      map (Vector (length_Batch b)) f (Batch_contents b)
        ~~ Batch_contents (mapfst_Batch f b).
forall (A B C : Type) (b : Batch A B C) (A' : Type)
  (f : A -> A'),
map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
  Proof.
forall (A B C : Type) (b : Batch A B C) (A' : Type)
  (f : A -> A'),
map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
    intros.
A, B, C: Type
b: Batch A B C
A': Type
f: A -> A'
map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
    induction b.
A, B, C: Type
c: C
A': Type
f: A -> A'
map (Vector (length_Batch (Done c))) f
  (Batch_contents (Done c)) ~~
Batch_contents (mapfst_Batch f (Done c))
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
f: A -> A'
IHb: map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
map (Vector (length_Batch (b ⧆ a))) f
  (Batch_contents (b ⧆ a)) ~~
Batch_contents (mapfst_Batch f (b ⧆ a))
    -
A, B, C: Type
c: C
A': Type
f: A -> A'
map (Vector (length_Batch (Done c))) f
  (Batch_contents (Done c)) ~~
Batch_contents (mapfst_Batch f (Done c)) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
f: A -> A'
IHb: map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
map (Vector (length_Batch (b ⧆ a))) f
  (Batch_contents (b ⧆ a)) ~~
Batch_contents (mapfst_Batch f (b ⧆ a)) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
f: A -> A'
IHb: map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
map (Vector (S (length_Batch b))) f
  (vcons (length_Batch b) a (Batch_contents b)) ~~
vcons (length_Batch (mapfst_Batch f b)) (f a)
  (Batch_contents (mapfst_Batch f b))
      rewrite map_Vector_vcons.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
f: A -> A'
IHb: map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
vcons (length_Batch b) (f a)
  (map (Vector (length_Batch b)) f (Batch_contents b)) ~~
vcons (length_Batch (mapfst_Batch f b)) (f a)
  (Batch_contents (mapfst_Batch f b))
      apply vcons_sim.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
f: A -> A'
IHb: map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
map (Vector (length_Batch b)) f (Batch_contents b) ~~
Batch_contents (mapfst_Batch f b)
      assumption.
  Qed.

  (** ** Specification for <<Batch_replace_contents>> *)
  (*******************************************************************************)
  Lemma Batch_replace_contents_spec {A A' B C}:
    forall (b: Batch A B C),
      Batch_replace_contents b =
        precoerce (length_cojoin_Batch b)
      in Batch_make (cojoin_Batch b (B := A')).
A, A', B, C: Type
forall b : Batch A B C,
Batch_replace_contents b =
Batch_make (cojoin_Batch b)
○ coerce_Vector_length (length_cojoin_Batch b)
  Proof.
A, A', B, C: Type
forall b : Batch A B C,
Batch_replace_contents b =
Batch_make (cojoin_Batch b)
○ coerce_Vector_length (length_cojoin_Batch b)
    intros b.
A, A', B, C: Type
b: Batch A B C
Batch_replace_contents b =
Batch_make (cojoin_Batch b)
○ coerce_Vector_length (length_cojoin_Batch b) ext v.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
Batch_replace_contents b v =
Batch_make (cojoin_Batch b)
  (coerce length_cojoin_Batch b in v)
    generalize (length_cojoin_Batch (A' := A') b).
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
forall
  e : length_Batch b = length_Batch (cojoin_Batch b),
Batch_replace_contents b v =
Batch_make (cojoin_Batch b) (coerce e in v)
    intros Heq.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
Heq: length_Batch b = length_Batch (cojoin_Batch b)
Batch_replace_contents b v =
Batch_make (cojoin_Batch b) (coerce Heq in v)
    induction b.
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (cojoin_Batch (Done c))
Batch_replace_contents (Done c) v =
Batch_make (cojoin_Batch (Done c)) (coerce Heq in v)
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents (b ⧆ a) v =
Batch_make (cojoin_Batch (b ⧆ a)) (coerce Heq in v)
    -
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (cojoin_Batch (Done c))
Batch_replace_contents (Done c) v =
Batch_make (cojoin_Batch (Done c)) (coerce Heq in v) reflexivity.
    -
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents (b ⧆ a) v =
Batch_make (cojoin_Batch (b ⧆ a)) (coerce Heq in v) rewrite Batch_replace_rw2.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v =
Batch_make (cojoin_Batch (b ⧆ a)) (coerce Heq in v)
      cbn.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v =
Batch_make (map (Batch A A') Step (cojoin_Batch b))
  (Vector_tl (coerce Heq in v))
  (Vector_hd (coerce Heq in v))
      rewrite Batch_make_natural_rw2.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v =
Batch_make (cojoin_Batch b)
  (coerce eq_sym
            (batch_length_map Step (cojoin_Batch b))
   in Vector_tl (coerce Heq in v))
⧆ Vector_hd (coerce Heq in v)
      rewrite <- (Vector_hd_coerce_eq (Heq := Heq)).
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents b (Vector_tl v) ⧆ Vector_hd v =
Batch_make (cojoin_Batch b)
  (coerce eq_sym
            (batch_length_map Step (cojoin_Batch b))
   in Vector_tl (coerce Heq in v)) ⧆ Vector_hd v
      fequal.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (cojoin_Batch b)),
Batch_replace_contents b v = Batch_make (cojoin_Batch b) (coerce Heq in v)
Batch_replace_contents b (Vector_tl v) =
Batch_make (cojoin_Batch b)
  (coerce eq_sym
            (batch_length_map Step (cojoin_Batch b))
   in Vector_tl (coerce Heq in v))
      specialize (IHb (Vector_tl v) (length_cojoin_Batch b)).
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: Batch_replace_contents b (Vector_tl v) =
Batch_make (cojoin_Batch b) (coerce length_cojoin_Batch b in Vector_tl v)
Batch_replace_contents b (Vector_tl v) =
Batch_make (cojoin_Batch b)
  (coerce eq_sym
            (batch_length_map Step (cojoin_Batch b))
   in Vector_tl (coerce Heq in v))
      rewrite IHb.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: Batch_replace_contents b (Vector_tl v) =
Batch_make (cojoin_Batch b) (coerce length_cojoin_Batch b in Vector_tl v)
Batch_make (cojoin_Batch b)
  (coerce length_cojoin_Batch b in Vector_tl v) =
Batch_make (cojoin_Batch b)
  (coerce eq_sym
            (batch_length_map Step (cojoin_Batch b))
   in Vector_tl (coerce Heq in v))
      apply Batch_make_sim1.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (cojoin_Batch (b ⧆ a))
IHb: Batch_replace_contents b (Vector_tl v) =
Batch_make (cojoin_Batch b) (coerce length_cojoin_Batch b in Vector_tl v)
coerce length_cojoin_Batch b in Vector_tl v ~~
coerce eq_sym (batch_length_map Step (cojoin_Batch b))
in Vector_tl (coerce Heq in v)
      vector_sim.
  Qed.

  (** ** Replacing Contents Does Not Change <<length_Batch>>, <<shape>>, or <<Batch_make>> *)
  (*******************************************************************************)
  Lemma length_replace_contents:
    forall {A B C: Type} (b: Batch A B C) `(v: Vector _ A'),
      length_Batch b = length_Batch (Batch_replace_contents b v).
forall (A B C : Type) (b : Batch A B C) (A' : Type)
  (v : Vector (length_Batch b) A'),
length_Batch b =
length_Batch (Batch_replace_contents b v)
  Proof.
forall (A B C : Type) (b : Batch A B C) (A' : Type)
  (v : Vector (length_Batch b) A'),
length_Batch b =
length_Batch (Batch_replace_contents b v)
    intros.
A, B, C: Type
b: Batch A B C
A': Type
v: Vector (length_Batch b) A'
length_Batch b =
length_Batch (Batch_replace_contents b v)
    induction b.
A, B, C: Type
c: C
A': Type
v: Vector (length_Batch (Done c)) A'
length_Batch (Done c) =
length_Batch (Batch_replace_contents (Done c) v)
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
length_Batch b = length_Batch (Batch_replace_contents b v)
length_Batch (b ⧆ a) =
length_Batch (Batch_replace_contents (b ⧆ a) v)
    -
A, B, C: Type
c: C
A': Type
v: Vector (length_Batch (Done c)) A'
length_Batch (Done c) =
length_Batch (Batch_replace_contents (Done c) v) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
length_Batch b = length_Batch (Batch_replace_contents b v)
length_Batch (b ⧆ a) =
length_Batch (Batch_replace_contents (b ⧆ a) v) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
length_Batch b = length_Batch (Batch_replace_contents b v)
S (length_Batch b) =
S
  (length_Batch
     (Batch_replace_contents b (Vector_tl v))) fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
length_Batch b = length_Batch (Batch_replace_contents b v)
length_Batch b =
length_Batch (Batch_replace_contents b (Vector_tl v))
      apply (IHb (Vector_tl v)).
  Qed.

  Lemma Batch_make_replace_contents {A A' B C}:
    forall (b: Batch A B C) (v: Vector (length_Batch b) A'),
      Batch_make (Batch_replace_contents b v) =
        precoerce (eq_sym (length_replace_contents b v))
      in (Batch_make (B := B) b).
A, A', B, C: Type
forall (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
Batch_make (Batch_replace_contents b v) =
Batch_make b
○ coerce_Vector_length
    (eq_sym (length_replace_contents b v))
  Proof.
A, A', B, C: Type
forall (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
Batch_make (Batch_replace_contents b v) =
Batch_make b
○ coerce_Vector_length
    (eq_sym (length_replace_contents b v))
    intros.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
Batch_make (Batch_replace_contents b v) =
Batch_make b
○ coerce_Vector_length
    (eq_sym (length_replace_contents b v))
    ext v'.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
v': Vector
  (length_Batch (Batch_replace_contents b v)) B
Batch_make (Batch_replace_contents b v) v' =
Batch_make b
  (coerce eq_sym (length_replace_contents b v) in v')
    generalize (eq_sym (length_replace_contents b v)).
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
v': Vector
  (length_Batch (Batch_replace_contents b v)) B
forall
  e : length_Batch (Batch_replace_contents b v) =
      length_Batch b,
Batch_make (Batch_replace_contents b v) v' =
Batch_make b (coerce e in v')
    intro e.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
v': Vector
  (length_Batch (Batch_replace_contents b v)) B
e: length_Batch (Batch_replace_contents b v) =
length_Batch b
Batch_make (Batch_replace_contents b v) v' =
Batch_make b (coerce e in v')
    induction b.
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (Done c) v)) B
e: length_Batch (Batch_replace_contents (Done c) v) =
length_Batch (Done c)
Batch_make (Batch_replace_contents (Done c) v) v' =
Batch_make (Done c) (coerce e in v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: forall (v : Vector (length_Batch b) A')
(v' : Vector (length_Batch (Batch_replace_contents b v)) B)
(e : length_Batch (Batch_replace_contents b v) = length_Batch b),
Batch_make (Batch_replace_contents b v) v' = Batch_make b (coerce e in v')
Batch_make (Batch_replace_contents (b ⧆ a) v) v' =
Batch_make (b ⧆ a) (coerce e in v')
    -
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (Done c) v)) B
e: length_Batch (Batch_replace_contents (Done c) v) =
length_Batch (Done c)
Batch_make (Batch_replace_contents (Done c) v) v' =
Batch_make (Done c) (coerce e in v') reflexivity.
    -
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: forall (v : Vector (length_Batch b) A')
(v' : Vector (length_Batch (Batch_replace_contents b v)) B)
(e : length_Batch (Batch_replace_contents b v) = length_Batch b),
Batch_make (Batch_replace_contents b v) v' = Batch_make b (coerce e in v')
Batch_make (Batch_replace_contents (b ⧆ a) v) v' =
Batch_make (b ⧆ a) (coerce e in v') cbn.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: forall (v : Vector (length_Batch b) A')
(v' : Vector (length_Batch (Batch_replace_contents b v)) B)
(e : length_Batch (Batch_replace_contents b v) = length_Batch b),
Batch_make (Batch_replace_contents b v) v' = Batch_make b (coerce e in v')
Batch_make (Batch_replace_contents b (Vector_tl v))
  (Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd (coerce e in v'))
      specialize (IHb (Vector_tl v) (Vector_tl v')).
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: forall
e : length_Batch (Batch_replace_contents b (Vector_tl v)) = length_Batch b,
Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b (coerce e in Vector_tl v')
Batch_make (Batch_replace_contents b (Vector_tl v))
  (Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd (coerce e in v'))
      specialize (IHb (eq_sym (length_replace_contents b (Vector_tl v)))).
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Batch_make (Batch_replace_contents b (Vector_tl v))
  (Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd (coerce e in v'))
      replace (Vector_hd (coerce_Vector_length e v'))
        with (Vector_hd v') at 1.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Batch_make (Batch_replace_contents b (Vector_tl v))
  (Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      Set Keyed Unification.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Batch_make (Batch_replace_contents b (Vector_tl v))
  (Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      rewrite IHb.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Batch_make b
  (coerce eq_sym
            (length_replace_contents b (Vector_tl v))
   in Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      Unset Keyed Unification.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Batch_make b
  (coerce eq_sym
            (length_replace_contents b (Vector_tl v))
   in Vector_tl v') (Vector_hd v') =
Batch_make b (Vector_tl (coerce e in v'))
  (Vector_hd v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      fequal.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
coerce eq_sym
         (length_replace_contents b (Vector_tl v))
in Vector_tl v' = Vector_tl (coerce e in v')
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      {
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
coerce eq_sym
         (length_replace_contents b (Vector_tl v))
in Vector_tl v' = Vector_tl (coerce e in v') apply Vector_eq.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
proj1_sig
  (coerce eq_sym
            (length_replace_contents b (Vector_tl v))
   in Vector_tl v') =
proj1_sig (Vector_tl (coerce e in v'))
        rewrite <- coerce_Vector_contents.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
proj1_sig (Vector_tl v') =
proj1_sig (Vector_tl (coerce e in v'))
        apply Vector_tl_coerce_sim.
      }
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
v': Vector
  (length_Batch
     (Batch_replace_contents (b ⧆ a) v)) B
e: length_Batch (Batch_replace_contents (b ⧆ a) v) =
length_Batch (b ⧆ a)
IHb: Batch_make (Batch_replace_contents b (Vector_tl v)) (Vector_tl v') =
Batch_make b
(coerce eq_sym (length_replace_contents b (Vector_tl v)) in Vector_tl v')
Vector_hd v' = Vector_hd (coerce e in v')
      apply Vector_hd_coerce_eq.
  Qed.

  Lemma Batch_shape_replace_contents:
    forall {A A' B C: Type} (b: Batch A B C) `(v: Vector _ A'),
      shape (F := BATCH1 B C) b =
        shape (F := BATCH1 B C) (Batch_replace_contents b v).
forall (A A' B C : Type) (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
shape b = shape (Batch_replace_contents b v)
  Proof.
forall (A A' B C : Type) (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
shape b = shape (Batch_replace_contents b v)
    intros.
A, A', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
shape b = shape (Batch_replace_contents b v)
    induction b.
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
shape (Done c) =
shape (Batch_replace_contents (Done c) v)
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
shape b = shape (Batch_replace_contents b v)
shape (b ⧆ a) =
shape (Batch_replace_contents (b ⧆ a) v)
    -
A, A', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
shape (Done c) =
shape (Batch_replace_contents (Done c) v) reflexivity.
    -
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
shape b = shape (Batch_replace_contents b v)
shape (b ⧆ a) =
shape (Batch_replace_contents (b ⧆ a) v) cbn.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
shape b = shape (Batch_replace_contents b v)
mapfst_Batch (const tt) b ⧆ const tt a =
mapfst_Batch (const tt)
  (Batch_replace_contents b (Vector_tl v))
⧆ const tt (Vector_hd v) fequal.
A, A', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
shape b = shape (Batch_replace_contents b v)
mapfst_Batch (const tt) b =
mapfst_Batch (const tt)
  (Batch_replace_contents b (Vector_tl v))
      apply (IHb (Vector_tl v)).
  Qed.

  (** * Lens-like laws *)
  (******************************************************************************)
  Section lens_laws.

    Context {A A' A'' B C: Type}.

    Lemma Batch_make_contents:
      forall (b: Batch A A C),
        Batch_make b (Batch_contents b) = extract_Batch b.
A, A', A'', B, C: Type
forall b : Batch A A C,
Batch_make b (Batch_contents b) = extract_Batch b
    Proof.
A, A', A'', B, C: Type
forall b : Batch A A C,
Batch_make b (Batch_contents b) = extract_Batch b
      intros.
A, A', A'', B, C: Type
b: Batch A A C
Batch_make b (Batch_contents b) = extract_Batch b
      induction b.
A, A', A'', B, C: Type
c: C
Batch_make (Done c) (Batch_contents (Done c)) =
extract_Batch (Done c)
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make (b ⧆ a) (Batch_contents (b ⧆ a)) =
extract_Batch (b ⧆ a)
      -
A, A', A'', B, C: Type
c: C
Batch_make (Done c) (Batch_contents (Done c)) =
extract_Batch (Done c) reflexivity.
      -
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make (b ⧆ a) (Batch_contents (b ⧆ a)) =
extract_Batch (b ⧆ a) rewrite Batch_make_rw2.
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make b (Vector_tl (Batch_contents (b ⧆ a)))
  (Vector_hd (Batch_contents (b ⧆ a))) =
extract_Batch (b ⧆ a)
        rewrite Batch_contents_rw2.
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make b
  (Vector_tl
     (vcons (length_Batch b) a (Batch_contents b)))
  (Vector_hd
     (vcons (length_Batch b) a (Batch_contents b))) =
extract_Batch (b ⧆ a)
        rewrite Vector_tl_vcons.
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make b (Batch_contents b)
  (Vector_hd
     (vcons (length_Batch b) a (Batch_contents b))) =
extract_Batch (b ⧆ a)
        rewrite Vector_hd_vcons.
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
Batch_make b (Batch_contents b) a =
extract_Batch (b ⧆ a)
        rewrite IHb.
A, A', A'', B, C: Type
b: Batch A A (A -> C)
a: A
IHb: Batch_make b (Batch_contents b) = extract_Batch b
extract_Batch b a = extract_Batch (b ⧆ a)
        reflexivity.
    Qed.

    Lemma Batch_get_put:
      forall (b: Batch A B C),
        Batch_replace_contents b (Batch_contents b) = b.
A, A', A'', B, C: Type
forall b : Batch A B C,
Batch_replace_contents b (Batch_contents b) = b
    Proof.
A, A', A'', B, C: Type
forall b : Batch A B C,
Batch_replace_contents b (Batch_contents b) = b
      intros.
A, A', A'', B, C: Type
b: Batch A B C
Batch_replace_contents b (Batch_contents b) = b
      induction b.
A, A', A'', B, C: Type
c: C
Batch_replace_contents (Done c)
  (Batch_contents (Done c)) = Done c
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
Batch_replace_contents (b ⧆ a)
  (Batch_contents (b ⧆ a)) = b ⧆ a
      -
A, A', A'', B, C: Type
c: C
Batch_replace_contents (Done c)
  (Batch_contents (Done c)) = Done c reflexivity.
      -
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
Batch_replace_contents (b ⧆ a)
  (Batch_contents (b ⧆ a)) = b ⧆ a cbn.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
Batch_replace_contents b
  (Vector_tl
     (vcons (length_Batch b) a (Batch_contents b)))
⧆ Vector_hd
    (vcons (length_Batch b) a (Batch_contents b)) =
b ⧆ a
        rewrite Vector_tl_vcons.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
Batch_replace_contents b (Batch_contents b)
⧆ Vector_hd
    (vcons (length_Batch b) a (Batch_contents b)) =
b ⧆ a
        rewrite Vector_hd_vcons.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
Batch_replace_contents b (Batch_contents b) ⧆ a =
b ⧆ a
        rewrite IHb.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
IHb: Batch_replace_contents b (Batch_contents b) = b
b ⧆ a = b ⧆ a
        reflexivity.
    Qed.

    Lemma Batch_put_get:
      forall (b: Batch A B C) (v: Vector (length_Batch b) A'),
        Batch_contents (Batch_replace_contents b v) =
          coerce length_replace_contents b v in v.
A, A', A'', B, C: Type
forall (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
Batch_contents (Batch_replace_contents b v) =
coerce length_replace_contents b v in v
    Proof.
A, A', A'', B, C: Type
forall (b : Batch A B C)
  (v : Vector (length_Batch b) A'),
Batch_contents (Batch_replace_contents b v) =
coerce length_replace_contents b v in v
      intros.
A, A', A'', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
Batch_contents (Batch_replace_contents b v) =
coerce length_replace_contents b v in v
      generalize (length_replace_contents b v).
A, A', A'', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
forall
  e : length_Batch b =
      length_Batch (Batch_replace_contents b v),
Batch_contents (Batch_replace_contents b v) =
coerce e in v
      intros Heq.
A, A', A'', B, C: Type
b: Batch A B C
v: Vector (length_Batch b) A'
Heq: length_Batch b = length_Batch (Batch_replace_contents b v)
Batch_contents (Batch_replace_contents b v) =
coerce Heq in v
      induction b.
A, A', A'', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (Batch_replace_contents (Done c) v)
Batch_contents (Batch_replace_contents (Done c) v) =
coerce Heq in v
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (Batch_replace_contents (b ⧆ a) v)
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (Batch_replace_contents b v)),
Batch_contents (Batch_replace_contents b v) = coerce Heq in v
Batch_contents (Batch_replace_contents (b ⧆ a) v) =
coerce Heq in v
      -
A, A', A'', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (Batch_replace_contents (Done c) v)
Batch_contents (Batch_replace_contents (Done c) v) =
coerce Heq in v cbn.
A, A', A'', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (Batch_replace_contents (Done c) v)
vnil = coerce Heq in v symmetry.
A, A', A'', B, C: Type
c: C
v: Vector (length_Batch (Done c)) A'
Heq: length_Batch (Done c) = length_Batch (Batch_replace_contents (Done c) v)
coerce Heq in v = vnil
        apply Vector_nil_eq.
      -
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (length_Batch (b ⧆ a)) A'
Heq: length_Batch (b ⧆ a) = length_Batch (Batch_replace_contents (b ⧆ a) v)
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (Batch_replace_contents b v)),
Batch_contents (Batch_replace_contents b v) = coerce Heq in v
Batch_contents (Batch_replace_contents (b ⧆ a) v) =
coerce Heq in v cbn in *.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (Batch_replace_contents b v)),
Batch_contents (Batch_replace_contents b v) = coerce Heq in v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v)
  (Batch_contents
     (Batch_replace_contents b (Vector_tl v))) =
coerce Heq in v
        rewrite Vector_surjective_pairing2.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (Batch_replace_contents b v)),
Batch_contents (Batch_replace_contents b v) = coerce Heq in v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v)
  (Batch_contents
     (Batch_replace_contents b (Vector_tl v))) =
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd (coerce Heq in v))
  (Vector_tl (coerce Heq in v))
        rewrite <- (Vector_hd_coerce_eq (Heq := Heq) (v := v)).
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: forall (v : Vector (length_Batch b) A')
(Heq : length_Batch b = length_Batch (Batch_replace_contents b v)),
Batch_contents (Batch_replace_contents b v) = coerce Heq in v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v)
  (Batch_contents
     (Batch_replace_contents b (Vector_tl v))) =
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v) (Vector_tl (coerce Heq in v))
        specialize (IHb (Vector_tl v) (S_uncons Heq)).
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: Batch_contents (Batch_replace_contents b (Vector_tl v)) =
coerce S_uncons Heq in Vector_tl v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v)
  (Batch_contents
     (Batch_replace_contents b (Vector_tl v))) =
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v) (Vector_tl (coerce Heq in v))
        fold (@length_Batch A B).
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: Batch_contents (Batch_replace_contents b (Vector_tl v)) =
coerce S_uncons Heq in Vector_tl v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v)
  (Batch_contents
     (Batch_replace_contents b (Vector_tl v))) =
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v) (Vector_tl (coerce Heq in v))
        (* ^^ I have no idea why this got expanded but it blocks rewriting *)
        rewrite IHb.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: Batch_contents (Batch_replace_contents b (Vector_tl v)) =
coerce S_uncons Heq in Vector_tl v
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v) (coerce S_uncons Heq in Vector_tl v) =
vcons
  (length_Batch
     (Batch_replace_contents b (Vector_tl v)))
  (Vector_hd v) (Vector_tl (coerce Heq in v))
        fequal.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: Batch_contents (Batch_replace_contents b (Vector_tl v)) =
coerce S_uncons Heq in Vector_tl v
coerce S_uncons Heq in Vector_tl v =
Vector_tl (coerce Heq in v)
        apply Vector_sim_eq.
A, A', A'', B, C: Type
b: Batch A B (B -> C)
a: A
v: Vector (S (length_Batch b)) A'
Heq: S (length_Batch b) =
S (length_Batch (Batch_replace_contents b (Vector_tl v)))
IHb: Batch_contents (Batch_replace_contents b (Vector_tl v)) =
coerce S_uncons Heq in Vector_tl v
coerce S_uncons Heq in Vector_tl v ~~
Vector_tl (coerce Heq in v)
        vector_sim.
    Qed.

    Lemma Batch_put_put:
      forall (b: Batch A B C)
        (v1: Vector (length_Batch b) A')
        (v2: Vector (length_Batch b) A''),
        Batch_replace_contents
          (Batch_replace_contents b v1)
          (coerce (length_replace_contents b v1) in v2) =
          Batch_replace_contents b v2.
A, A', A'', B, C: Type
forall (b : Batch A B C)
  (v1 : Vector (length_Batch b) A')
  (v2 : Vector (length_Batch b) A''),
Batch_replace_contents (Batch_replace_contents b v1)
  (coerce length_replace_contents b v1 in v2) =
Batch_replace_contents b v2
    Proof.
A, A', A'', B, C: Type
forall (b : Batch A B C)
  (v1 : Vector (length_Batch b) A')
  (v2 : Vector (length_Batch b) A''),
Batch_replace_contents (Batch_replace_contents b v1)
  (coerce length_replace_contents b v1 in v2) =
Batch_replace_contents b v2
      intros.
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
Batch_replace_contents (Batch_replace_contents b v1)
  (coerce length_replace_contents b v1 in v2) =
Batch_replace_contents b v2
      apply Batch_replace_sim3.
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
shape (Batch_replace_contents b v1) = shape b
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
coerce length_replace_contents b v1 in v2 ~~ v2
      symmetry.
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
shape b = shape (Batch_replace_contents b v1)
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
coerce length_replace_contents b v1 in v2 ~~ v2
      apply Batch_shape_replace_contents.
A, A', A'', B, C: Type
b: Batch A B C
v1: Vector (length_Batch b) A'
v2: Vector (length_Batch b) A''
coerce length_replace_contents b v1 in v2 ~~ v2
      vector_sim.
    Qed.

  End lens_laws.

  (** ** Batch is Shapely *)
  (******************************************************************************)
  Section Batch_shapely.

    Context {A B C: Type}.

    Lemma Batch_shapeliness: forall (b1 b2: Batch A B C),
        (shape (F := BATCH1 B C) b1 =
           shape (F := BATCH1 B C) b2) ->
        tolist (F := BATCH1 B C) b1 = tolist b2 ->
        b1 = b2.
A, B, C: Type
forall b1 b2 : Batch A B C,
shape b1 = shape b2 ->
tolist b1 = tolist b2 -> b1 = b2
    Proof.
A, B, C: Type
forall b1 b2 : Batch A B C,
shape b1 = shape b2 ->
tolist b1 = tolist b2 -> b1 = b2
      introv Hshape.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
tolist b1 = tolist b2 -> b1 = b2
      apply (Batch_simultaneous_ind Hshape).
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C),
tolist (Done c) = tolist (Done c) -> Done c = Done c
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 b2 : Batch A B (B -> C)),
(tolist b1 = tolist b2 -> b1 = b2) ->
forall a1 a2 : A,
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
tolist (b1 ⧆ a1) = tolist (b2 ⧆ a2) ->
b1 ⧆ a1 = b2 ⧆ a2
      -
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
forall (C : Type) (c : C),
tolist (Done c) = tolist (Done c) -> Done c = Done c intros; reflexivity.
      -
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
forall (C : Type) (b1 b2 : Batch A B (B -> C)),
(tolist b1 = tolist b2 -> b1 = b2) ->
forall a1 a2 : A,
shape (b1 ⧆ a1) = shape (b2 ⧆ a2) ->
tolist (b1 ⧆ a1) = tolist (b2 ⧆ a2) ->
b1 ⧆ a1 = b2 ⧆ a2 intros X b1' b2' Heq a1 a2 Hshape' Hlist.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist (b1' ⧆ a1) = tolist (b2' ⧆ a2)
b1' ⧆ a1 = b2' ⧆ a2
        rewrite tolist_Batch_rw2 in Hlist.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ a1 :: nil = tolist (b2' ⧆ a2)
b1' ⧆ a1 = b2' ⧆ a2
        rewrite tolist_Batch_rw2 in Hlist.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ a1 :: nil =
tolist b2' ++ a2 :: nil
b1' ⧆ a1 = b2' ⧆ a2
        do 2 change (?x::nil) with (ret list _ x) in Hlist.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
b1' ⧆ a1 = b2' ⧆ a2
        assert (a1 = a2).
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
a1 = a2
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
b1' ⧆ a1 = b2' ⧆ a2
        {
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
a1 = a2 eapply list_app_inv_r2; eauto. }
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
b1' ⧆ a1 = b2' ⧆ a2
        assert (b1' = b2').
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
b1' = b2'
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
H0: b1' = b2'
b1' ⧆ a1 = b2' ⧆ a2
        {
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
b1' = b2' apply Heq.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
tolist b1' = tolist b2' eapply list_app_inv_l2.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
tolist b1' ++ ret list A ?a1 =
tolist b2' ++ ret list A ?a2
          eauto. }
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b1', b2': Batch A B (B -> X)
Heq: tolist b1' = tolist b2' -> b1' = b2'
a1, a2: A
Hshape': shape (b1' ⧆ a1) = shape (b2' ⧆ a2)
Hlist: tolist b1' ++ ret list A a1 =
tolist b2' ++ ret list A a2
H: a1 = a2
H0: b1' = b2'
b1' ⧆ a1 = b2' ⧆ a2
        subst.
A, B, C: Type
b1, b2: Batch A B C
Hshape: shape b1 = shape b2
X: Type
b2': Batch A B (B -> X)
Heq: tolist b2' = tolist b2' -> b2' = b2'
a2: A
Hshape': shape (b2' ⧆ a2) = shape (b2' ⧆ a2)
Hlist: tolist b2' ++ ret list A a2 =
tolist b2' ++ ret list A a2
b2' ⧆ a2 = b2' ⧆ a2
        reflexivity.
    Qed.

  End Batch_shapely.

End deconstruction.

(** * Theory About Batch *)
(******************************************************************************)
Section Batch_theory.

  Lemma Batch_make_precompose1:
    forall {A B C' C D: Type} (b: Batch A B (C -> D)) (f: C' -> C)
      (v: Vector (length_Batch b) B)
      (v': Vector (length_Batch (map _ (precompose f) b)) B)
      (Hsim: v ~~ v')
      (c: C'),
      Batch_make (map (Batch A B) (precompose f) b) v' c =
        Batch_make b v (f c).
forall (A B C' C D : Type) (b : Batch A B (C -> D))
  (f : C' -> C) (v : Vector (length_Batch b) B)
  (v' : Vector
          (length_Batch
             (map (Batch A B) (precompose f) b)) B),
v ~~ v' ->
forall c : C',
Batch_make (map (Batch A B) (precompose f) b) v' c =
Batch_make b v (f c)
  Proof.
forall (A B C' C D : Type) (b : Batch A B (C -> D))
  (f : C' -> C) (v : Vector (length_Batch b) B)
  (v' : Vector
          (length_Batch
             (map (Batch A B) (precompose f) b)) B),
v ~~ v' ->
forall c : C',
Batch_make (map (Batch A B) (precompose f) b) v' c =
Batch_make b v (f c)
    intros.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
Batch_make (map (Batch A B) (precompose f) b) v' c =
Batch_make b v (f c)
    rewrite (Batch_make_natural_rw2 b (precompose f) v').
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
precompose f
  (Batch_make b
     (coerce eq_sym
               (batch_length_map (precompose f) b)
      in v')) c = Batch_make b v (f c)
    unfold precompose.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
Batch_make b
  (coerce eq_sym
            (batch_length_map
               (fun g : C -> D => g ○ f) b) in v')
  (f c) = Batch_make b v (f c)
    fequal.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
coerce eq_sym
         (batch_length_map (fun g : C -> D => g ○ f) b)
in v' = v
    apply Vector_sim_eq.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
coerce eq_sym
         (batch_length_map (fun g : C -> D => g ○ f) b)
in v' ~~ v
    apply Vector_coerce_sim_l'.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
v' ~~ v
    symmetry.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector (length_Batch b) B
v': Vector
  (length_Batch
     (map (Batch A B) (precompose f) b)) B
Hsim: v ~~ v'
c: C'
proj1_sig v = proj1_sig v'
    assumption.
  Qed.

  Lemma Batch_make_precompose2:
    forall {A B C' C D: Type} (b: Batch A B (C -> D)) (f: C' -> C)
      (v: Vector (length_Batch (map _ (precompose f) b)) B)
      (c: C'),
      Batch_make (map _ (precompose f) b) v c =
        Batch_make b (coerce eq_sym (batch_length_map (precompose f) b) in v) (f c).
forall (A B C' C D : Type) (b : Batch A B (C -> D))
  (f : C' -> C)
  (v : Vector
         (length_Batch
            (map (Batch A B) (precompose f) b)) B)
  (c : C'),
Batch_make (map (Batch A B) (precompose f) b) v c =
Batch_make b
  (coerce eq_sym (batch_length_map (precompose f) b)
   in v) (f c)
  Proof.
forall (A B C' C D : Type) (b : Batch A B (C -> D))
  (f : C' -> C)
  (v : Vector
         (length_Batch
            (map (Batch A B) (precompose f) b)) B)
  (c : C'),
Batch_make (map (Batch A B) (precompose f) b) v c =
Batch_make b
  (coerce eq_sym (batch_length_map (precompose f) b)
   in v) (f c)
    intros.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector
  (length_Batch (map (Batch A B) (precompose f) b))
  B
c: C'
Batch_make (map (Batch A B) (precompose f) b) v c =
Batch_make b
  (coerce eq_sym (batch_length_map (precompose f) b)
   in v) (f c)
    apply Batch_make_precompose1.
A, B, C', C, D: Type
b: Batch A B (C -> D)
f: C' -> C
v: Vector
  (length_Batch (map (Batch A B) (precompose f) b))
  B
c: C'
coerce eq_sym (batch_length_map (precompose f) b) in v ~~
v
    apply Vector_coerce_sim_l.
  Qed.

  Lemma Batch_make_natural1:
    forall {A B B' C: Type} (b: Batch A B' C) (f: B -> B')
      (v: Vector (length_Batch b) B)
      (v': Vector (length_Batch (mapsnd_Batch f b)) B),
      v ~~ v' ->
      Batch_make b (map _ f v) =
        Batch_make (mapsnd_Batch f b) v'.
forall (A B B' C : Type) (b : Batch A B' C)
  (f : B -> B') (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b)) B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
  Proof.
forall (A B B' C : Type) (b : Batch A B' C)
  (f : B -> B') (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b)) B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
    introv Hsim.
A, B, B', C: Type
b: Batch A B' C
f: B -> B'
v: Vector (length_Batch b) B
v': Vector (length_Batch (mapsnd_Batch f b)) B
Hsim: v ~~ v'
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
    induction b.
A, B, B', C: Type
c: C
f: B -> B'
v: Vector (length_Batch (Done c)) B
v': Vector (length_Batch (mapsnd_Batch f (Done c))) B
Hsim: v ~~ v'
Batch_make (Done c)
  (map (Vector (length_Batch (Done c))) f v) =
Batch_make (mapsnd_Batch f (Done c)) v'
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (length_Batch (b ⧆ a)) B
v': Vector (length_Batch (mapsnd_Batch f (b ⧆ a))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make (b ⧆ a)
  (map (Vector (length_Batch (b ⧆ a))) f v) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
    -
A, B, B', C: Type
c: C
f: B -> B'
v: Vector (length_Batch (Done c)) B
v': Vector (length_Batch (mapsnd_Batch f (Done c))) B
Hsim: v ~~ v'
Batch_make (Done c)
  (map (Vector (length_Batch (Done c))) f v) =
Batch_make (mapsnd_Batch f (Done c)) v' cbn in v, v'.
A, B, B', C: Type
c: C
f: B -> B'
v, v': Vector 0 B
Hsim: v ~~ v'
Batch_make (Done c)
  (map (Vector (length_Batch (Done c))) f v) =
Batch_make (mapsnd_Batch f (Done c)) v'
      rewrite (Vector_nil_eq v).
A, B, B', C: Type
c: C
f: B -> B'
v, v': Vector 0 B
Hsim: v ~~ v'
Batch_make (Done c)
  (map (Vector (length_Batch (Done c))) f vnil) =
Batch_make (mapsnd_Batch f (Done c)) v'
      rewrite (Vector_nil_eq v').
A, B, B', C: Type
c: C
f: B -> B'
v, v': Vector 0 B
Hsim: v ~~ v'
Batch_make (Done c)
  (map (Vector (length_Batch (Done c))) f vnil) =
Batch_make (mapsnd_Batch f (Done c)) vnil
      reflexivity.
    -
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (length_Batch (b ⧆ a)) B
v': Vector (length_Batch (mapsnd_Batch f (b ⧆ a))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make (b ⧆ a)
  (map (Vector (length_Batch (b ⧆ a))) f v) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v' cbn in v, v'.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make (b ⧆ a)
  (map (Vector (length_Batch (b ⧆ a))) f v) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      (* LHS *)
      rewrite Batch_make_rw2.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (Vector_tl (map (Vector (length_Batch (b ⧆ a))) f v))
  (Vector_hd (map (Vector (length_Batch (b ⧆ a))) f v)) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      rewrite (Vector_surjective_pairing2 (v := v)).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (Vector_tl
     (map (Vector (length_Batch (b ⧆ a))) f
        (vcons (length_Batch b) (Vector_hd v)
           (Vector_tl v))))
  (Vector_hd
     (map (Vector (length_Batch (b ⧆ a))) f
        (vcons (length_Batch b) (Vector_hd v)
           (Vector_tl v)))) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      rewrite (map_Vector_vcons f (length_Batch b) _ (Vector_hd v)).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (Vector_tl
     (vcons (length_Batch b) (f (Vector_hd v))
        (map (Vector (length_Batch b)) f (Vector_tl v))))
  (Vector_hd
     (vcons (length_Batch b) (f (Vector_hd v))
        (map (Vector (length_Batch b)) f (Vector_tl v)))) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      rewrite Vector_tl_vcons.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (Vector_hd
     (vcons (length_Batch b) (f (Vector_hd v))
        (map (Vector (length_Batch b)) f (Vector_tl v)))) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      rewrite Vector_hd_vcons.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      (* RHS *)
      try rewrite (mapsnd_Batch_rw2 (B := B) f a b).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make (mapsnd_Batch f (b ⧆ a)) v'
      (* ^^^ fails for some reason *)
      cbn.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make
  (map (Batch A B) (precompose f) (mapsnd_Batch f b))
  (Vector_tl v') (Vector_hd v')
      rewrite (Batch_make_precompose2 (mapsnd_Batch f b) _).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
      assert (cut: f (Vector_hd v) = f (Vector_hd v')).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
f (Vector_hd v) = f (Vector_hd v')
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) 
           (precompose f) 
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b)) in 
   Vector_tl v') (f (Vector_hd v'))
      {
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
f (Vector_hd v) = f (Vector_hd v') inversion Hsim.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
H0: proj1_sig v = proj1_sig v'
f (Vector_hd v) = f (Vector_hd v')
        fequal.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
H0: proj1_sig v = proj1_sig v'
Vector_hd v = Vector_hd v'
        apply (Vector_hd_sim Hsim). }
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
      rewrite cut.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall (v : Vector (length_Batch b) B)
  (v' : Vector (length_Batch (mapsnd_Batch f b))
          B),
v ~~ v' ->
Batch_make b (map (Vector (length_Batch b)) f v) =
Batch_make (mapsnd_Batch f b) v'
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v')) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
      specialize (IHb (Vector_tl v)).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: forall
  v' : Vector (length_Batch (mapsnd_Batch f b))
         B,
Vector_tl v ~~ v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b) v'
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v')) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
      specialize (IHb
                    (coerce eq_sym (batch_length_map (precompose f)
                                      (mapsnd_Batch f b))
                      in Vector_tl v')).
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v))
  (f (Vector_hd v')) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
      rewrite IHb.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v')) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v'))
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) 
           (precompose f) 
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v'
      +
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v')) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map (precompose f)
               (mapsnd_Batch f b)) in Vector_tl v')
  (f (Vector_hd v')) reflexivity.
      +
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Vector_tl v ~~
coerce eq_sym
         (batch_length_map (precompose f)
            (mapsnd_Batch f b)) in Vector_tl v' apply Vector_coerce_sim_r'.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
Vector_tl v ~~ Vector_tl v'
        apply Vector_tl_sim.
A, B, B', C: Type
b: Batch A B' (B' -> C)
a: A
f: B -> B'
v: Vector (S (length_Batch b)) B
v': Vector
  (S
     (length_Batch
        (map (Batch A B) (precompose f)
           (mapsnd_Batch f b)))) B
Hsim: v ~~ v'
IHb: Vector_tl v ~~
coerce eq_sym
         (batch_length_map 
            (precompose f) 
            (mapsnd_Batch f b)) in 
Vector_tl v' ->
Batch_make b
  (map (Vector (length_Batch b)) f (Vector_tl v)) =
Batch_make (mapsnd_Batch f b)
  (coerce eq_sym
            (batch_length_map 
               (precompose f) 
               (mapsnd_Batch f b))
   in Vector_tl v')
cut: f (Vector_hd v) = f (Vector_hd v')
v ~~ v'
        assumption.
  Qed.

  Lemma map_coerce_Vector:
    forall (n m: nat) (Heq: n = m)
      (A B: Type) (f: A -> B) (v: Vector n A),
      coerce Heq in (map _ f v) = map _ f (coerce Heq in v).
forall (n m : nat) (Heq : n = m) (A B : Type)
  (f : A -> B) (v : Vector n A),
coerce Heq in map (Vector n) f v =
map (Vector m) f (coerce Heq in v)
  Proof.
forall (n m : nat) (Heq : n = m) (A B : Type)
  (f : A -> B) (v : Vector n A),
coerce Heq in map (Vector n) f v =
map (Vector m) f (coerce Heq in v)
    intros.
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
coerce Heq in map (Vector n) f v =
map (Vector m) f (coerce Heq in v)
    apply Vector_sim_eq.
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
coerce Heq in map (Vector n) f v ~~
map (Vector m) f (coerce Heq in v)
    apply (transitive_Vector_sim (v2 := map _ f v)).
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
coerce Heq in map (Vector n) f v ~~ map (Vector n) f v
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
map (Vector n) f v ~~
map (Vector m) f (coerce Heq in v)
    -
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
coerce Heq in map (Vector n) f v ~~ map (Vector n) f v apply symmetric_Vector_sim.
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
map (Vector n) f v ~~ coerce Heq in map (Vector n) f v
      apply Vector_coerce_sim_r.
    -
n, m: nat
Heq: n = m
A, B: Type
f: A -> B
v: Vector n A
map (Vector n) f v ~~
map (Vector m) f (coerce Heq in v) apply map_coerce_Vector.
  Qed.

  Lemma Batch_make_natural2:
    forall {A B B' C: Type} (b: Batch A B' C) (f: B -> B')
      (v: Vector (length_Batch (mapsnd_Batch f b)) B),
      Batch_make (mapsnd_Batch f b) v =
        Batch_make b (coerce (eq_sym (batch_length_mapsnd f b)) in (map _ f v)).
forall (A B B' C : Type) (b : Batch A B' C)
  (f : B -> B')
  (v : Vector (length_Batch (mapsnd_Batch f b)) B),
Batch_make (mapsnd_Batch f b) v =
Batch_make b
  (coerce eq_sym (batch_length_mapsnd f b)
   in map (Vector (length_Batch (mapsnd_Batch f b))) f
        v)
  Proof.
forall (A B B' C : Type) (b : Batch A B' C)
  (f : B -> B')
  (v : Vector (length_Batch (mapsnd_Batch f b)) B),
Batch_make (mapsnd_Batch f b) v =
Batch_make b
  (coerce eq_sym (batch_length_mapsnd f b)
   in map (Vector (length_Batch (mapsnd_Batch f b))) f
        v)
    intros.
A, B, B', C: Type
b: Batch A B' C
f: B -> B'
v: Vector (length_Batch (mapsnd_Batch f b)) B
Batch_make (mapsnd_Batch f b) v =
Batch_make b
  (coerce eq_sym (batch_length_mapsnd f b)
   in map (Vector (length_Batch (mapsnd_Batch f b))) f
        v)
    symmetry.
A, B, B', C: Type
b: Batch A B' C
f: B -> B'
v: Vector (length_Batch (mapsnd_Batch f b)) B
Batch_make b
  (coerce eq_sym (batch_length_mapsnd f b)
   in map (Vector (length_Batch (mapsnd_Batch f b))) f
        v) = Batch_make (mapsnd_Batch f b) v
    rewrite map_coerce_Vector.
A, B, B', C: Type
b: Batch A B' C
f: B -> B'
v: Vector (length_Batch (mapsnd_Batch f b)) B
Batch_make b
  (map (Vector (length_Batch b)) f
     (coerce eq_sym (batch_length_mapsnd f b) in v)) =
Batch_make (mapsnd_Batch f b) v
    apply (Batch_make_natural1 b f _ v).
A, B, B', C: Type
b: Batch A B' C
f: B -> B'
v: Vector (length_Batch (mapsnd_Batch f b)) B
coerce eq_sym (batch_length_mapsnd f b) in v ~~ v
    apply Vector_coerce_sim_l.
  Qed.

End Batch_theory.

(** ** Misc *)
(******************************************************************************)
Section spec.

  Lemma runBatch_const_contents:
    forall `{Applicative G} `(b: Batch A B C)
      (x: G B) `(v: Vector _ A'),
      runBatch (G := G) (const x) b =
        runBatch (G := G) (const x)
          (Batch_replace_contents b v).
forall (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B C : Type) (b : Batch A B C) (x : G B)
  (A' : Type) (v : Vector (length_Batch b) A'),
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
  Proof.
forall (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B C : Type) (b : Batch A B C) (x : G B)
  (A' : Type) (v : Vector (length_Batch b) A'),
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
    intros.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
x: G B
A': Type
v: Vector (length_Batch b) A'
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
    induction b.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
x: G B
A': Type
v: Vector (length_Batch (Done c)) A'
runBatch (const x) (Done c) =
runBatch (const x) (Batch_replace_contents (Done c) v)
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
x: G B
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
runBatch (const x) (b ⧆ a) =
runBatch (const x) (Batch_replace_contents (b ⧆ a) v)
    -
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
x: G B
A': Type
v: Vector (length_Batch (Done c)) A'
runBatch (const x) (Done c) =
runBatch (const x) (Batch_replace_contents (Done c) v) reflexivity.
    -
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
x: G B
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
runBatch (const x) (b ⧆ a) =
runBatch (const x) (Batch_replace_contents (b ⧆ a) v) cbn.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
x: G B
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
runBatch (const x) b <⋆> const x a =
runBatch (const x)
  (Batch_replace_contents b (Vector_tl v)) <⋆>
const x (Vector_hd v) fequal.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
x: G B
A': Type
v: Vector (length_Batch (b ⧆ a)) A'
IHb: forall v : Vector (length_Batch b) A',
runBatch (const x) b =
runBatch (const x) (Batch_replace_contents b v)
runBatch (const x) b =
runBatch (const x)
  (Batch_replace_contents b (Vector_tl v)) apply IHb.
  Qed.

  Lemma Batch_eq_iff:
    forall `(b1: Batch A B C) `(b2: Batch A B C),
      b1 = b2 <->
        Batch_make b1 ~!~ Batch_make b2 /\
          Batch_contents b1 ~~ Batch_contents b2.
forall (A B C : Type) (b1 b2 : Batch A B C),
b1 = b2 <->
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2
  Proof.
forall (A B C : Type) (b1 b2 : Batch A B C),
b1 = b2 <->
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2
    intros.
A, B, C: Type
b1, b2: Batch A B C
b1 = b2 <->
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2 split.
A, B, C: Type
b1, b2: Batch A B C
b1 = b2 ->
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2
A, B, C: Type
b1, b2: Batch A B C
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2 -> b1 = b2
    -
A, B, C: Type
b1, b2: Batch A B C
b1 = b2 ->
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2 intros; subst.
A, B, C: Type
b2: Batch A B C
Batch_make b2 ~!~ Batch_make b2 /\
Batch_contents b2 ~~ Batch_contents b2 split.
A, B, C: Type
b2: Batch A B C
Batch_make b2 ~!~ Batch_make b2
A, B, C: Type
b2: Batch A B C
Batch_contents b2 ~~ Batch_contents b2
      2: reflexivity.
A, B, C: Type
b2: Batch A B C
Batch_make b2 ~!~ Batch_make b2
      unfold Vector_fun_sim.
A, B, C: Type
b2: Batch A B C
length_Batch b2 = length_Batch b2 /\
(forall v1 v2 : Vector (length_Batch b2) B,
 v1 ~~ v2 -> Batch_make b2 v1 = Batch_make b2 v2)
      split; try reflexivity.
A, B, C: Type
b2: Batch A B C
forall v1 v2 : Vector (length_Batch b2) B,
v1 ~~ v2 -> Batch_make b2 v1 = Batch_make b2 v2
      introv Hsim.
A, B, C: Type
b2: Batch A B C
v1, v2: Vector (length_Batch b2) B
Hsim: v1 ~~ v2
Batch_make b2 v1 = Batch_make b2 v2
      auto using Batch_make_sim1.
    -
A, B, C: Type
b1, b2: Batch A B C
Batch_make b1 ~!~ Batch_make b2 /\
Batch_contents b1 ~~ Batch_contents b2 -> b1 = b2 intros [Hmake Hcontents].
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
b1 = b2
      rewrite <- (Batch_get_put b1).
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
Batch_replace_contents b1 (Batch_contents b1) = b2
      rewrite <- (Batch_get_put b2).
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
Batch_replace_contents b1 (Batch_contents b1) =
Batch_replace_contents b2 (Batch_contents b2)
      apply Batch_replace_sim3.
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
shape b1 = shape b2
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
Batch_contents b1 ~~ Batch_contents b2
      now apply Batch_make_shape_rev.
A, B, C: Type
b1, b2: Batch A B C
Hmake: Batch_make b1 ~!~ Batch_make b2
Hcontents: Batch_contents b1 ~~ Batch_contents b2
Batch_contents b1 ~~ Batch_contents b2
      assumption.
  Qed.

End spec.

(** * Representation theorems *)
(******************************************************************************)
Lemma runBatch_repr1 `{Applicative G}:
  forall `(b: Batch A B C) (f: A -> G B),
    map G (Batch_make b)
      (traverse (T := Vector (length_Batch b)) f (Batch_contents b)) =
      forwards (runBatch (G := Backwards G) (mkBackwards ∘ f) b).
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
forall (A B C : Type) (b : Batch A B C) (f : A -> G B),
map G (Batch_make b) (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
Proof.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
forall (A B C : Type) (b : Batch A B C) (f : A -> G B),
map G (Batch_make b) (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
  intros.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
map G (Batch_make b) (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
  induction b.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
f: A -> G B
map G (Batch_make (Done c))
  (traverse f (Batch_contents (Done c))) =
forwards (runBatch (mkBackwards ∘ f) (Done c))
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (traverse f (Batch_contents (b ⧆ a))) =
forwards (runBatch (mkBackwards ∘ f) (b ⧆ a))
  -
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
f: A -> G B
map G (Batch_make (Done c))
  (traverse f (Batch_contents (Done c))) =
forwards (runBatch (mkBackwards ∘ f) (Done c)) cbn.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
f: A -> G B
map G (fun _ : Vector 0 B => c)
  (pure G
     (exist (fun l : list B => length l = 0) nil
        eq_refl)) = pure G c
    rewrite app_pure_natural.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
c: C
f: A -> G B
pure G c = pure G c
    reflexivity.
  -
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (traverse f (Batch_contents (b ⧆ a))) =
forwards (runBatch (mkBackwards ∘ f) (b ⧆ a)) rewrite Batch_contents_rw2.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (traverse f
     (vcons (length_Batch b) a (Batch_contents b))) =
forwards (runBatch (mkBackwards ∘ f) (b ⧆ a))
    unfold length_Batch at 2. (* hidden *)
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (traverse f
     (vcons (length_Batch b) a (Batch_contents b))) =
forwards (runBatch (mkBackwards ∘ f) (b ⧆ a))
    rewrite traverse_Vector_vcons.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (pure G (vcons (length_Batch b)) <⋆> f a <⋆>
   traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) (b ⧆ a))
    rewrite runBatch_rw2.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (pure G (vcons (length_Batch b)) <⋆> f a <⋆>
   traverse f (Batch_contents b)) =
forwards
  (runBatch (mkBackwards ∘ f) b <⋆>
   (mkBackwards ∘ f) a)
    rewrite forwards_ap.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (Batch_make (b ⧆ a))
  (pure G (vcons (length_Batch b)) <⋆> f a <⋆>
   traverse f (Batch_contents b)) =
map G evalAt (forwards ((mkBackwards ∘ f) a)) <⋆>
forwards (runBatch (mkBackwards ∘ f) b)
    rewrite map_ap.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (compose (Batch_make (b ⧆ a)))
  (pure G (vcons (length_Batch b)) <⋆> f a) <⋆>
traverse f (Batch_contents b) =
map G evalAt (forwards ((mkBackwards ∘ f) a)) <⋆>
forwards (runBatch (mkBackwards ∘ f) b)
    rewrite map_ap.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
map G (compose (compose (Batch_make (b ⧆ a))))
  (pure G (vcons (length_Batch b))) <⋆> f a <⋆>
traverse f (Batch_contents b) =
map G evalAt (forwards ((mkBackwards ∘ f) a)) <⋆>
forwards (runBatch (mkBackwards ∘ f) b)
    rewrite app_pure_natural.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
map G evalAt (forwards ((mkBackwards ∘ f) a)) <⋆>
forwards (runBatch (mkBackwards ∘ f) b)
    rewrite <- IHb.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
map G evalAt (forwards ((mkBackwards ∘ f) a)) <⋆>
map G (Batch_make b) (traverse f (Batch_contents b))
    rewrite map_to_ap.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
pure G evalAt <⋆> forwards ((mkBackwards ∘ f) a) <⋆>
map G (Batch_make b) (traverse f (Batch_contents b))
    rewrite <- ap_map.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
map G (precompose (Batch_make b))
  (pure G evalAt <⋆> forwards ((mkBackwards ∘ f) a)) <⋆>
traverse f (Batch_contents b)
    rewrite map_ap.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
map G (compose (precompose (Batch_make b)))
  (pure G evalAt) <⋆> forwards ((mkBackwards ∘ f) a) <⋆>
traverse f (Batch_contents b)
    rewrite app_pure_natural.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a <⋆>
traverse f (Batch_contents b) =
pure G (precompose (Batch_make b) ∘ evalAt) <⋆>
forwards ((mkBackwards ∘ f) a) <⋆>
traverse f (Batch_contents b)
    fequal.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) <⋆> f a =
pure G (precompose (Batch_make b) ∘ evalAt) <⋆>
forwards ((mkBackwards ∘ f) a)
    fequal.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
pure G
  (compose (Batch_make (b ⧆ a))
   ∘ vcons (length_Batch b)) =
pure G (precompose (Batch_make b) ∘ evalAt)
    fequal.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
compose (Batch_make (b ⧆ a)) ∘ vcons (length_Batch b) =
precompose (Batch_make b) ∘ evalAt
    ext b' v'.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
b': B
v': Vector (length_Batch b) B
(compose (Batch_make (b ⧆ a)) ∘ vcons (length_Batch b))
  b' v' = (precompose (Batch_make b) ∘ evalAt) b' v'
    unfold compose, precompose, evalAt.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
b': B
v': Vector (length_Batch b) B
Batch_make (b ⧆ a) (vcons (length_Batch b) b' v') =
Batch_make b v' b'
    cbn.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
b': B
v': Vector (length_Batch b) B
Batch_make b
  (Vector_tl (vcons (length_Batch b) b' v'))
  (Vector_hd (vcons (length_Batch b) b' v')) =
Batch_make b v' b'
    rewrite Vector_tl_vcons.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
b': B
v': Vector (length_Batch b) B
Batch_make b v'
  (Vector_hd (vcons (length_Batch b) b' v')) =
Batch_make b v' b'
    rewrite Vector_hd_vcons.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B (B -> C)
a: A
f: A -> G B
IHb: map G (Batch_make b)
  (traverse f (Batch_contents b)) =
forwards (runBatch (mkBackwards ∘ f) b)
b': B
v': Vector (length_Batch b) B
Batch_make b v' b' = Batch_make b v' b'
    reflexivity.
Qed.

Lemma runBatch_repr2 `{Applicative G}:
  forall `(b: Batch A B C) (f: A -> G B),
    runBatch f b =
      map G (Batch_make b)
        (forwards (traverse (G := (Backwards G))
                     (T := Vector (length_Batch b))
                     (mkBackwards ∘ f)
                     (Batch_contents b))).
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
forall (A B C : Type) (b : Batch A B C) (f : A -> G B),
runBatch f b =
map G (Batch_make b)
  (forwards
     (traverse (mkBackwards ∘ f) (Batch_contents b)))
Proof.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
forall (A B C : Type) (b : Batch A B C) (f : A -> G B),
runBatch f b =
map G (Batch_make b)
  (forwards
     (traverse (mkBackwards ∘ f) (Batch_contents b)))
  intros.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
runBatch f b =
map G (Batch_make b)
  (forwards
     (traverse (mkBackwards ∘ f) (Batch_contents b)))
  symmetry.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
map G (Batch_make b)
  (forwards
     (traverse (mkBackwards ∘ f) (Batch_contents b))) =
runBatch f b
  change_left
    (forwards
       (map (Backwards G) (Batch_make b)
          (traverse (G := Backwards G) (mkBackwards ∘ f) (Batch_contents b)))).
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
forwards
  (map (Backwards G) (Batch_make b)
     (traverse (mkBackwards ∘ f) (Batch_contents b))) =
runBatch f b
  rewrite runBatch_repr1.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
forwards
  (forwards
     (runBatch (mkBackwards ∘ (mkBackwards ∘ f)) b)) =
runBatch f b
  rewrite runBatch_via_traverse.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
forwards
  (forwards
     ((map (Backwards (Backwards G)) extract_Batch
       ∘ traverse (mkBackwards ∘ (mkBackwards ∘ f))) b)) =
runBatch f b
  rewrite runBatch_via_traverse.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
forwards
  (forwards
     ((map (Backwards (Backwards G)) extract_Batch
       ∘ traverse (mkBackwards ∘ (mkBackwards ∘ f))) b)) =
(map G extract_Batch ∘ traverse f) b
  change_left
    (map G extract_Batch
       (forwards (
            forwards (
                traverse (G := Backwards (Backwards G))
                  (mkBackwards ∘ (mkBackwards ∘ f)) b)))).
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
map G extract_Batch
  (forwards
     (forwards
        (traverse (mkBackwards ∘ (mkBackwards ∘ f)) b))) =
(map G extract_Batch ∘ traverse f) b
  rewrite traverse_double_backwards.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B, C: Type
b: Batch A B C
f: A -> G B
map G extract_Batch (traverse f b) =
(map G extract_Batch ∘ traverse f) b
  reflexivity.
Qed.


(** * Annotating <<Batch>> with Proofs of Occurrence *)
(******************************************************************************)
Require Import ContainerFunctor.

Import ContainerFunctor.Notations.
Import Applicative.Notations.
Import Functors.Early.Subset.
Import Subset.Notations.

Section annotate_Batch_elements.

  (** ** Lemmas regarding <<tosubset>> *)
  (******************************************************************************)
  Definition tosubset_Step1 {A B C:Type}:
    forall (a': A) (rest: Batch A B (B -> C)),
      forall (a: A),
        tosubset (F := BATCH1 B (B -> C)) rest a ->
        tosubset (F := BATCH1 B C) (Step rest a') a.
A, B, C: Type
forall (a' : A) (rest : Batch A B (B -> C)) (a : A),
tosubset rest a -> tosubset (rest ⧆ a') a
  Proof.
A, B, C: Type
forall (a' : A) (rest : Batch A B (B -> C)) (a : A),
tosubset rest a -> tosubset (rest ⧆ a') a
    introv.
A, B, C: Type
a': A
rest: Batch A B (B -> C)
a: A
tosubset rest a -> tosubset (rest ⧆ a') a
    rewrite tosubset_Batch_rw2.
A, B, C: Type
a': A
rest: Batch A B (B -> C)
a: A
tosubset rest a -> (tosubset rest ∪ {{a'}}) a
    simpl_subset.
A, B, C: Type
a': A
rest: Batch A B (B -> C)
a: A
tosubset rest a -> tosubset rest a \/ a' = a
    tauto.
  Defined.

  Definition tosubset_Step2 {A B C:Type}:
    forall (rest: Batch A B (B -> C)) (a: A),
      tosubset (F := BATCH1 B C) (Step rest a) a.
A, B, C: Type
forall (rest : Batch A B (B -> C)) (a : A),
tosubset (rest ⧆ a) a
  Proof.
A, B, C: Type
forall (rest : Batch A B (B -> C)) (a : A),
tosubset (rest ⧆ a) a
    intros.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
tosubset (rest ⧆ a) a
    rewrite tosubset_Batch_rw2.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
(tosubset rest ∪ {{a}}) a
    simpl_subset.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
tosubset rest a \/ a = a
    tauto.
  Qed.

  Definition element_of_Step1 {A B C:Type}:
    forall (a': A) (rest: Batch A B (B -> C)),
    forall (a: A),
      a ∈ rest ->
      a ∈ (Step rest a').
A, B, C: Type
forall (a' : A) (rest : Batch A B (B -> C)) (a : A),
a ∈ rest -> a ∈ (rest ⧆ a')
  Proof.
A, B, C: Type
forall (a' : A) (rest : Batch A B (B -> C)) (a : A),
a ∈ rest -> a ∈ (rest ⧆ a')
    introv.
A, B, C: Type
a': A
rest: Batch A B (B -> C)
a: A
a ∈ rest -> a ∈ (rest ⧆ a')
    rewrite element_of_Batch_rw2.
A, B, C: Type
a': A
rest: Batch A B (B -> C)
a: A
a ∈ rest -> a ∈ rest \/ a = a'
    tauto.
  Defined.

  Definition element_of_Step2 {A B C:Type}:
    forall (rest: Batch A B (B -> C)) (a: A),
      a ∈ (Step rest a).
A, B, C: Type
forall (rest : Batch A B (B -> C)) (a : A),
a ∈ (rest ⧆ a)
  Proof.
A, B, C: Type
forall (rest : Batch A B (B -> C)) (a : A),
a ∈ (rest ⧆ a)
    intros.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
a ∈ (rest ⧆ a)
    rewrite element_of_Batch_rw2.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
a ∈ rest \/ a = a
    tauto.
  Qed.

  (** ** Annotation Operation *)
  (******************************************************************************)
  Definition sigMap {A: Type} (P Q: A -> Prop) (Himpl: forall a, P a -> Q a):
    sig P -> sig Q :=
    fun σ => match σ with
          | exist _ a h => exist Q a (Himpl a h)
          end.

  Lemma annotate_occurrence_helper {A B C: Type}:
    forall (a: A) (b_orig: Batch A B (B -> C))
      (b_recc: Batch {a'| element_of (F := BATCH1 B (B -> C))
                           a' b_orig} B (B -> C)),
      Batch {a'| element_of (F := BATCH1 B C) a' (b_orig ⧆ a)} B (B -> C).
A, B, C: Type
forall (a : A) (b_orig : Batch A B (B -> C)),
Batch {a' : A | a' ∈ b_orig} B (B -> C) ->
Batch {a' : A | a' ∈ (b_orig ⧆ a)} B (B -> C)
  Proof.
A, B, C: Type
forall (a : A) (b_orig : Batch A B (B -> C)),
Batch {a' : A | a' ∈ b_orig} B (B -> C) ->
Batch {a' : A | a' ∈ (b_orig ⧆ a)} B (B -> C)
    intros a b_orig b_recc.
A, B, C: Type
a: A
b_orig: Batch A B (B -> C)
b_recc: Batch {a' : A | a' ∈ b_orig} B (B -> C)
Batch {a' : A | a' ∈ (b_orig ⧆ a)} B (B -> C)
    apply (map (BATCH1 B (B -> C))
             (sigMap (fun a0 : A => a0 ∈ b_orig)
                (fun a0 : A => a0 ∈ (b_orig ⧆ a))
                (element_of_Step1 a b_orig)) b_recc).
  Defined.

  Fixpoint annotate_occurrence
   {A B C: Type}
   (b: Batch A B C):
    Batch {a| element_of (F := BATCH1 B C) a b} B C :=
    match b with
    | Done c => Done c
    | Step rest a =>
        Step (annotate_occurrence_helper a rest (annotate_occurrence rest))
          (exist (tosubset (rest ⧆ a))
          a (element_of_Step2 rest a))
    end.

  (** * <<runBatch>> Assuming Proofs of Occurrence *)
  (******************************************************************************)
  Definition runBatch_with_occurrence
    {A B C} (G: Type -> Type)
    `{Applicative G}:
    forall (b: Batch A B C)
      `(f: {a | element_of (F := BATCH1 B C) a b} -> G B), G C :=
    fun b f => runBatch f (annotate_occurrence b).

End annotate_Batch_elements.