type prim = {name : string; arity : int} let succ = {name ="succ"; arity = 1} let plus = {name = "plus"; arity = 2} type exp = | Const of int | Prim of prim * exp list | Var of var | App of exp * exp | Fonction of var * exp | Liaison of var * exp * exp and var = string;; type valeur = | Vconst of int | Vfonction of var * exp * env and env = (var * valeur) list;; type error = | Libre of string | Delta of prim * valeur list | Beta of exp exception Error of error let error e = raise (Error e);; let delta_plus [ Vconst x; Vconst y] = Vconst (x + y) let delta_succ [ Vconst x ] = Vconst (x+1) let delta = [ "succ", delta_succ; "plus", delta_plus; ] ;; let find x env = try List.assoc x env with Not_found -> error (Libre x);; let rec eval env = function | Const c -> Vconst c | Var x -> find x env | Fonction (x, a) -> Vfonction (x, a, env) | App (a1, a2) as e -> let f = eval env a1 in let v = eval env a2 in begin match f with | Vfonction (x, a, env0) -> eval ((x, v) :: env0) a | Vconst _ -> error (Beta e) end | Prim (f, args) -> let vargs = List.map (eval env) args in begin try (List.assoc f.name delta) vargs with x -> error (Delta (f, vargs)) end | Liaison (x, e1, e2) -> eval env (App (Fonction (x, e2), e1)) ;;