Definition Pred : Cobham :=
Rec Zero (Proj 2 0) (Proj 2 0) (Proj 1 0).
(* Eval vm_compute in (arity pred'). *)
Definition move_arg (n i j:nat) (e:Cobham) : Cobham :=
Comp n e (move_forward i j
(map (Proj n) (seq 0 n)) (Proj n 0)).
Definition dummies (n m : nat)(e : Cobham) : Cobham :=
Comp (n+m) e (map (Proj (n+m)) (seq 0 n)).
(* n s : arities of e*)
Fixpoint BC_to_Cobham n s (e : BC) : Cobham :=
match e with
| zero => Zero
| proj n s i => Proj (n + s) i
| succ b => Succ b
| pred => Pred
| cond => Cond
| rec g h0 h1 =>
Rec (BC_to_Cobham (n - 1) s g)
(move_arg (S (n+s)) 1 (n-1) (BC_to_Cobham n (S s) h0) )
(move_arg (S (n+s)) 1 (n-1) (BC_to_Cobham n (S s) h1) )
(Poly (pplus (psum n s) (poly_BC n e)))
| comp n s h rl tl =>
Comp (n + s) (BC_to_Cobham (length rl) (length tl) h)
(map (fun e => (dummies n s (BC_to_Cobham n 0 e))) rl ++
map (BC_to_Cobham n s) tl)
end.
Opaque Poly.

Lemma BC_to_Cobham_correct : forall (e : BC) n s,
arities e = ok_arities n s ->
(forall xl yl,
n = length xl ->
s = length yl ->
sem e xl yl = Sem (BC_to_Cobham n s e) (xl ++ yl)).