# Library SimpleCont

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.

Require Import String.

Require Import List.

Require Import Omega.

Require Import Recdef.

Set Implicit Arguments.

Unset Automatic Introduction.

Local Open Scope string_scope.

Definition var := string.

Inductive type :=

Unit_t : type

| Void_t : type

| Arrow_t : type -> type -> type

| Cont_t : type -> type.

Inductive type :=

Unit_t : type

| Void_t : 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

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

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.

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.

We'll now give a denotational semantics for continuations. To start
off, we need an empty type...

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.

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.

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.)

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.

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.

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 =>

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

Notice that the continuation k is ignored here