# An open value interpreter

type 'value expr = | App of 'value expr * 'value expr | Eq of 'value expr * 'value expr | Id of string | If of 'value expr * 'value expr * 'value expr | Lambda of string * 'value expr | Let of string * 'value expr * 'value expr | LetRec of string * 'value expr * 'value expr | Val of 'value exception NoSuchVar of string exception TypeError of string let rec lookup name = function | [] -> raise (NoSuchVar name) | (n, v) :: _ when name = n -> v | _ :: t -> lookup name t;; let rec eval env = function | App(f, x) -> let f' = eval env f and x' = eval env x in (match f' with | `BuiltinFunc(f) -> f x' | `Closure(var, body, env') -> eval ((var, x')::env') body | _ -> failwith "Invalid App LHS") | Eq(l, r) -> let l' = eval env l and r' = eval env r in `Bool(l' = r') | Id(x) -> lookup x env | If(c, t, e) -> (match eval env c with | `Bool(true) -> eval env t | `Bool(false) -> eval env e | _ -> raise (TypeError "bool")) | Lambda(arg, body) -> `Closure(arg, body, env) | Let(bv, be, expr) -> let v = eval env be in eval ((bv, v)::env) expr | LetRec(bv, Lambda(arg, body), expr) -> let rec env' = (bv, `Closure(arg, body, env'))::env in eval env' expr | LetRec(_, _, _) -> failwith "Invalid LetRec" | Val(v) -> v;; let evaluate = eval [];; (** An expression that doesn't actually use any values has a completely * unconstrained value type parameter; i.e. it's of type 'a expr. *) let omega = Lambda("x", App(Id("x"), Id("x"))) (** The type inferred here without the annotation on op is pretty loose, since * there's nothing actually saying what type `Int corresponds to. Furthermore, * there's nothing forcing l, r, and the return type to all be the same * either. *) let arith_op (op: int -> int -> int) l r = let f = `BuiltinFunc(function | `Int l -> `BuiltinFunc(function | `Int r -> `Int(op l r) | _ -> raise (TypeError "int")) | _ -> raise (TypeError "int")) in App(App(Val(f), l), r);; (* Just some helpers. *) let add (l, r) = arith_op ( + ) l r let mul (l, r) = arith_op ( * ) l r (** An expression using ints. The type evaluated to here still is either a * built-in function or an int -- the types forced to exist by eval don't need * to exist, since eval isn't actually involved here. *) let int_stuff = mul( add(Val(`Int(1)), Val(`Int(2))), add(Val(`Int(3)), Val(`Int(4))));; (* We can use strings too, without having declared them above. *) (** Concatenates two strings. *) let strcat = Val(`BuiltinFunc(function | `String(s1) -> `BuiltinFunc(function | `String(s2) -> `String(s1 ^ s2) | _ -> raise (TypeError "String")) | _ -> raise (TypeError "String"))) (** Gets the length of a string. You can see that the type inference figures * out that this is String -> Int, and so will force both to be valid values * for the exprs this is embedded in. *) let strlen = Val(`BuiltinFunc(function | `String(s) -> `Int(String.length s) | _ -> raise (TypeError "String"))) (** The code used below; the type here is again somewhat unhelpful, other than * exposing the structure of the code itself. *) let hello_world_len = Let("s1", Val(`String("Hello")), Let("s2", Val(`String("World")), App(strlen, App(App(strcat, Id("s1")), Id("s2")))))