(* 15-212, Spring 2011 *) (* Michael Erdmann *) (* Code for Lecture 24 *) (* Part B: Functions and Recursion in an Interpreter *) (* Authored by Frank Pfenning, Fall 1997 *) (************************************************************************) (* NOTE: The code for this lecture assumes that the following *) (* file has already been loaded: *) (* use "/afs/andrew/course/15/212sp/code/rational.sml"; *) (************************************************************************) (* Adding functions *) signature EVAL2 = sig type ident = string datatype 'a env = Null | Dec of 'a env * (ident * 'a) datatype exp = Integer of int | Plus of exp * exp | Minus of exp * exp | Times of exp * exp | Divide of exp * exp | Neg of exp | True | False | IfThenElse of exp * exp * exp | Or of exp * exp | And of exp * exp | Equal of exp * exp | Less of exp * exp | Let of exp env * exp | Var of ident | Fn of ident * exp (* new: fn x => e *) | App of exp * exp (* new: e1 e2 *) type decls = exp env datatype value = Rational of Rat.rat | Boolean of bool | Closure of value env * exp (* new: {env; fn x => e} *) val toString : value -> string exception Error of string val eval : value env * exp -> value val eval' : value env * decls -> value env end; (* signature EVAL2 *) functor Eval2 () :> EVAL2 = struct type ident = string datatype 'a env = Null | Dec of 'a env * (ident * 'a) exception Error of string (* val lookup : string * 'a env -> 'a *) (* raises Error if variable is not declared in environment *) fun lookup (x, env) = let fun lk (Null) = raise Error ("Undeclared Variable") | lk (Dec(env, (y, v))) = if (x = y) then v else lk env in lk env end datatype exp = Integer of int | Plus of exp * exp | Minus of exp * exp | Times of exp * exp | Divide of exp * exp | Neg of exp | True | False | IfThenElse of exp * exp * exp | Or of exp * exp | And of exp * exp | Equal of exp * exp | Less of exp * exp | Let of exp env * exp | Var of ident | Fn of ident * exp (* new: fn x => e *) | App of exp * exp (* new: e1 e2 *) type decls = exp env datatype value = Rational of Rat.rat | Boolean of bool | Closure of value env * exp (* new: {env; fn x => e} *) fun intToString (p) = if p < 0 then "-" ^ Int.toString(~p) else Int.toString(p) fun toString' (p, 1) = intToString p | toString' (p, q) = intToString p ^ "/" ^ intToString q fun toString (Rational(r)) = toString' (Rat.toInts r) | toString (Boolean(true)) = "true" | toString (Boolean(false)) = "false" | toString (Closure _) = "_" (* new: closures not observable *) fun theRat (Rational(r)) = r | theRat _ = raise Error ("Runtime Type Error") fun theBool (Boolean(b)) = b | theBool _ = raise Error ("Runtime Type Error") fun theClosure (Closure(env, e)) = (env, e) | theClosure _ = raise Error ("Runtime Type Error") fun evalExp (env, Integer(n)) = Rational (Rat.//(n,1)) | evalExp (env, Plus es) = ratOp env Rat.+ es | evalExp (env, Minus es) = ratOp env Rat.- es | evalExp (env, Times es) = ratOp env Rat.* es | evalExp (env, Divide es) = ratOp env Rat./ es | evalExp (env, Neg e) = ratFun env Rat.~ e | evalExp (env, True) = Boolean (true) | evalExp (env, False) = Boolean (false) | evalExp (env, IfThenElse(e1, e2, e3)) = if theBool(evalExp(env, e1)) then evalExp (env, e2) else evalExp (env, e3) | evalExp (env, Or(e1, e2)) = Boolean (theBool(evalExp(env, e1)) orelse theBool(evalExp(env, e2))) | evalExp (env, And(e1, e2)) = Boolean (theBool(evalExp(env, e1)) andalso theBool(evalExp(env, e2))) | evalExp (env, Equal(e1, e2)) = Boolean (case Rat.compare (theRat (evalExp(env, e1)), theRat (evalExp(env, e2))) of EQUAL => true | _ => false) | evalExp (env, Less(e1, e2)) = Boolean (case Rat.compare (theRat (evalExp(env, e1)), theRat (evalExp(env, e2))) of LESS => true | _ => false) | evalExp (env, Let(decls, e)) = evalExp (evalDecls(env, decls), e) | evalExp (env, Var(x)) = lookup (x, env) (* next two cases are new *) | evalExp (env, e as Fn(x, e')) = Closure(env, e) | evalExp (env, App(e1, e2)) = let val (env', Fn (x, e1')) = theClosure (evalExp (env, e1)) val v2 = evalExp (env, e2) in evalExp (Dec (env', (x, v2)), e1') end and evalDecls (env, Null) = env | evalDecls (env, Dec(decls, (x, e))) = let val env' = evalDecls (env, decls) val v = evalExp (env', e) in Dec (env', (x, v)) end and ratOp env func (e1, e2) = Rational (func (theRat (evalExp (env, e1)), theRat (evalExp (env, e2)))) and ratFun env func e = Rational (func (theRat (evalExp (env, e)))) fun handleErrors func x = (func x handle Div => raise Error ("Division by Zero") | Overflow => raise Error ("Arithmetic Overflow")) fun eval (env, e) = handleErrors evalExp (env, e) fun eval' (env, decls) = handleErrors evalDecls (env, decls) end; (* functor Eval2 *) structure Eval2 :> EVAL2 = Eval2 (); local open Eval2 in val e = Let (Dec (Dec (Dec (Null, ("x", Integer 3)), ("f", Fn ("y", Divide (Var "y", Var "x")))), ("x", Integer 1)), App (Var "f", Integer 2)) val v = eval (Null, e) val _ = print (toString v ^ "\n") end; (* Adding recursion *) signature EVAL2 = sig type ident = string datatype 'a env = Null | Dec of 'a env * (ident * 'a) | Rec of 'a env * (ident * 'a) (* new: recursive environment *) datatype exp = Integer of int | Plus of exp * exp | Minus of exp * exp | Times of exp * exp | Divide of exp * exp | Neg of exp | True | False | IfThenElse of exp * exp * exp | Or of exp * exp | And of exp * exp | Equal of exp * exp | Less of exp * exp | Let of exp env * exp | Var of ident | Fn of ident * exp (* new: fn x => e *) | App of exp * exp (* new: e1 e2 *) type decls = exp env datatype value = Rational of Rat.rat | Boolean of bool | Closure of value env * exp (* new: {env; fn x => e} *) | Freeze of exp (* new: unevaluated expression *) val toString : value -> string exception Error of string val eval : value env * exp -> value val eval' : value env * decls -> value env end; (* signature EVAL2 *) functor Eval2 () :> EVAL2 = struct type ident = string datatype 'a env = Null | Dec of 'a env * (ident * 'a) | Rec of 'a env * (ident * 'a) exception Error of string (* lookup now returns the environment ending in the declaration *) (* for the variable to allow recursion *) (* val lookup : string * 'a env -> 'a env *) (* raises Error if variable is not declared in environment *) fun lookup (x, env) = let fun lk (Null) = raise Error ("Undeclared Variable") | lk (env as Dec(env', (y, v))) = if (x = y) then env else lk env' | lk (env as Rec(env', (y, v))) = if (x = y) then env else lk env' in lk env end datatype exp = Integer of int | Plus of exp * exp | Minus of exp * exp | Times of exp * exp | Divide of exp * exp | Neg of exp | True | False | IfThenElse of exp * exp * exp | Or of exp * exp | And of exp * exp | Equal of exp * exp | Less of exp * exp | Let of exp env * exp | Var of ident | Fn of ident * exp (* new: fn x => e *) | App of exp * exp (* new: e1 e2 *) type decls = exp env datatype value = Rational of Rat.rat | Boolean of bool | Closure of value env * exp (* new: {env; fn x => e} *) | Freeze of exp (* new: unevaluated expression *) fun intToString (p) = if p < 0 then "-" ^ Int.toString(~p) else Int.toString(p) fun toString' (p, 1) = intToString p | toString' (p, q) = intToString p ^ "/" ^ intToString q fun toString (Rational(r)) = toString' (Rat.toInts r) | toString (Boolean(true)) = "true" | toString (Boolean(false)) = "false" | toString (Closure _) = "_" (* new: closures not observable *) fun theRat (Rational(r)) = r | theRat _ = raise Error ("Runtime Type Error") fun theBool (Boolean(b)) = b | theBool _ = raise Error ("Runtime Type Error") fun theClosure (Closure(env, e)) = (env, e) | theClosure _ = raise Error ("Runtime Type Error") fun evalExp (env, Integer(n)) = Rational (Rat.//(n,1)) | evalExp (env, Plus es) = ratOp env Rat.+ es | evalExp (env, Minus es) = ratOp env Rat.- es | evalExp (env, Times es) = ratOp env Rat.* es | evalExp (env, Divide es) = ratOp env Rat./ es | evalExp (env, Neg e) = ratFun env Rat.~ e | evalExp (env, True) = Boolean (true) | evalExp (env, False) = Boolean (false) | evalExp (env, IfThenElse(e1, e2, e3)) = if theBool(evalExp(env, e1)) then evalExp (env, e2) else evalExp (env, e3) | evalExp (env, Or(e1, e2)) = Boolean (theBool(evalExp(env, e1)) orelse theBool(evalExp(env, e2))) | evalExp (env, And(e1, e2)) = Boolean (theBool(evalExp(env, e1)) andalso theBool(evalExp(env, e2))) | evalExp (env, Equal(e1, e2)) = Boolean (case Rat.compare (theRat (evalExp(env, e1)), theRat (evalExp(env, e2))) of EQUAL => true | _ => false) | evalExp (env, Less(e1, e2)) = Boolean (case Rat.compare (theRat (evalExp(env, e1)), theRat (evalExp(env, e2))) of LESS => true | _ => false) | evalExp (env, Let(decls, e)) = evalExp (evalDecls(env, decls), e) | evalExp (env, Var(x)) = (case lookup (x, env) of env' as Rec (_, (x, Freeze e)) => evalExp (env', e) | Dec (_, (x, v)) => v) (* no other case possible: recursive declarations are always *) (* frozen definitions in the appropriate environment *) (* next two cases are new *) | evalExp (env, e as Fn(x, e')) = Closure(env, e) | evalExp (env, App(e1, e2)) = let val (env', Fn (x, e1')) = theClosure (evalExp (env, e1)) val v2 = evalExp (env, e2) in evalExp (Dec (env', (x, v2)), e1') end and evalDecls (env, Null) = env | evalDecls (env, Dec(decls, (x, e))) = let val env' = evalDecls (env, decls) val v = evalExp (env', e) in Dec (env', (x, v)) end | evalDecls (env, Rec(decls, (x, e))) = let val env' = evalDecls (env, decls) in Rec (env', (x, Freeze e)) end and ratOp env func (e1, e2) = Rational (func (theRat (evalExp (env, e1)), theRat (evalExp (env, e2)))) and ratFun env func e = Rational (func (theRat (evalExp (env, e)))) fun handleErrors func x = (func x handle Div => raise Error ("Division by Zero") | Overflow => raise Error ("Arithmetic Overflow")) fun eval (env, e) = handleErrors evalExp (env, e) fun eval' (env, decls) = handleErrors evalDecls (env, decls) end; (* functor Eval2 *) structure Eval2 :> EVAL2 = Eval2 (); local open Eval2 in val e = Let (Rec (Dec (Null, ("b", Integer 2)), ("power", Fn ("x", IfThenElse (Equal (Var "x", Integer 0), Integer 1, Times (Var "b", App (Var "power", Minus (Var "x", Integer 1))))))), App (Var "power", Integer 5)) val v = eval (Null, e) val _ = print (toString v ^ "\n") val e' = Let (Rec (Null, ("blackHole", Var "blackHole")), Integer 1) val v' = eval (Null, e') val _ = print (toString v' ^ "\n") val e'' = Let (Rec (Null, ("blackHole", Var "blackHole")), Var "blackHole"); end; (* will not terminate *) (* val v'' = Eval2.eval (Eval2.Null, e''); *)