ML; Scope (15 points)

What do the following ML expressions evaluate to:

let val x = 1
in let val x = 2
   in let val y = x
      in x + y 
      end
   end
end
------------------------------ 4
let val x = 1
in let val f = (fn y => x + y)
   in let val x = 2
      in f 4
      end
   end
end
------------------------------ 5
let val x = 1
in let val f = (fn y => let val x = y 
                        in fn g => g (g x)
                        end)
   in f 3 (let val x = x
           in (fn z => x + z)
           end)
   end
end
------------------------------ 5
let val x = ref 1
in let val f = (fn y => !x + y)
   in f ((fn _ => !x) (x := 6))
   end
end
------------------------------ 12
2 + callcc (fn k => 3)
------------------------------ 5
2 + callcc (fn k => 3 + (throw k 5) + 7)
------------------------------ 7
let fun inv n k = if n=0 
                  then throw k 13 
                  else (1 div n)
in 7 + callcc (fn k => 5 + (inv 3 k) + (inv 0 k) + (inv 2 k) + 11)
end
------------------------------ 20

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CPS (15 points)

Answer the following two questions:
* Convert the function search to CPS:

datatype tree = 
    Empty
  | Bin of int * tree * tree

fun search Empty n = false
  | search (Bin(i,t1,t2)) n = 
    if i=n then true
    else if (search t1 n) then true
         else (search t2 n)

fun searchcps Empty n k = k false
  | searchcps (Bin(i,t1,t2)) n k = 
    if i=n then k true
    else searchcps t1 n (fn b => if b then k true
                                 else searchcps t2 n k)

* Optimize the CPS version of search to immediately return
true when it finds the n it is searching for, ignoring
all pending if expressions.

fun searchcps t n rk = 
    let fun innersearch Empty k = k false
          | innersearch (Bin(i,t1,t2)) k = 
              if i=n then rk true
              else innersearch t1 (fn b => if b then rk true
                                           else innersearch t2 k)
    in innersearch t rk
    end

OR EVEN:

fun searchcps t n rk = 
    let fun innersearch Empty k = k false
          | innersearch (Bin(i,t1,t2)) k = 
              if i=n then rk true
              else innersearch t1 (fn _ => innersearch t2 k)
    in innersearch t rk
    end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Streams (20 points)

Here is a standard interpreter for a small functional language:

datatype prim = Plus

datatype exp = 
    Num of int
  | Primapp of exp * prim * exp
  | Var of string
  | Fun of string * exp
  | App of exp * exp 
  | Letrec of string * exp * exp

datatype value = 
    Int of int
  | Void
  | Closure of string * exp * env

withtype env = (string * value ref) list

exception Error

fun lookupL [] y = raise Error
  | lookupL ((x,v)::env) y = if x=y then v else lookupL env y

fun lookup env x = ! (lookupL env x)

fun extend env x v = (x,v) :: env

fun add (Int i1) (Int i2) = Int (i1+i2)
  | add _ _ = raise Error

fun interp (Num i) env = Int i
  | interp (Primapp(e1,Plus,e2)) env = add (interp e1 env) (interp e2 env)
  | interp (Var s) env = lookup env s
  | interp (Fun(s,e)) env = Closure(s,e,env)
  | interp (App(e1,e2)) env = 
    let val f = interp e1 env
        val a = interp e2 env
    in case f of 
        Closure(s,e,env) => interp e (extend env s (ref a))
      | _ => raise Error
    end
  | interp (Letrec(s,e1,e2)) env = 
    let val r = ref Void
        val renv = extend env s r
        val v1 = interp e1 renv
        val _ = (r := v1)
    in interp e2 renv
    end

We extend the set of expressions with the following three clauses:
  | MkStream of exp * exp
  | HeadStream of exp
  | TailStream of exp

Extend the above code to handle the new clauses. For example, your new
interpreter should evaluate the following expression as follows:

- val e = 
  Letrec("ones", 
         MkStream(Num 1, Var "ones"), 
         HeadStream (TailStream (TailStream (TailStream (Var "ones")))))
- interp e [];
val it = Int 1 : value

Note that the expression MkStream(Num 1, Var "ones") denotes an
infinite stream of ones. Be careful not to go into an infinite loop
while evaluating such expressions.

Here is a possible solution:

datatype value = 
    Int of int
  | Void
  | Closure of string * exp * env
  | Stream of value * (unit -> value)

...
  | interp (MkStream(e1,e2)) env = 
    let val h = interp e1 env
    in Stream(h,fn () => interp e2 env)
    end
  | interp (HeadStream e) env = 
    let val s = interp e env
    in case s of 
        Stream(h,_) => h
      | _ => raise Error
    end
  | interp (TailStream e) env = 
    let val s = interp e env
    in case s of 
        Stream(_,tf) => tf()
      | _ => raise Error
    end

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
beta-Reduction (15 points)}

In the lambda-calculus, a fixed point combinator is a term M such
that:

forall F    MF = F(MF)


Prove, using beta-reductions, that the following combinator
is a fixed point combinator:

theta = (lambda xy.y(xxy)) (lambda xy.y(xxy))

Proof: For any given F:

theta F = (lambda xy.y(xxy)) (lambda xy.y(xxy)) F
        = (y(xxy)) [x:=(lambda xy.y(xxy))] [y:=F]
        = F ((lambda xy.y(xxy)) (lambda xy.y(xxy)) F)
        = F (theta F)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
callcc (15 points)

The goal is to extend an interpreter for a small functional language
with a Break expression, whose informal semantics is as follows. If an
expression Break(e) is encountered during evaluation, then e is
evaluated to a value v, and the dynamically closest App expression
immediately returns with the value v. For example, the following
expression:

val e = 
  Letrec("f",Fun("n",Primapp(Break(Var("n")),
                             Plus,
                             App(Var("f"),Var("n")))),
         App(Var("f"),Num(42)))

evaluates as follows. The recursive function bound to f is applied to
the argument 42. The body of this function consists of an addition
whose first argument is a break expression and whose second argument
is a recursive call. Assuming that evaluation of the arguments to Plus
proceeds from left to right, the break expression is evaluated first,
which immediately jumps to the dynamically closest App expression
returning 42 as the result of the entire program.

Complete the following interpreter so that it behaves as explained above:

structure K = SMLofNJ.Cont

datatype prim = Plus

datatype exp = 
    Num of int
  | Primapp of exp * prim * exp
  | Var of string
  | Fun of string * exp
  | App of exp * exp 
  | Letrec of string * exp * exp
  | Break of exp

datatype value = 
    Int of int
  | Void
  | Closure of string * exp * env
  | BreakCont of value K.cont

withtype env = (string * value ref) list

exception Error

fun lookupL [] y = raise Error
  | lookupL ((x,v)::env) y = if x=y then v else lookupL env y

fun lookup env x = ! (lookupL env x)

fun extend env x v = (x,v) :: env

fun add (Int i1) (Int i2) = Int (i1+i2)
  | add _ _ = raise Error

fun interp (Num i) env = Int i
  | interp (Primapp(e1,Plus,e2)) env = add (interp e1 env) (interp e2 env)
  | interp (Var s) env = lookup env s
  | interp (Fun(s,e)) env = Closure(s,e,env)
  | interp (Letrec(s,e1,e2)) env = 
    let val r = ref Void
        val renv = extend env s r
        val v1 = interp e1 renv
        val _ = (r := v1)
    in interp e2 renv
    end
  | interp (App(e1,e2)) env = 
    let val f = interp e1 env
        val a = interp e2 env
    in case f of 
        Closure(s,e,cenv) => 
            let val newenv = extend cenv s (ref a)
            in K.callcc (fn bk => 
               interp e (extend newenv "_break" (ref (BreakCont bk))))
            end
      | _ => raise Error
    end
  | interp (Break(e)) env = (** Complete this clause **)

Solution:

  | interp (Break(e)) env = 
    let val (BreakCont k) = lookup env "_break" 
    in K.throw k (interp e env)
    end