simple induction 1; intros.
inversion_clear H0; auto.
inversion_clear H0; auto.
inversion_clear H0; auto.
inversion_clear H0; auto.
inversion_clear H1; auto. apply (determ_VAL_OF e0 I); auto.
inversion_clear H4. exact (H3 V' H6).
cut (boolean true = boolean false).
intro HH; discriminate HH.
exact (H1 (boolean false) H5).
inversion_clear H4.
cut (boolean false = boolean true).
intro HH; discriminate HH.
exact (H1 (boolean true) H5).
exact (H3 V' H6).
inversion_clear H4.
elim (H1 u0 H5); elim (H3 v0 H6); trivial.
inversion_clear H6.
cut (Clos P E0 e1 = Clos P0 E3 e3).
intro HH; injection HH.
intros.
cut (u = u0).
intro.
apply H5.
try rewrite H6; try rewrite H10; try rewrite H11; try rewrite H12.
exact H9.
exact (H3 u0 H8).
exact (H1 (Clos P0 E3 e3) H7).
cut (Clos P E0 e1 = Clos_rec x E3 P0 e3).
intro HH; discriminate HH.
exact (H1 (Clos_rec x E3 P0 e3) H7).
cut (Clos P E0 e1 = OP_clos c).
intro HH; discriminate HH.
exact (H1 (OP_clos c) H7).
inversion_clear H6.
cut (Clos_rec x E0 P e1 = Clos P0 E3 e3).
intro HH; discriminate HH.
exact (H1 (Clos P0 E3 e3) H7).
cut (Clos_rec x E0 P e1 = Clos_rec x0 E3 P0 e3).
intro HH; injection HH.
cut (u = u0).
intros.
apply H5.
try rewrite H6; try rewrite H10; try rewrite H11; try rewrite H12;
try rewrite H13.
exact H9.
exact (H3 u0 H8).
exact (H1 (Clos_rec x0 E3 P0 e3) H7).
cut (Clos_rec x E0 P e1 = OP_clos c).
intro HH; discriminate HH.
exact (H1 (OP_clos c) H7).
inversion_clear H4.
cut (OP_clos c = Clos P E0 e2).
intro HH; discriminate HH.
exact (H1 (Clos P E0 e2) H5).
cut (OP_clos c = Clos_rec x E0 P e2).
intro HH; discriminate HH.
exact (H1 (Clos_rec x E0 P e2) H5).
cut (valpair (num n) (num m) = valpair (num n0) (num m0)).
intro HH; injection HH.
intros.
cut (OP_clos c = OP_clos c0).
intro HH1; injection HH1.
intro.
try rewrite H4; try rewrite H7; try rewrite H8.
trivial.
exact (H1 (OP_clos c0) H5).
exact (H3 (valpair (num n0) (num m0)) H6).
inversion_clear H4.
cut (u = u0).
intro.
apply H3.
try rewrite H4.
exact H6.
exact (H1 u0 H5).
inversion_clear H2.
apply H1.
exact H3.
Qed.
(*****************************************************************************)
(*We present now the definitions that concerns the Categorical Abstract      *)
(*Machine. The Set Commande defines its syntax                               *)
(*****************************************************************************)
Inductive Value : Set :=
| null : Value
| elem : bool -> Value
| int : nat -> Value
| def_op : OP -> Value.
(*****************************************************************************)
Inductive Commande : Set :=
| quote : Value -> Commande
| car : Commande
| cdr : Commande
| cons : Commande
| push : Commande
| swap : Commande
| branch : Commande -> Commande -> Commande
| cur : Commande -> Commande
| cur_rec : Commande -> Commande
| app : Commande
| o : Commande -> Commande -> Commande.
(*****************************************************************************)
Inductive CSem_val : Set :=
| val : Value -> CSem_val
| Cam_pair : CSem_val -> CSem_val -> CSem_val
| Cam_clos : Commande -> CSem_val -> CSem_val
| Cam_clos_rec : Commande -> CSem_val -> CSem_val
| Cam_nil : CSem_val.
(*****************************************************************************)
Inductive Etat : Set :=
| nil : Etat
| ETcons : CSem_val -> Etat -> Etat.
(*****************************************************************************)
(*               We provide now the Semantics of the CAM                     *)
(*****************************************************************************)
Inductive CAM_DS : Etat -> Commande -> Etat -> Prop :=
| QUO :
forall (s : Etat) (a : CSem_val) (b : Value),
CAM_DS (ETcons a s) (quote b) (ETcons (val b) s)
| CAR :
forall (s : Etat) (a b : CSem_val),
CAM_DS (ETcons (Cam_pair a b) s) car (ETcons a s)
| CDR :
forall (s : Etat) (a b : CSem_val),
CAM_DS (ETcons (Cam_pair a b) s) cdr (ETcons b s)
| CONS :
forall (s : Etat) (a b : CSem_val),
CAM_DS (ETcons b (ETcons a s)) cons (ETcons (Cam_pair a b) s)
| PUSH :
forall (s : Etat) (a : CSem_val),
CAM_DS (ETcons a s) push (ETcons a (ETcons a s))
| SWAP :
forall (s : Etat) (a b : CSem_val),
CAM_DS (ETcons a (ETcons b s)) swap (ETcons b (ETcons a s))
| BRANCHT :
forall (s s1 : Etat) (c1 c2 : Commande),
CAM_DS s c1 s1 -> CAM_DS (ETcons (val (elem true)) s) (branch c1 c2) s1
| BRANCHF :
forall (s s2 : Etat) (c1 c2 : Commande),
CAM_DS s c2 s2 ->
CAM_DS (ETcons (val (elem false)) s) (branch c1 c2) s2
| CUR :
forall (s : Etat) (a : CSem_val) (c : Commande),
CAM_DS (ETcons a s) (cur c) (ETcons (Cam_clos c a) s)
| APPcam1 :
forall (s s1 : Etat) (a b : CSem_val) (c : Commande),
CAM_DS (ETcons (Cam_pair a b) s) c s1 ->
CAM_DS (ETcons (Cam_pair (Cam_clos c a) b) s) app s1
| APPcam2 :
forall (s s1 : Etat) (a b : CSem_val) (c : Commande),
CAM_DS (ETcons (Cam_pair (Cam_pair b (Cam_clos_rec c b)) a) s) c s1 ->
CAM_DS (ETcons (Cam_pair (Cam_clos_rec c b) a) s) app s1
| APPcam_op :
forall (s : Etat) (n m : nat) (oper : OP),
CAM_DS
(ETcons
(Cam_pair (val (def_op oper))
(Cam_pair (val (int n)) (val (int m)))) s) app
(ETcons (val (int (eval_op oper n m))) s)
| CUR_REC :
forall (s : Etat) (a : CSem_val) (c : Commande),
CAM_DS (ETcons a s) (cur_rec c) (ETcons (Cam_clos_rec c a) s)
| o_DS :
forall (s s1 s2 : Etat) (c1 c2 : Commande),
CAM_DS s c1 s1 -> CAM_DS s1 c2 s2 -> CAM_DS s (o c1 c2) s2.
(*****************************************************************************)
(*We now define the "Squelette"of an environment which is the intuitive      *)
(*corresponding list of Debruijn indexes of an environment                   *)
(*****************************************************************************)
Inductive Squelette : Set :=
| nil_squelette : Squelette
| cons_squelette : Pat -> Squelette -> Squelette.
(*****************************************************************************)
Inductive Habite : MLenv -> Squelette -> Prop :=
| triv_habite : Habite Enil nil_squelette
| cons_habite :
forall (x : Pat) (u : MLval) (e : MLenv) (s : Squelette),
Habite e s -> Habite (Econs x u e) (cons_squelette x s).
(*****************************************************************************)
(*                Habite is an injective w.r.t the Squelette argument        *)
(*****************************************************************************)

(* Specifications: *)
Lemma Habite_inject :
forall (e : MLenv) (s1 s2 : Squelette),
Habite e s1 -> Habite e s2 -> s1 = s2.