Fixpoint arities (e:BC) : Arities :=
match e with
| zero => ok_arities 0 0
| proj n s i =>
if leb (S i) (n + s) then ok_arities n s
else error_proj n s i
| succ _ => ok_arities 0 1
| pred => ok_arities 0 1
| cond => ok_arities 0 4
| rec g h0 h1 =>
match arities g, arities h0, arities h1
with | ok_arities gn gs, ok_arities h0n h0s, ok_arities h1n h1s =>
if beq_nat (S gn) h0n && beq_nat h0n h1n &&
beq_nat (S gs) h0s && beq_nat h0s h1s
then ok_arities h0n gs
else error_rec (ok_arities gn gs) (ok_arities h0n h0s) (ok_arities h1n h1s)
| e1, e2, e3 => error_rec e1 e2 e3
end
| comp n s h nl sl =>
match arities h, map arities nl, map arities sl with
| ok_arities hn hs, anl, asl =>
if beq_nat hn (length nl) && beq_nat hs (length sl) &&
forallb (fun ne => aeq (arities ne) (ok_arities n 0)) nl &&
forallb (fun se => aeq (arities se) (ok_arities n s)) sl
then ok_arities n s
else error_comp (ok_arities hn hs) anl asl
| e , anl, asl => error_comp e anl asl
end
end.
Definition arities2 e :=
match arities e with
| ok_arities n s => (n, s)
| _ => (0, 0)
end.

Lemma BC_ind_inf' :
forall (P : nat -> nat -> BC -> Prop),
forall Q : nat -> nat -> list BC -> Prop,
(forall n s, Q n s nil) ->
(forall e n s l, P n s e -> Q n s l -> Q n s (e :: l)) ->
P 0 0 zero ->
(forall n s i, i < n + s ->  P n s (proj n s i)) ->
(forall b, P 0 1 (succ b)) ->
P 0 1 pred ->
P 0 4 cond ->
(forall n s g h0 h1,
arities g = ok_arities n s ->
arities h0 = ok_arities (S n) (S s) ->
arities h1 = ok_arities (S n) (S s) ->
P n s g ->
P (S n) (S s) h0 ->
P (S n) (S s) h1 ->
P (S n) s (rec g h0 h1)) ->
(forall n s h rl tl,
arities h = ok_arities (length rl) (length tl) ->
(forall e, In e rl -> arities e = ok_arities n 0) ->
(forall e, In e tl -> arities e = ok_arities n s) ->
P (length rl) (length tl) h ->
Q n 0 rl ->
Q n s tl ->
P n s (comp n s h rl tl)) ->
forall e n s , arities e = ok_arities n s -> P n s e.