(* 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                                                     *)
(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*  Mini_ML.v                                                               *)
(*                                                                          *)
(*  This file contains the definitions of the Mini-ML and the               *)
(*  Categorical Abstract Machine (C.A.M) natural semantics                  *)
(*  It also contains the definition of the translation from                 *)
(*  Mini-ML to the CAM and the proof that this translation is               *)
(*  correct                                                                 *)
(*                                                                          *)
(*                                                                          *)
(*  Samuel Boutin                                                           *)
(*  Coq V5.10                                                               *)
(*  December  1994                                                          *)
(*                                                                          *)
(*                                                                          *)
(****************************************************************************)
(*                                Mini_ML.v                                 *)
(****************************************************************************)
(*****************************************************************************)
(*                CORRECTNESS PROOF OF A MINI_ML COMPILER                    *)
(*                             Samuel Boutin                                 *)
(*                             December 1994                                 *)
(*                              Coql  V5.10                                  *)
(*****************************************************************************)
(*****************************************************************************)
(* First we define a Set "OP" of variable which is a representation of the   *)
(* arithmetic functions *,+,-... that we will not describe explicitely       *)
(* We take the natural numbers to code the variables (but of course it has no*)
(* relation with the De bruijn indexes)                                      *)
(*****************************************************************************)
Parameter OP : Set.
Parameter eval_op : OP -> nat -> nat -> nat.
Definition Pat := nat.
(*****************************************************************************)
(*              Defining the syntax of ML expressions                        *)
(*****************************************************************************)
Inductive MLexp : Set :=
| Bool : bool -> MLexp
| Num : nat -> MLexp
| op : OP -> MLexp
| id : Pat -> MLexp
| appl : MLexp -> MLexp -> MLexp
| mlpair : MLexp -> MLexp -> MLexp
| lambda : Pat -> MLexp -> MLexp
| let' : Pat -> MLexp -> MLexp -> MLexp
| letrec : Pat -> Pat -> MLexp -> MLexp -> MLexp
| ite : MLexp -> MLexp -> MLexp -> MLexp.
(*****************************************************************************)
(*     ML values and environment are defined with the following mutual       *)
(*     recursive definition                                                  *)
(*****************************************************************************)
Inductive MLval : Set :=
| num : nat -> MLval
| boolean : bool -> MLval
| valpair : MLval -> MLval -> MLval
| OP_clos : OP -> MLval
| Clos : Pat -> MLexp -> MLenv -> MLval
| Clos_rec : Pat -> MLexp -> Pat -> MLenv -> MLval
with MLenv : Set :=
| Enil : MLenv
| Econs : Pat -> MLval -> MLenv -> MLenv.
(*****************************************************************************)
(* Definition of VAL_OF which decide if a variable belongs to an environment *)
(*****************************************************************************)
Inductive VAL_OF : MLenv -> Pat -> MLval -> Prop :=
| ELT : forall (e : MLenv) (I : Pat) (a : MLval), VAL_OF (Econs I a e) I a
| CHG :
forall (e : MLenv) (X I : Pat) (a b : MLval),
VAL_OF e I a -> X <> I :>Pat -> VAL_OF (Econs X b e) I a.
(*****************************************************************************)
(*         The following lemma shows us that VAL_OF is deterministic         *)
(*****************************************************************************)
simple induction 1.
intros.
inversion_clear H0; auto.
elim H2; auto.
intros.
apply H1.
inversion H3.
elim H2.
exact H4.
auto.
(* Injection H4. Intros. Try Rewrite <- H5. Elim H9;Auto. Intros;Auto. *)
Qed.
(*****************************************************************************)
(*                   We define now the Mini-ML semantics                     *)
(*In this semantics we want to distinguish the places where application is   *)
(*used in a recursive scheme from the other places.                          *)
(*That's why we have a special rule for application in the case where the    *)
(*function applied has as value a recursive closure (this correspond in fact *)
(*to a test during application                                               *)
(*****************************************************************************)
Inductive ML_DS : MLenv -> MLexp -> MLval -> Prop :=
| BOOL : forall (b : bool) (e : MLenv), ML_DS e (Bool b) (boolean b)
| NUM : forall (n : nat) (e : MLenv), ML_DS e (Num n) (num n)
| Sem_OP : forall (c : OP) (e : MLenv), ML_DS e (op c) (OP_clos c)
| LAMBDA :
forall (e : MLenv) (P : Pat) (E : MLexp),
ML_DS e (lambda P E) (Clos P E e)
| IDENT :
forall (e : MLenv) (v : MLval) (I : Pat),
VAL_OF e I v -> ML_DS e (id I) v
| ITE1 :
forall (e : MLenv) (E1 E2 E3 : MLexp) (v : MLval),
ML_DS e E1 (boolean true) -> ML_DS e E2 v -> ML_DS e (ite E1 E2 E3) v
| ITE2 :
forall (e : MLenv) (E1 E2 E3 : MLexp) (v : MLval),
ML_DS e E1 (boolean false) -> ML_DS e E3 v -> ML_DS e (ite E1 E2 E3) v
| MLPAIR :
forall (e : MLenv) (E1 E2 : MLexp) (u v : MLval),
ML_DS e E1 u -> ML_DS e E2 v -> ML_DS e (mlpair E1 E2) (valpair u v)
| APPml1 :
forall (e e1 : MLenv) (P : Pat) (E E1 E2 : MLexp) (u v : MLval),
ML_DS e E1 (Clos P E e1) ->
ML_DS e E2 u -> ML_DS (Econs P u e1) E v -> ML_DS e (appl E1 E2) v
| APPml2 :
forall (e e1 : MLenv) (x P : Pat) (E E1 E2 : MLexp) (u v : MLval),
ML_DS e E1 (Clos_rec x E P e1) ->
ML_DS e E2 u ->
ML_DS (Econs x u (Econs P (Clos_rec x E P e1) e1)) E v ->
ML_DS e (appl E1 E2) v
| APPml_op :
forall (e : MLenv) (E1 E2 : MLexp) (n m : nat) (c : OP),
ML_DS e E1 (OP_clos c) ->
ML_DS e E2 (valpair (num n) (num m)) ->
ML_DS e (appl E1 E2) (num (eval_op c n m))
| Sem_let :
forall (e : MLenv) (P : Pat) (E1 E2 : MLexp) (u v : MLval),
ML_DS e E2 u -> ML_DS (Econs P u e) E1 v -> ML_DS e (let' P E2 E1) v
| Sem_letrec :
forall (e : MLenv) (P x : Pat) (E E2 : MLexp) (u : MLval),
ML_DS (Econs P (Clos_rec x E P e) e) E2 u ->
ML_DS e (letrec P x E E2) u.
(*****************************************************************************)
(* This predicate can be seen as an injective partial function associating a *)
(*  value to an environment and an expression:                               *)
(*****************************************************************************)

Lemma ML_DS_determ :
forall (e : MLenv) (E : MLexp) (V : MLval),
ML_DS e E V -> forall V' : MLval, ML_DS e E V' -> V = V' :>MLval.