(*************************************************************)
(** * An abstract machine for cbn evaluation                 *)
(*************************************************************)
(** The advantage of named terms is an efficient operational semantics! Compared to LN or de Bruijn representation, we don't need always need to modify terms (such as via open or shifting) as we traverse binders. Instead, as long as the binder is "sufficiently fresh" we can use the name as is, and only rename (via swapping) when absolutely necessary. *)
(** Below, we define an operational semantics based on an abstract machine. As before, it will model execution as a sequence of small-step transitions. However, transition will be between _machine configurations_, not just expressions.  Our abstract machine configurations have three components:  - the current expression being evaluated the heap (aka - environment): a mapping between variables and expressions - the stack: the evaluation context of the current - expression  Because we have a heap, we don't need to use substitution to define our semantics! To implement [x ~> e] we add a definition that [x] maps to [e] in the heap and then look up the definition when we get to [x] during evaluation.  *)
Definition heap := list (atom * n_exp).
Inductive frame : Set := | n_app2 : n_exp -> frame.
Notation  stack := (list frame).
Definition configuration := (heap * n_exp * stack)%type.
(** The (small-step) semantics is a _function_ from configurations to configurations, until completion or error. *)
Inductive Step a := Error    : Step a
| Done     : Step a
| TakeStep : a -> Step a.
Definition isVal (t : n_exp) :=
match t with
| n_abs _ _ => true
| _         => false
end.
Definition machine_step (avoid : atoms) (c : configuration) : Step configuration :=
match c with
(h, t, s) =>
if isVal t then
match s with
| nil => Done _
| n_app2 t2 :: s' =>
match t with
| n_abs x t1 =>
(* if the bound name [x] is not fresh, we need to rename it *)
if AtomSetProperties.In_dec x (dom h `union` avoid)  then
let (y,_) := atom_fresh (dom h `union` avoid) in
TakeStep _ ((y,t2)::h, swap x y t1, s')
else
TakeStep _ ((x,t2)::h, t1, s')
| _ => Error _ (* non-function applied to argument *)
end
end
else match t with
| n_var x => match get x h with
| Some t1  => TakeStep _ (h, t1, s)
| None    => Error _ (* Unbound variable *)
end
| n_app t1 t2 => TakeStep _ (h, t1, n_app2 t2 :: s)
| _ => Error _ (* unreachable (value in nonValueStep) *)
end
end.
Definition initconf (t : n_exp) : configuration := (nil,t,nil).
(** Example: evaluation of  "(\y. (\x. x) y) Z"  << machine                                       corresponding term  {}, (\y. (\x. x) y) Z , nil                  (\y. (\x. x) y) Z ==> {}, (\y. (\x. x) y), n_app2 Z :: nil         (\y. (\x. x) y) Z ==> {y -> Z}, (\x.x) y, nil                      (\x. x) Z ==> {y -> Z}, (\x.x), n_app2 y :: nil            (\x. x) Z ==> {x -> y, y -> Z}, x, nil                     Z ==> {x -> y, y -> Z}, y, nil                     Z ==> {x -> y, y -> Z}, Z, nil                     Z ==> Done >>  (Note that the machine takes extra steps compared to the substitution semantics.)  We will prove that this machine implements the substitution semantics in the next section.  *)
(** ** Recommended Exercise [values_are_done]  Show that values don't step using this abstract machine. (This is a simple proof.) *)

Lemma values_are_done : forall D t,
isVal t = true -> machine_step D (initconf t) = Done _.