Fixpoint evalList (m : nat) (l : Vector.t nat m) {struct l} :
naryFunc m -> nat :=
match l in (Vector.t _ m) return (naryFunc m -> nat) with
| Vector.nil => fun x : naryFunc 0 => x
| Vector.cons a n l' => fun x : naryFunc (S n) => evalList n l' (x a)
end.
Fixpoint evalOneParamList (n m a : nat) (l : Vector.t (naryFunc (S n)) m)
{struct l} : Vector.t (naryFunc n) m :=
match l in (Vector.t _ m) return (Vector.t (naryFunc n) m) with
| Vector.nil  => Vector.nil  (naryFunc n)
| Vector.cons f m' l' => Vector.cons _ (f a) m' (evalOneParamList n m' a l')
end.
Fixpoint evalComposeFunc (n : nat) :
forall m : nat, Vector.t (naryFunc n) m -> naryFunc m -> naryFunc n :=
match
n
return
(forall m : nat, Vector.t (naryFunc n) m -> naryFunc m -> naryFunc n)
with
| O => evalList
| S n' =>
fun (m : nat) (l : Vector.t (naryFunc (S n')) m)
(f : naryFunc m) (a : nat) =>
evalComposeFunc n' m (evalOneParamList _ _ a l) f
end.
Fixpoint compose2 (n : nat) : naryFunc n -> naryFunc (S n) -> naryFunc n :=
match n return (naryFunc n -> naryFunc (S n) -> naryFunc n) with
| O => fun (a : nat) (g : nat -> nat) => g a
| S n' =>
fun (f : naryFunc (S n')) (g : naryFunc (S (S n'))) (a : nat) =>
compose2 n' (f a) (fun x : nat => g x a)
end.
Fixpoint evalPrimRecFunc (n : nat) (g : naryFunc n)
(h : naryFunc (S (S n))) (a : nat) {struct a} : naryFunc n :=
match a with
| O => g
| S a' => compose2 _ (evalPrimRecFunc n g h a') (h a')
end.
Fixpoint evalPrimRec (n : nat) (f : PrimRec n) {struct f} :
naryFunc n :=
match f in (PrimRec n) return (naryFunc n) with
| succFunc => S
| zeroFunc => 0
| projFunc n m pf => evalProjFunc n m pf
| composeFunc n m l f =>
evalComposeFunc n m (evalPrimRecs _ _ l) (evalPrimRec _ f)
| primRecFunc n g h =>
evalPrimRecFunc n (evalPrimRec _ g) (evalPrimRec _ h)
end
with evalPrimRecs (n m : nat) (fs : PrimRecs n m) {struct fs} :
Vector.t (naryFunc n) m :=
match fs in (PrimRecs n m) return (Vector.t (naryFunc n) m) with
| PRnil a => Vector.nil  (naryFunc a)
| PRcons a b g gs => Vector.cons _ (evalPrimRec _ g) _ (evalPrimRecs _ _ gs)
end.
Definition extEqualVectorGeneral (n m : nat) (l : Vector.t (naryFunc n) m) :
forall (m' : nat) (l' : Vector.t (naryFunc n) m'), Prop.
induction l as [| a n0 l Hrecl].
intros.
destruct l' as [| a n0 v].
exact True.
exact False.
intros.
destruct l' as [| a0 n1 v].
exact False.
exact (extEqual n a a0 /\ Hrecl _ v).
Defined.
Definition extEqualVector n: forall m (l l' : Vector.t (naryFunc n) m), Prop.
refine (@Vector.rect2 _ _ _ _ _); intros.
apply True.
apply (extEqual n a b /\ X).
Defined.

(* Specifications: *)
Lemma extEqualVectorRefl :
forall (n m : nat) (l : Vector.t (naryFunc n) m), extEqualVector n m l l.
Lemma extEqualOneParamList :
forall (n m : nat) (l1 l2 : Vector.t (naryFunc (S n)) m) (c : nat),
extEqualVector (S n) m l1 l2 ->
extEqualVector n m (evalOneParamList n m c l1) (evalOneParamList n m c l2).
Lemma extEqualCompose :
forall (n m : nat) (l1 l2 : Vector.t (naryFunc n) m) (f1 f2 : naryFunc m),
extEqualVector n m l1 l2 ->
extEqual m f1 f2 ->
extEqual n (evalComposeFunc n m l1 f1) (evalComposeFunc n m l2 f2).
Lemma extEqualCompose2 :
forall (n : nat) (f1 f2 : naryFunc n),
extEqual n f1 f2 ->
forall g1 g2 : naryFunc (S n),
extEqual (S n) g1 g2 -> extEqual n (compose2 n f1 g1) (compose2 n f2 g2).
Lemma extEqualPrimRec :
forall (n : nat) (g1 g2 : naryFunc n) (h1 h2 : naryFunc (S (S n))),
extEqual n g1 g2 ->
extEqual (S (S n)) h1 h2 ->
extEqual (S n) (evalPrimRecFunc n g1 h1) (evalPrimRecFunc n g2 h2).