(** * 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.