(** The language of Cobham *)
(** * Syntax and induction principle  - [Cobham_ind2] is a handmade induction principle because the one generated automatically by Coq ignores the type [list BC] in the constructor [Comp]. *)
Inductive Cobham : Type :=
| Zero : Cobham
| Proj : nat -> nat -> Cobham
| Succ : bool -> Cobham
| Smash : Cobham
| Rec  : Cobham -> Cobham -> Cobham -> Cobham -> Cobham
| Comp : nat -> Cobham -> list Cobham -> Cobham.
Definition Rec2 g h j := Rec g h h j.
(** * Arity  - [arity e] returns the arity (i.e., the number variables) of the expression [e] if it is well formed, or an error including the arity of the subterms. *)
Inductive Arity : Set :=
| error_Rec : Arity -> Arity -> Arity -> Arity -> Arity
| error_Comp : Arity -> list Arity -> Arity
| error_Proj : nat -> nat -> Arity
| ok_arity : nat -> Arity.
Definition arity_eq (a1 a2 : Arity) :=
match a1, a2 with
| ok_arity n1, ok_arity n2 => beq_nat n1 n2
| _, _ => false
end.
Fixpoint arity (e : Cobham) : Arity :=
match e with
| Zero => ok_arity 0
| Proj n j => if leb (S j) n
then ok_arity n else error_Proj n j
| Succ _ => ok_arity 1
| Smash => ok_arity 2
| Rec g h0 h1 j =>
match arity g, arity h0, arity h1, arity j with
| ok_arity gn, ok_arity h0n, ok_arity h1n, ok_arity jn =>
if beq_nat (S (S gn)) h0n &&
beq_nat h1n h0n &&
beq_nat (S jn) h1n
then ok_arity jn
else error_Rec (ok_arity gn) (ok_arity h0n)
(ok_arity h1n) (ok_arity jn)
| ag, ah0, ah1, aj => error_Rec ag ah0 ah1 aj
end
| Comp n h l =>
match arity h, map arity l with
| ok_arity nh, al =>
if beq_nat nh (length l) &&
forallb (fun e => arity_eq e (ok_arity n)) al then
ok_arity n else error_Comp (ok_arity nh) al
| e , le => error_Comp e le
end
end.

Lemma Cobham_ind_inf' :
forall (P : nat -> Cobham -> Prop),
forall Q : nat -> list Cobham -> Prop,
(forall n, Q n nil) ->
(forall e n l, P n e -> Q n l -> Q n (e :: l)) ->
P 0 Zero ->
(forall n i, i < n  ->  P n (Proj n i)) ->
(forall b, P 1 (Succ b)) ->
(P 2 Smash) ->
(forall n g h0 h1 j,
arity g = ok_arity n ->
arity h0 = ok_arity (S (S n)) ->
arity h1 = ok_arity (S (S n)) ->
arity j = ok_arity (S n) ->
P n g ->
P (S (S n)) h0 ->
P (S (S n)) h1 ->
P (S n) j ->
P (S n) (Rec g h0 h1 j)) ->
(forall n h rl,
arity h = ok_arity (length rl)  ->
(forall e, In e rl -> arity e = ok_arity n) ->
P (length rl)  h ->
Q n rl ->
P n (Comp n h rl)) ->
forall e n , arity e = ok_arity n -> P n e.