Require Vector.
Require Export Bool.
Require Export EqNat.
Inductive PrimRec : nat -> Set :=
| succFunc : PrimRec 1
| zeroFunc : PrimRec 0
| projFunc : forall n m : nat, m < n -> PrimRec n
| composeFunc :
forall (n m : nat) (g : PrimRecs n m) (h : PrimRec m), PrimRec n
| primRecFunc :
forall (n : nat) (g : PrimRec n) (h : PrimRec (S (S n))), PrimRec (S n)
with PrimRecs : nat -> nat -> Set :=
| PRnil : forall n : nat, PrimRecs n 0
| PRcons : forall n m : nat, PrimRec n -> PrimRecs n m -> PrimRecs n (S m).
Scheme PrimRec_PrimRecs_rec := Induction for PrimRec
Sort Set
with PrimRecs_PrimRec_rec := Induction for PrimRecs
Sort Set.
Scheme PrimRec_PrimRecs_ind := Induction for PrimRec
Sort Prop
with PrimRecs_PrimRec_ind := Induction for PrimRecs
Sort Prop.
Fixpoint evalConstFunc (n m : nat) {struct n} : naryFunc n :=
match n return (naryFunc n) with
| O => m
| S n' => fun _ => evalConstFunc n' m
end.
(* The parameters are number in opposite order. So proj(2,0)(a,b) = b. *)
Fixpoint evalProjFunc (n : nat) : forall m : nat, m < n -> naryFunc n :=
match n return (forall m : nat, m < n -> naryFunc n) with
| O => fun (m : nat) (l : m < 0) => False_rec _ (lt_n_O _ l)
| S n' =>
fun (m : nat) (l : m < S n') =>
match eq_nat_dec m n' with
| left _ => fun a : nat => evalConstFunc _ a
| right l1 =>
fun _ =>
evalProjFunc n' m
match le_lt_or_eq _ _ (lt_n_Sm_le _ _ l) with
| or_introl l2 => l2
| or_intror l2 => False_ind _ (l1 l2)
end
end
end.

(* Specifications: *)
Lemma evalProjFuncInd :
forall (n m : nat) (p1 p2 : m < n),
evalProjFunc n m p1 = evalProjFunc n m p2.