(** * Adding Continuations to the language. *)
Require Import Eqdep.
Require Import String.
Require Import List.
Require Import Omega.
Require Import Recdef. 
Set Implicit Arguments.
Unset Automatic Introduction.
Local Open Scope string_scope.

(** ** Abstract Syntax *)
Definition var := string.

Inductive type := 
  Unit_t : type
| Void_t : type (* the empty type *)
| Arrow_t : type -> type -> type
| Cont_t : type -> type. 

(** You can think of a [Cont_t t] "stack" that we can return a [t]
    value to, and it will go off and compute the rest of the program.
*)

Definition env(A:Type) := list (var * A).
Fixpoint lookup A (env:env A) (x:var) : option A := 
  match env with 
    | nil => None
    | (y,v)::env' => if string_dec x y then Some v else lookup env' x
  end.

(** We're going to integrate the typing into the expression formation
    so that we can build a denotational semantics in Coq. *)
Inductive exp : env type -> type -> Type := 
| Var_e : forall G t x, lookup G x = Some t -> exp G t
| Lam_e : forall G t1 t2 x (e:exp ((x,t1)::G) t2), exp G (Arrow_t t1 t2)
| App_e : forall G t1 t2, exp G (Arrow_t t1 t2) -> exp G t1 -> exp G t2
| Unit_e : forall G, exp G Unit_t
(** Notice that the [Cast_e] rule lets us produce an expression of arbitrary
   type.  That's because we can't possibly get a value of type [Void_t]. *)
| Cast_e : forall G t, exp G Void_t -> exp G t
(** [Callcc_e (fun k => e)] works as follows:  We capture the current 
    continuation (i.e., stack) which is expecting us to return a [t]
    to it.  We then bind the stack to the variable [k] as a [Cont_t t]
    value, and continue to produce the value specified by [e].  One way
    to think of [callcc] is that it captures a point in time in the
    computation, and gives that point a name ([k]) so that we can jump
    back to that point in time in the future. *)
| Callcc_e : forall G t, exp G (Arrow_t (Cont_t t) t) -> exp G t
(** [Throw_e k v] invokes the continuation [k] by "returning" the value
    [v] to it.  It throws away the current context (i.e., stack).  So
    for instance, if we have:  [1 + throw k 3] then the context is
    [1 + _] which gets ignored.  *)
| Throw_e : forall G t, exp G (Cont_t t) -> exp G t -> exp G Void_t.

(** We'll now give a denotational semantics for continuations.  To start
    off, we need an empty type... *)
Inductive void : Type := .

Section ANSWER.
  (** We also need to specify the type of answers for a program -- this
      is because a continuation is going to capture the entire context
      up to the end of the program, so we know the continuation will return
      a valueof [ans] type. *)
  Variable ans : Type.

  (** The [V] definition gives a value interpretation of types as Coq types.
      As expected, [Unit_t] and [Void_t] map to [unit] and [void] respectively.
      A [Cont_t t] becomes a function from [t] values to [ans], where [ans]
      is the answer type of the whole program.  Finally, a function type
      [Arrow_t t1 t2] is interpreted as a function from [t1] to a function
      which when given a [cont t2] (i.e., [V[t2] -> ans]) returns an [ans].
      So unwinding the definitions:
      [V (Arrow_t t1 t2) = V t1 -> (V t2 -> ans) -> ans]
      Notice that I've packaged up the translation into a monad of sorts.
      It's just that for this monad [M A = cont A -> ans = (A -> ans) -> ans]
      and the [return] and [bind] for this monad are as below. 
  *)
  Definition cont(A:Type) := A -> ans.
  Definition M (A:Type) := cont A -> ans.
  Definition Ret(A:Type)(v:A) : M A := fun k => k v.
  Definition Bind(A B:Type)(c:M A)(f:A -> M B) : M B := 
    fun k => c (fun v => f v k).
  Notation "'ret' x" := (Ret x) (at level 75).
  Notation "x <- c ; f" := (Bind c (fun x => f)) 
    (right associativity, at level 84, c at next level).

  Fixpoint V(t:type) : Type := 
    match t with 
      | Unit_t => unit
      | Arrow_t t1 t2 => (V t1) -> M (V t2)
      | Void_t => void
      | Cont_t t => cont (V t) 
    end%type.

  (** [C t] is our computational interpretation of types.  That is, it's
     what we use for expressions of type [t] (as opposed to values which
     are defined above with [V t].) *)
  Definition C (t:type) := M (V t).

  (** Lift the value translation to environments.  Notice that this is 
     a call-by-value interpretation.  We'd use [C] if it was a call-by-name. *)
  Fixpoint VG(G:env type) : Type := 
    match G with 
      | nil => unit
      | (x,t)::G' => (V t) * (VG G')
    end%type.

  (** Look up the value associated with a variable in the dynamic environment. *)
  Definition lookup_var G (dynenv : VG G) (x:var) (t:type) : (lookup G x = Some t) -> V t.
    induction G ; simpl. intros. discriminate H. 
    intros. destruct a. destruct dynenv. 
    destruct (string_dec x v). injection H. intro. 
    rewrite H0 in v0. apply v0. apply (IHG v1 _ _ H).
  Defined.

  (** The denotational semantis of expressions.  Given an expression [e] such that
      [G |- e : t], and an environment in the value interpretation of [G], we return
      a [C t] computation.  That is, we return a function of type [(V t -> ans) -> ans].
  *)
  Fixpoint eval G t (e:exp G t) : VG G -> C t := 
    match e in exp G' t' return VG G' -> C t' with
      | Var_e G t x H => fun p => ret lookup_var G p x H
      | Lam_e _ _ _ x e => fun p => ret fun v => eval e (v,p)
      | App_e _ _ _ e1 e2 => fun p => 
        v1 <- eval e1 p ; v2 <- eval e2 p ; v1 v2
      | Unit_e _ => fun p => ret tt
      | Cast_e _ _ e => fun p => 
        v <- eval e p ; match v with end
      | Callcc_e _ _ e => fun p => 
        (** Notice that the continuation [k] is duplicated here *)
        fun k => eval e p (fun f => f k k)
      | Throw_e _ _ e1 e2 => fun p => 
        (** Notice that the continuation [k] is ignored here *)
        fun k => 
          eval e1 p
          (fun v1 => eval e2 p 
            (fun v2 => v1 v2))
    end.

End ANSWER.