(*************************************************************************)
(*                                                                       *)
(* Lecture 3                                                             *)
(*                                                                       *)
(*************************************************************************)
(** Next, we import the definitions of the simply-typed lambda calculus. *)
(** And some auxiliary lemmas about these definitions. *)
(* This file draws heavily on the generated lemmas in Stlc.Lemmas. *)
(*************************************************************)
(*   Connection to nominal representation of terms           *)
(*************************************************************)
(* A named representation of STLC terms. No debruijn indices, and binders include the names of free variables. *)
Inductive n_exp : Set :=
| n_var (x:var)
| n_abs (x:var) (e:n_exp)
| n_app (e1:n_exp) (e2:n_exp).
Parameter X : var.
Parameter Y : var.
Parameter neqXY : X <> Y.
Definition example_X : n_exp := n_abs X (n_var X).
Definition example_Y : n_exp := n_abs Y (n_var Y).
(* --- an environment-based interpreter for named terms ------- *)
(* The result of this interpreter is a "closure" --- a lambda expression paired with a substitution for all of the free variables in the term. We call such substitutions "environments".  *)
Inductive nom_env : Set :=
| nom_nil  : nom_env
| nom_cons : atom -> n_exp -> nom_env -> nom_env -> nom_env.
Inductive nom_val : Set :=
| nom_closure : atom -> nom_env -> n_exp -> nom_val.
Fixpoint rho_lookup x rho : option (n_exp * nom_env) :=
match rho with
| nom_nil => None
| nom_cons y e r rho' =>  if (x == y) then Some (e,r) else rho_lookup x rho'
end.
Inductive res (a : Set) : Set :=
| val     : a -> res a
| timeout : res a
| stuck   : res a.
Fixpoint nom_interp (n:nat) (e:n_exp) (rho: nom_env) : res nom_val :=
match n with
| 0 => timeout _
| S m =>
match e with
| n_var x =>  match (rho_lookup x rho) with
| Some (e',r') => nom_interp m e' r'
| None   => stuck _
end
| n_app e1 e2 =>
match nom_interp m e1 rho with
| val _ (nom_closure x rho' e1') =>
nom_interp m e1' (nom_cons x e2 rho rho')
| r       => r
end
| n_abs x e   => val _ (nom_closure x rho e)
end
end.
(* --- translation from nominal terms and values to LN terms --- *)
(* Our goal is to prove the correctness of this interpreter. In otherwords, we want to show that if it produces a value, then we can translate to an evaluation of LN terms.  The property that we ultimately want to prove looks something like this:  << Lemma nom_soundness0 : forall n e v, val _ v = nom_interp n e nom_nil  -> bigstep (nom_to_exp e) (nom_val_to_exp v). >>  where we straightforwardly translate nominal terms to LN terms. (Note that we cannot write the function in the other direction --- there are many equally valid names that we can choose for the bound variable.) *)
Fixpoint nom_to_exp (ne : n_exp) : exp :=
match ne with
| n_var x => var_f x
| n_app e1 e2 => app (nom_to_exp e1) (nom_to_exp e2)
| n_abs x e1 => abs (close_exp_wrt_exp x (nom_to_exp e1))
end.
(* The following function for environments substitutes all of the mappings in the environment in a LN expression, using the LN substitution function. This is good because we don't need to define capture-avoiding substitution for nominal terms. *)
Fixpoint nom_envsubst (ne:nom_env) : exp -> exp :=
match ne with
| nom_nil => fun e => e
| nom_cons x e' r' rho =>
fun e => nom_envsubst rho ([ x ~> nom_envsubst r' (nom_to_exp e')] e)
end.
Fixpoint nom_val_to_exp (cv:nom_val) : exp :=
match cv with
| nom_closure x rho e =>
nom_envsubst rho (nom_to_exp (n_abs x e))
end.
(* ----------------- closed values, environments and terms ------------------- *)
(* To prove the soundness lemma, we will need to strengthen it so that it says something about non-empty environments.   << Lemma nom_soundness1 : forall n rho e v, val _ v = nom_interp n e rho  -> .... -> bigstep (nom_envsubst rho (nom_to_exp e)) (nom_val_to_exp v). >>  However, this lemma will not be true for all environments and nominal terms, we need to make sure that (1) the domain of the environment includes definitions for all of the free variables in e, and (2) the range of the environment includes only *closed* nominal values.  *)
Fixpoint dom_rho (rho :nom_env) :=
match rho with
| nom_nil => {}
| nom_cons x _ _ rho => {{x}} \u dom_rho rho
end.
Inductive closed_env : nom_env -> Prop :=
| closed_nil : closed_env nom_nil
| closed_cons : forall x e r rho,
closed_env r ->
fv_exp (nom_to_exp e) [<=] dom_rho r ->
closed_env rho -> closed_env (nom_cons x e r rho).
Inductive closed_val : nom_val -> Prop :=
| closed_closure : forall x rho e,
closed_env rho ->
fv_exp (nom_to_exp e) [<=] add x (dom_rho rho) ->
closed_val (nom_closure x rho e).
Hint Constructors closed_env closed_val.
(* Our definition of closed_env means that any value that we lookup from this environment will be closed. *)
(* Furthermore, we can also prove that closed values have no free variables after translation.  This proof is done by mutual induction on the closed_val/closed_env derivation. So before we can do that, we need to ask Coq to derive the appropriate induction scheme. *)
(* ----------------- nom_envsubst reductions ------------------- *)
(* We can think of a an environment as a multi-substitution for locally nameless terms.  Therefore, the nom_envsubst function inherits many of the properties of the subst_exp function.  *)
(* ----------------------------------------- *)
(* Lemma fv_closed : (forall v, closed_val v -> fv_exp (nom_val_to_exp v) [=] {}).  Lemma fv_closed : (forall v, closed_val v -> fv_exp (nom_val_to_exp v) [=] {}).  Lemma fv_closed_env : (forall rho, closed_env rho -> forall e, fv_exp e [<=] dom_rho rho -> fv_exp (nom_envsubst rho e) [=] {}). *)
(* Now we can use these results to show that the interpreter produces closed values from appropriate environments and terms. *)
(* ----------------- interpreter soundness for values ------------------- *)
(* The next step is to show that nominal values bigstep to themselves. In otherwords, we want to show that:  << Lemma nom_soundness_val : forall v, bigstep (nom_val_to_exp v) (nom_val_to_exp v). >>  To prove this lemma, we need to show that these nominal values translate LN values, and that these values are locally closed.  *)
Hint Resolve nom_val_to_exp_is_value.
(* Need the mutual induction scheme for the next lemma! *)
Scheme nom_val_ind' := Induction for nom_val Sort Prop
with  nom_env_ind' := Induction for nom_env Sort Prop.
Combined Scheme nom_mutual from nom_val_ind', nom_env_ind'.
eapply nom_val_to_exp_lc_mutual.
Qed.
Hint Resolve nom_to_exp_lc nom_val_to_exp_lc nom_envsubst_lc.
(* ----------------- interpreter soundness ------------------- *)
(* Finally, we get to the actual soundness function for the interpreter. *)

Lemma nom_soundness : forall n rho e v,
val _ v = nom_interp n e rho  ->
closed_env rho ->
fv_exp (nom_to_exp e) [<=] dom_rho rho ->
bigstep (nom_envsubst rho (nom_to_exp e)) (nom_val_to_exp v).