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.
(** * Logical or  - arities: (1,1) *)
Notation or_e := plus_e (only parsing).
(** * Multiplication  - arities: (2,0) *)
Definition mult_e : BC :=
rec (zero_e 1 0)
(comp 2 1 plus_e ((proj 2 0 1) :: nil) ((proj 2 1 2) :: nil))
(comp 2 1 plus_e ((proj 2 0 1) :: nil) ((proj 2 1 2) :: nil)).
Opaque mult_e.
(** Logical and  - arities: (2,0) *)
Notation and_e := mult_e (only parsing).
(** * Minus (with reversed arguments)  - arities: (1,1) *)
Definition minus_rev_e : BC :=
rec (proj 0 1 0)
(comp 1 2 pred nil ((proj 1 2 1) :: nil))
(comp 1 2 pred nil ((proj 1 2 1) :: nil)).
Opaque minus_rev_e.
(** * Less than predicate  - arities: (1,1) *)
Notation lt_e := minus_rev_e.
(** * Less than or equal to predicate  - arities: (1,1) *)
Definition le_e : BC :=
comp 1 1 lt_e (proj 1 0 0 :: nil) (comp 1 1 succ_e nil (proj 1 1 1 :: nil) :: nil).
Opaque le_e.
(** * Minus  - arities: (2,0) *)
Notation minus_e := (inv_e (from_11_to_20 minus_rev_e)) (only parsing).
(** * Maximum  - arities: (2,0) *)
Definition max_e : BC :=
comp 2 0 (rec (proj 2 0 0) (proj 3 1 2) (proj 3 1 2) )
[ P'_e; proj 2 0 0; proj 2 0 1] nil.
(** * Euclidean division  - arities: (2,0) *)
Fixpoint div' (q y:nat)(x:nat) : nat :=
match q with
| 0 => 0
| S q' => if leb (q' * y) x then q' else div' q' y x
end.
Definition div (x y:nat) : nat := div' (S x) y x.
Definition div'_e : BC :=
rec (zero_e 1 1)
(comp 2 2 cond nil
[comp 2 2 le_e [comp 2 0 mult_e [proj 2 0 0; proj 2 0 1] nil]
[proj 2 2 3]; proj 2 2 2; proj 2 2 0; proj 2 2 2])
(comp 2 2 cond nil
[comp 2 2 le_e [comp 2 0 mult_e [proj 2 0 0; proj 2 0 1] nil]
[proj 2 2 3]; proj 2 2 2; proj 2 2 0; proj 2 2 2]).
Ltac elim_if :=  match goal with
| |- context [if ?c then ?c1 else ?c2]  => case_eq c
end.
Opaque div'_e.
Definition div_e : BC :=
comp 2 0 div'_e [comp 2 0 succ_e nil [proj 2 0 0]; proj 2 0 1] [proj 2 0 0].
(** * Multiplication by a constant  - with any arities: (n,0) *)
Fixpoint scalar_e (a:nat)(n:nat)(e:BC) : BC :=
match a with
| 0 => zero_e n 0
| S a' => comp n 0 plus_e [e] [scalar_e a' n e]
end.
Opaque plus_e.
(** * Multiplication of a list of expressions  - with any arities: (n,0) *)
Fixpoint multl_e (n:nat)(el:list BC) : BC :=
match el with
| nil => one_e n 0
| e' :: el' => comp n 0 mult_e [e'; multl_e n el'] nil
end.
Opaque mult_e.

Lemma multl_correct :
forall n nl el,
length (sem (multl_e n el) nl nil) = multl (map (fun e => length (sem e nl nil)) el).