(* Data definitions *) type fae = Num of int | Add of fae * fae | Sub of fae * fae | Id of string | Fun of string * fae | App of fae * fae and faeValue = NumV of int | ClosureV of string * fae * subCache and subCache = MTSub | ASub of string * faeValue * subCache (* Lookup *) exception Failed of string let rec lookup = function (findName, MTSub) -> raise (Failed "free variable") | (findName, ASub(name, v, restSc)) -> if (name = findName) then v else lookup(findName, restSc) (* Number operations *) let mkNumOp = fun op -> function (NumV(a), NumV(b)) -> NumV(op a b) | _ -> raise (Failed "not numbers") let numPlus = mkNumOp (fun a b -> a + b) let numMinus = mkNumOp (fun a b -> a - b) (* Interpreter *) let rec interp : (fae * subCache -> faeValue ) = function (Num(n), sc) -> NumV(n) | (Add(l, r), sc) -> numPlus(interp(l, sc), interp(r, sc)) | (Sub(l, r), sc) -> numMinus(interp(l, sc), interp(r, sc)) | (Id(name), sc) -> lookup(name, sc) | (Fun(param, body), sc) -> ClosureV(param, body, sc) | (App(fn, arg), sc) -> let funV = interp(fn, sc) and argV = interp(arg, sc) in match funV with ClosureV(param, body, sc) -> interp(body, ASub(param, argV, sc)) | _ -> raise (Failed "not a function") (* Testing *) let test = function (a, b) -> if (a = b) then true else raise (Failed "test failure") ;; (* Test cases *) test(interp(Num(10), MTSub), NumV(10));; test(interp(Add(Num(10), Num(17)), MTSub), NumV(27));; test(interp(Sub(Num(10), Num(7)), MTSub), NumV(3));; test(interp(App(Fun("x", Add(Id("x"), Num(12))), Add(Num(1), Num(17))), MTSub), NumV(30));; test(interp(App(Fun("x", App(Fun("f", Add(App(Id("f"), Num(1)), App(Fun("x", App(Id("f"), Num(2))), Num(3)))), Fun("y", Add(Id("x"), Id("y"))))), Num(0)), MTSub), NumV(3));;