Section Traversable.
Variable t : Type -> Type.
Variable traverse : KleeneCoalg (fun x => x) t.
Definition size a (x:t a) : nat := dim (traverse a a x).
Definition iso1 a (x: t a) : {x : t unit & Vector.t a (size x)} :=
let s := coalg traverse unit x in
existT (fun x : t unit => Vector.t a (size x)) (peek (k:=s) (Vector.const tt _))
(eq_rect _ (Vector.t a) (pos s) _ (eq_sym (dim_preservation _ _ _))).
Definition iso2 a (y : {x : t unit & Vector.t a (size x)}) : t a :=
let (t,s) := y in
peek (k:=coalg traverse a t) (eq_rect _ (Vector.t a) s _ (eq_sym (free_b_dim _ _ _ _))).
End Traversable.
(******************************************************************************)
Record Applicative := applicative
{ carrier :> Type -> Type
; pure : forall a, a -> carrier a
; ap : forall a b, carrier (a -> b) -> carrier a -> carrier b
; map := fun a b (f : a -> b) x => ap (pure f) x
; _ : forall (a : Type) x, map (fun (y : a) => y) x = x
; _ : forall a b c x y z,
ap (ap (map (fun (f : b -> c) (g : a -> b) (w:a) => f (g w)) x) y) z =
ap x (ap y z)
; _ : forall a b (f : a -> b) x, map f (pure x) = pure (f x)
; _ : forall a b (f : carrier (a -> b)) x,
ap f (pure x) = map (fun g => g x) f
}.
Fixpoint sequenceVector n a (F:Applicative) (v: Vector.t (F a) n) : F (Vector.t a n) :=
match v in Vector.t _ n return F (Vector.t a n) with
| Vector.nil => pure _ (Vector.nil _)
| Vector.cons h m t =>
ap (map (fun x => Vector.cons _ x m) h) (sequenceVector t)
end.
Definition traverseVector n a b (F:Applicative) (f : a -> F b) (v : Vector.t a n) : F (Vector.t b n) :=
sequenceVector (Vector.map f v).
Definition IdApplicative : Applicative.
exists (fun A => A) (fun a (x : a) => x) (fun a b (f : a -> b) => f);
try reflexivity.
Defined.
Definition NatPlusApplicative : Applicative.
exists (fun _ => nat) (fun _ _ => 0) (fun a b => plus).
reflexivity.
intros _ _ _ x y z.
apply plus_assoc_reverse.
reflexivity.
intros _ _ x _.
apply plus_0_r.
Defined.
Definition ConstListApplicative (a : Type) : Applicative.
exists (fun _ => list a) (fun _ _ => nil) (fun _ _ => (@app a)).
reflexivity.
intros _ _ _ x y z.
apply app_assoc_reverse.
reflexivity.
intros _ _ x _.
apply app_nil_r.
Defined.
Definition KSpure i j a (x : a) : KleeneStore i j a :=
kleeneStore (fun v => x) (Vector.nil _).
Definition append_view A n p (P : Vector.t A (n + p) -> Type) :
(forall v1 v2, P (Vector.append v1 v2)) ->
forall v, P v.
induction n.
intros f v.
apply (f (Vector.nil _)).
intros f v.
replace v with (Vector.cons _ (Vector.hd v) (n + p) (Vector.tl v)).
destruct (Vector.tl v) as [v1 v2] using IHn.
apply (f (Vector.cons _ (Vector.hd v) _ v1)).
assert (forall m (v : Vector.t A (S m)), Vector.cons A (Vector.hd v) m (Vector.tl v) = v).
clear -A.
apply Vector.caseS.
reflexivity.
apply H.
Defined.
Definition KSap i j a b (g : KleeneStore i j (a -> b)) (k : KleeneStore i j a) :
KleeneStore i j b :=
kleeneStore (fun v => append_view (P := fun _ => b) (fun v1 v2 => (peek (k:=g) v1) (peek (k:=k) v2)) v)
(Vector.append (pos g) (pos k)).

Lemma equivalent_KS i j a (dim1 dim2 : nat) (peek1 : Vector.t j dim1 -> a) (peek2 : Vector.t j dim2 -> a)
(pos1 : Vector.t i dim1) (pos2 : Vector.t i dim2) (e : dim1 = dim2) :
(forall (v1 : Vector.t j dim1) (v2 : Vector.t j dim2), (eq_rect _ _ v1 _ e) = v2 -> peek1 v1 = peek2 v2) ->
eq_rect _ _ pos1 _ e = pos2 -> kleeneStore peek1 pos1 = kleeneStore peek2 pos2.