Inductive BCI : Set :=
| zeroI  : BCI
| projIn : nat -> BCI
| projIs : nat -> BCI
| succI  : bool -> BCI
| predI  : BCI
| condI  : BCI
| recI   : BCI -> BCI -> BCI -> BCI
| compI  : BCI -> list BCI -> list BCI -> BCI.
Inductive TypeI :=
| I : nat -> nat -> TypeI
| E : ErrorI -> TypeI
with ErrorI  :=
| Enat : nat -> ErrorI
| Epair : TypeI -> TypeI -> ErrorI.
Definition eq_t (e1 e2 : TypeI) : bool :=
match e1, e2 with
| I n1 s1, I n2 s2 => beq_nat n1 n2 && beq_nat s1 s2
| _, _ => false
end.
Definition unionI (e1 e2 : TypeI) :=
match e1, e2 with
| I n1 s1, I n2 s2 => I (max n1 n2) (max s1 s2)
| _, _ => E (Enat 3)
end.
Fixpoint inf_list (l : list TypeI) : TypeI :=
match l with
| nil => I 0 0
| e :: l' => unionI e (inf_list l')
end.
Fixpoint inf (e : BCI) : TypeI :=
match e with
| zeroI => I 0 0
| projIn i => I (S i) 0
| projIs i => I 0 (S i)
| succI b => I 0 1
| predI => I 0 1
| condI => I 0 4
| recI g h0 h1 =>
match inf g, inf h0, inf h1 with
| I gn gs, I h0n h0s, I h1n h1s =>
I (maxl [S gn; h0n; h1n]) (maxl [gs; h0s-1; h1s-1])
| _, _, _ => E (Enat 1)
end
| compI h nl sl =>
match inf h with
| I hn hs =>
if leb hn (length nl) && leb hs (length sl)
then
match inf_list (map inf nl),
inf_list (map inf sl) with
| I nnl snl, I nsl ssl =>
if beq_nat snl 0 then
I (max nnl nsl) ssl
else E (Enat 4)
| _, _ => E (Enat 5)
end
else E (Enat 6)
| E e => E e
end
end.
Fixpoint semI (e:BCI) (vnl vsl:list bs) : bs :=
match e with
| zeroI => nil
| projIn i => nth i vnl nil
| projIs i => nth i vsl nil
| succI b => b :: hd nil vsl
| predI => tail (hd nil vsl)
| condI =>
match vsl with
| a :: b :: c :: d :: _ =>
match a with
| nil => b
| true :: _ => c
| false :: _ => d
end
| a :: b :: c :: _ =>
match a with
| nil => b
| true :: _ => c
| false :: _ => nil
end
| a :: b :: _ =>
match a with
| nil => b
| _ => nil
end
| _ => nil
end
| recI g h0 h1 =>
sem_rec (semI g) (semI h0) (semI h1)
(hd nil vnl) (tail vnl) vsl
| compI h nl sl =>
semI h (map (fun ne => semI ne vnl nil) nl)
(map (fun se => semI se vnl vsl) sl)
end.
Definition invI (e : BCI) : BCI :=
compI e [projIn 1; projIn 0] nil.
Definition from_11_to_20I e :=
compI e [projIn 0] [projIn 1].
Definition appI : BCI :=
recI (projIs 0)
(compI (succI false) nil [projIs 0])
(compI (succI true)  nil [projIs 0]).
(* Eval vm_compute in inf appI. *)

Lemma appI_correct v1 v2 :
semI appI [v1] [v2] = v1 ++ v2.