(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(* définition des adresses d'états produits *)
Fixpoint iad_conv_aux_0 (p : positive) : positive :=
match p with
| xH => 2%positive
| xO p' => xO (xO (iad_conv_aux_0 p'))
| xI p' => xO (xI (iad_conv_aux_0 p'))
end.
Fixpoint iad_conv_aux_1 (p : positive) : positive :=
match p with
| xH => 1%positive
| xO p' => xO (xO (iad_conv_aux_1 p'))
| xI p' => xI (xO (iad_conv_aux_1 p'))
end.
Fixpoint iad_conv_aux_2 (p0 p1 : positive) {struct p1} : positive :=
match p0, p1 with
| xH, xH => 3%positive
| xH, xO p1' => xI (xO (iad_conv_aux_0 p1'))
| xH, xI p1' => xI (xI (iad_conv_aux_0 p1'))
| xO p0', xH => xO (xI (iad_conv_aux_1 p0'))
| xO p0', xO p1' => xO (xO (iad_conv_aux_2 p0' p1'))
| xO p0', xI p1' => xO (xI (iad_conv_aux_2 p0' p1'))
| xI p0', xH => xI (xI (iad_conv_aux_1 p0'))
| xI p0', xO p1' => xI (xO (iad_conv_aux_2 p0' p1'))
| xI p0', xI p1' => xI (xI (iad_conv_aux_2 p0' p1'))
end.
Definition iad_conv (a0 a1 : ad) : ad :=
match a0, a1 with
| N0, N0 => N0
| N0, Npos p1 => Npos (iad_conv_aux_0 p1)
| Npos p0, N0 => Npos (iad_conv_aux_1 p0)
| Npos p0, Npos p1 => Npos (iad_conv_aux_2 p0 p1)
end.
(* surjectivité de iad_conv *)
Definition iad_conv_prop (p : positive) : Prop :=
(exists q : positive, p = iad_conv_aux_0 q) \/
(exists q : positive, p = iad_conv_aux_1 q) \/
(exists q : positive, (exists r : positive, p = iad_conv_aux_2 q r)).
intros.
elim H; intros. elim H0. intros. left. split with (xI x).
simpl in |- *. rewrite <- H1. trivial. elim H0; intros. elim H1. intros.
right. right. split with (xO x). split with 1%positive. simpl in |- *. rewrite H2.
trivial. elim H1. intros. elim H2. intros. right. right.
split with (xO x). split with (xI x0). simpl in |- *. rewrite H3.
trivial.
Qed.
(* fonctions réciproques gauche et droite de iad_conv *)
Inductive ad_couple : Set :=
cpla : ad -> ad -> ad_couple.
Fixpoint iad_conv_inv_0 (p : positive) : ad_couple :=
match p with
| xH => cpla (Npos 1) N0
| xO xH => cpla N0 (Npos 1)
| xI xH => cpla (Npos 1) (Npos 1)
| xO (xO p') =>
match iad_conv_inv_0 p' with
| cpla N0 N0 => cpla N0 N0
| cpla N0 (Npos p1) => cpla N0 (Npos (xO p1))
| cpla (Npos p0) N0 => cpla (Npos (xO p0)) N0
| cpla (Npos p0) (Npos p1) => cpla (Npos (xO p0)) (Npos (xO p1))
end
| xO (xI p') =>
match iad_conv_inv_0 p' with
| cpla N0 N0 => cpla N0 (Npos 1)
| cpla N0 (Npos p1) => cpla N0 (Npos (xI p1))
| cpla (Npos p0) N0 => cpla (Npos (xO p0)) (Npos 1)
| cpla (Npos p0) (Npos p1) => cpla (Npos (xO p0)) (Npos (xI p1))
end
| xI (xO p') =>
match iad_conv_inv_0 p' with
| cpla N0 N0 => cpla (Npos 1) N0
| cpla N0 (Npos p1) => cpla (Npos 1) (Npos (xO p1))
| cpla (Npos p0) N0 => cpla (Npos (xI p0)) N0
| cpla (Npos p0) (Npos p1) => cpla (Npos (xI p0)) (Npos (xO p1))
end
| xI (xI p') =>
match iad_conv_inv_0 p' with
| cpla N0 N0 => cpla (Npos 1) (Npos 1)
| cpla N0 (Npos p1) => cpla (Npos 1) (Npos (xI p1))
| cpla (Npos p0) N0 => cpla (Npos (xI p0)) (Npos 1)
| cpla (Npos p0) (Npos p1) => cpla (Npos (xI p0)) (Npos (xI p1))
end
end.
Definition iad_conv_inv (a : ad) : ad_couple :=
match a with
| N0 => cpla N0 N0
| Npos p => iad_conv_inv_0 p
end.

Lemma iad_inv_inv_0 :
forall a0 a1 : ad, iad_conv_inv (iad_conv a0 a1) = cpla a0 a1.