Fixpoint unary_preserv (e : BC) : bool :=
match e with
| zero => true
| proj n s j => true
| succ b => b
| pred => true
| cond => true
| rec g h0 h1 => unary_preserv g  &&
unary_preserv h0 &&
unary_preserv h1
| comp _ _ h nl sl => unary_preserv h &&
forallb unary_preserv nl &&
forallb unary_preserv sl
end.
(** * Zero  - with any arities (n, s) *)
(** * One  - with any arities (n, s) *)
Definition one_e (n s:nat) : BC :=
comp n s (comp 0 0 (succ true) nil (zero :: nil)) nil nil.
(** * Successor  - arities: (1, 0) *)
Definition succ_e : BC := succ true.
(** * Conversion from [nat] to [BC]  - with any arities (n, s) *)
Fixpoint nat2BC (n s x:nat) : BC :=
match x with
| 0 => zero_e n s
| S x' => comp n s succ_e nil [nat2BC n s x']
end.
Opaque succ_e.
(** * Addition  - arities: (1,1) *)
Definition plus_e : BC :=
rec (proj 0 1 0)
(comp 1 2 succ_e nil ((proj 1 2 1) :: nil))
(comp 1 2 succ_e nil ((proj 1 2 1) :: nil)).
Opaque plus_e.
Fixpoint plusl_e (n:nat)(el:list BC) : BC :=
match el with
| nil => zero_e n 0
| e' :: el' => comp n 0 plus_e [e'] [plusl_e n el']
end.

Lemma plusl_correct :
forall n nl el,
length (sem (plusl_e n el) nl nil) = plusl (map (fun e => length (sem e nl nil)) el).