This is a simple ML parser/interpreter implemented in OCAML. Below there are different versions.

Sorry for the comments in Italian. Please comment below if you don't get parts of the algorithm.

base version:

(* Varesano Fabio esercizio pdp07 Interprete *)


exception Reduce of string;;

(* definizione di tipo per la sintassi astratta *)
type expr = 
	| Var of string
	| Int of int
	| Bfun of string
	| Fun of string * expr
	| App of expr * expr
	| Let of string * expr * expr
	| Cond of expr * expr * expr
  | Bool of bool
  | Def of string * expr;;
  
(* Lista per memorizzazione espressioni def *)
let velist = ref [];;

(* Funzione di ricerca in velist *)
let rec contains_val list v = match list with
  | [] -> false
  | x::xs -> if(fst(x) = v) then true
             else contains_val xs v;;
 
let rec get_val list v = match list with
  | [] -> raise (Reduce("funzione non definita"))
  | x::xs -> if(fst(x) = v) then snd(x)
             else get_val xs v;;


(*PARSER*)

exception SyntErr of string * int;;

let p = ref 0;;

let c2s c = Char.escaped c;;

let isvar v = let c = Char.code v
	      in 96 p := !p+1;next s 
		| n when(isint n) -> let acc = ref(c2s n) 
				     in p:=!p+1;
				     while (isint s.[!p]) do
				         acc:=!acc^(c2s s.[!p]);
				         p:=!p+1
				     done;
				     !acc
		| v when(isvar v) -> let acc = ref(c2s v)
				     in p:=!p+1;
				     while (isvar s.[!p]) do
				         acc:=!acc^(c2s s.[!p]);
				         p:=!p+1 
				     done;
				     !acc
		|x -> p:=!p+1;(c2s x);;

let parse s = let rec parse1 s = 
		let c = next s 
		in match c with
			 "!" -> let v = (next s)
				in let d = (next s)
				in if(isvar v.[0]) & (d = ".") then Fun(v, parse1 s) else raise(SyntErr("valutazione !", !p))
			|"+" -> Bfun "+"
			|"*" -> Bfun "*"
			|"-" -> Bfun "-"
			|"/" -> Bfun "/"
      |"<" -> Bfun "<"
			|">" -> Bfun ">"
      |"let" -> let v1 = (next s)
                 in let u = (next s) 
                    in if(isvar v1.[0]) & (u = "=") then
                          let checkin s =
                             let i = (next s)
                             in if(i="in") then (parse1 s)
                                else raise(SyntErr("valutazione in", !p))
                             in let e = parse1 s
                                in let w = checkin s
                                   in Let(v1, e, w)
                       else raise(SyntErr("valutazione let", !p))
      |"if" -> let e1 = (parse1 s)
                in let v1 = (next s)
                   in if(v1 = "then") then
                         let e2 = (parse1 s)
                         in let v2 = (next s)
                            in if(v2 = "else") then
                                 let e3 = (parse1 s)
                                  in Cond(e1, e2, e3)
                               else raise(SyntErr("valutazione else", !p))
                      else raise(SyntErr("valutazione then", !p))
      |"def" -> let v1 = (next s)
                  in if(isvar v1.[0]) then let e = (parse1 s) in Def( v1, e)
                     else raise(SyntErr("valutazione def", !p))
      | "(" -> let v1 = (parse1 s)
				 in let rec mkapp v =
				 	let q = !p
				 	in if(next s) = ")" then v
				 	   else (p:=q;let v2 = parse1 s in mkapp(App(v, v2)))
				    in mkapp v1  
			| v when (isvar v.[0]) -> Var v 
			| n when (isint n.[0]) -> Int(int_of_string n)
			| _ -> raise(SyntErr("carattere non conosciuto", !p))
	      in (p:=0 ; parse1 ("("^s^")") );;


(*INTERPRETE*)



let rec evaluated = function
		  Fun(_,_) -> true
		| u -> let rec partial_application n = function
							  Int x -> true
              | Bool b -> true
							| Bfun v -> n < 2
							| App(u, v) -> (evaluated v && partial_application(n+1) u)
							| _ -> false
		       in partial_application 0 u;;

let mk_delta opname op =function 
			 App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Int(op x y)
			 | _ -> raise (Reduce("valutazione delta int"));;
       
let mk_if opname op =function 
       App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Bool(op x y)
       | _ -> raise (Reduce("valutazione delta bool"));;

let delta_plus = mk_delta "+" ( + );;
let delta_minus = mk_delta "-" ( - );;
let delta_times = mk_delta "*" ( * );;
let delta_div = mk_delta "/" ( / );;
let delta_less = mk_if "<" ( < );;
let delta_more = mk_if ">" ( > );;


let delta_rules = [delta_plus; delta_minus; delta_times; delta_div; delta_less; delta_more];;

let rec tryone funlist arg = match funlist with
			[] -> raise (Reduce("valutazione tryone"))
			| f::fx -> try f arg with (Reduce(_)) -> tryone fx arg;;

let delta = tryone delta_rules

let rec subst x v a = match a with
		| Var y -> if x = y then v else a
		| Fun(y, a1) -> if x = y then a else Fun(y, subst x v a1)
		| App(a1, a2) -> App(subst x v a1, subst x v a2)
		| Let(y, a1, a2) -> if x = y then Let(y, subst x v a1, a2)
				     else Let(y, subst x v a1, subst x v a2)
    | Cond(e1, e2, e3) -> Cond( subst x v e1, subst x v e2, subst x v e3)
		| e -> e;;

let beta = function
	| App(Fun(x, a), v) when evaluated v -> subst x v a
	| Let(x, v, a) when evaluated v -> subst x v a
	| _ -> raise (Reduce("valutazione beta"));;

let all_rules = beta::delta_rules;;

let top_reduction = tryone all_rules;;

let rec eval_step = function
    (* valutazione Var quando corrisponde ad una funzione definita con DEF, da richiamare. *)
    | Var v when (contains_val !velist v) -> get_val !velist v
		| App(a1,a2) when not(evaluated a1) -> App(eval_step a1, a2)
		| App(a1, a2) when not (evaluated a2) -> App(a1, eval_step a2)
		| Let(x, a1, a2) when not(evaluated a1) -> Let(x, eval_step a1, a2)
    | Cond(i, t, e) when not (evaluated i) -> Cond ((eval_step i), t, e) 
    | Cond(i, t, e) -> (
                        match i with 
                        Bool l -> if l then 
                                        if (not (evaluated t)) then
                                            eval_step t 
                                        else
                                            t
                                    else
                                        if (not (evaluated e)) then
                                            eval_step e 
                                        else
                                            e
                        |_ -> raise (Reduce("valutazione evalstep cond")))
    | Def(v, e) -> velist := (v, e)::!velist; e
		| a -> top_reduction a;;

let rec eval e = if evaluated e then e else eval(eval_step e);;

let myml code = eval(parse code);

Version using OCAML Objects:

(* esercizio pdp07 Interprete versione con classe scanner *)


exception Reduce of string;;

(* definizione di tipo per la sintassi astratta *)
type expr = 
	| Var of string
	| Int of int
	| Bfun of string
	| Fun of string * expr
	| App of expr * expr
	| Let of string * expr * expr
	| Cond of expr * expr * expr
  | Bool of bool
  | Def of string * expr;;
  
(* Lista per memorizzazione espressioni def *)
let velist = ref [];;

(* Funzione di ricerca in velist *)
let rec contains_val list v = match list with
  | [] -> false
  | x::xs -> if(fst(x) = v) then true
             else contains_val xs v;;
 
let rec get_val list v = match list with
  | [] -> raise (Reduce("funzione non definita"))
  | x::xs -> if(fst(x) = v) then snd(x)
             else get_val xs v;;


(*PARSER*)

exception SyntErr of string * int;;

let p = ref 0;;

let c2s c = Char.escaped c;;

let isvar v = let c = Char.code v
in 96 this#setpos(p+1); this#getnext 
                                | n when(isint n) -> let acc = ref(c2s n) 
                                in this#setpos(p+1);
                                while (isint s.[p]) do
                                        acc:=!acc^(c2s s.[p]);
                                        this#setpos(p+1)
                                done;
                                !acc
                | v when(isvar v) -> let acc = ref(c2s v)
                                in this#setpos(p+1);
                                while (isvar s.[p]) do
                                        acc:=!acc^(c2s s.[p]);
                                        this#setpos(p+1)
                                done;
                                !acc
                |x -> this#setpos(p+1); (c2s x)
        end;;

let parse scr = let rec parse1 scr = 
		let c = scr#getnext 
		in match c with
			 "!" -> let v = (scr#getnext)
				in let d = (scr#getnext)
				in if(isvar v.[0]) & (d = ".") then Fun(v, parse1 scr) else raise(SyntErr("valutazione !", scr#getpos))
			|"+" -> Bfun "+"
			|"*" -> Bfun "*"
			|"-" -> Bfun "-"
			|"/" -> Bfun "/"
      |"<" -> Bfun "<"
			|">" -> Bfun ">"
      |"let" -> let v1 = (scr#getnext)
                 in let u = (scr#getnext) 
                    in if(isvar v1.[0]) & (u = "=") then
                          let checkin s =
                             let i = (scr#getnext)
                             in if(i="in") then (parse1 scr)
                                else raise(SyntErr("valutazione in", scr#getpos))
                             in let e = parse1 scr
                                in let w = checkin scr
                                   in Let(v1, e, w)
                       else raise(SyntErr("valutazione let", scr#getpos))
      |"if" -> let e1 = (parse1 scr)
                in let v1 = (scr#getnext)
                   in if(v1 = "then") then
                         let e2 = (parse1 scr)
                         in let v2 = (scr#getnext)
                            in if(v2 = "else") then
                                 let e3 = (parse1 scr)
                                  in Cond(e1, e2, e3)
                               else raise(SyntErr("valutazione else", scr#getpos))
                      else raise(SyntErr("valutazione then", scr#getpos))
      |"def" -> let v1 = (scr#getnext)
                  in if(isvar v1.[0]) then let e = (parse1 scr) in Def( v1, e)
                     else raise(SyntErr("valutazione def", scr#getpos))
      | "(" -> let v1 = (parse1 scr)
				 in let rec mkapp v =
				 	let q = scr#getpos
				 	in if(scr#getnext) = ")" then v
				 	   else (scr#setpos(q);let v2 = parse1 scr in mkapp(App(v, v2)))
				    in mkapp v1  
			| v when (isvar v.[0]) -> Var v 
			| n when (isint n.[0]) -> Int(int_of_string n)
			| _ -> raise(SyntErr("carattere non conosciuto", scr#getpos))
                                in (scr#setpos(0) ; parse1 (scr#addbrakets; scr) );;


(*INTERPRETE*)



let rec evaluated = function
		  Fun(_,_) -> true
		| u -> let rec partial_application n = function
							  Int x -> true
              | Bool b -> true
							| Bfun v -> n < 2
							| App(u, v) -> (evaluated v && partial_application(n+1) u)
							| _ -> false
		       in partial_application 0 u;;

let mk_delta opname op =function 
			 App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Int(op x y)
			 | _ -> raise (Reduce("valutazione delta int"));;
       
let mk_if opname op =function 
       App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Bool(op x y)
       | _ -> raise (Reduce("valutazione delta bool"));;

let delta_plus = mk_delta "+" ( + );;
let delta_minus = mk_delta "-" ( - );;
let delta_times = mk_delta "*" ( * );;
let delta_div = mk_delta "/" ( / );;
let delta_less = mk_if "<" ( < );;
let delta_more = mk_if ">" ( > );;


let delta_rules = [delta_plus; delta_minus; delta_times; delta_div; delta_less; delta_more];;

let rec tryone funlist arg = match funlist with
			[] -> raise (Reduce("valutazione tryone"))
			| f::fx -> try f arg with (Reduce(_)) -> tryone fx arg;;

let delta = tryone delta_rules

let rec subst x v a = match a with
		| Var y -> if x = y then v else a
		| Fun(y, a1) -> if x = y then a else Fun(y, subst x v a1)
		| App(a1, a2) -> App(subst x v a1, subst x v a2)
		| Let(y, a1, a2) -> if x = y then Let(y, subst x v a1, a2)
				     else Let(y, subst x v a1, subst x v a2)
    | Cond(e1, e2, e3) -> Cond( subst x v e1, subst x v e2, subst x v e3)
		| e -> e;;

let beta = function
	| App(Fun(x, a), v) when evaluated v -> subst x v a
	| Let(x, v, a) when evaluated v -> subst x v a
	| _ -> raise (Reduce("valutazione beta"));;

let all_rules = beta::delta_rules;;

let top_reduction = tryone all_rules;;

let rec eval_step = function
    (* valutazione Var quando corrisponde ad una funzione definita con DEF, da richiamare. *)
    | Var v when (contains_val !velist v) -> get_val !velist v
		| App(a1,a2) when not(evaluated a1) -> App(eval_step a1, a2)
		| App(a1, a2) when not (evaluated a2) -> App(a1, eval_step a2)
		| Let(x, a1, a2) when not(evaluated a1) -> Let(x, eval_step a1, a2)
    | Cond(i, t, e) when not (evaluated i) -> Cond ((eval_step i), t, e) 
    | Cond(i, t, e) -> (
                        match i with 
                        Bool l -> if l then 
                                        if (not (evaluated t)) then
                                            eval_step t 
                                        else
                                            t
                                    else
                                        if (not (evaluated e)) then
                                            eval_step e 
                                        else
                                            e
                        |_ -> raise (Reduce("valutazione evalstep cond")))
    | Def(v, e) -> velist := (v, e)::!velist; e
		| a -> top_reduction a;;

let rec eval e = if evaluated e then e else eval(eval_step e);;

let myml code = let scr = new scanner (code) in eval(parse scr);
 

Using OCAML Objects and call by name:

(* esercizio pdp07 Interprete versione con classe scanner e valutazione by name *)


exception Reduce of string;;

(* definizione di tipo per la sintassi astratta *)
type expr = 
	| Var of string
	| Int of int
	| Bfun of string
	| Fun of string * expr
	| App of expr * expr
	| Let of string * expr * expr
	| Cond of expr * expr * expr
  | Bool of bool
  | Def of string * expr;;
  
(* Lista per memorizzazione espressioni def *)
let velist = ref [];;

(* Funzione di ricerca in velist *)
let rec contains_val list v = match list with
  | [] -> false
  | x::xs -> if(fst(x) = v) then true
             else contains_val xs v;;
 
let rec get_val list v = match list with
  | [] -> raise (Reduce("funzione non definita"))
  | x::xs -> if(fst(x) = v) then snd(x)
             else get_val xs v;;


(*PARSER*)

exception SyntErr of string * int;;

let p = ref 0;;

let c2s c = Char.escaped c;;

let isvar v = let c = Char.code v
in 96 this#setpos(p+1); this#getnext 
                                | n when(isint n) -> let acc = ref(c2s n) 
                                in this#setpos(p+1);
                                while (isint s.[p]) do
                                        acc:=!acc^(c2s s.[p]);
                                        this#setpos(p+1)
                                done;
                                !acc
                | v when(isvar v) -> let acc = ref(c2s v)
                                in this#setpos(p+1);
                                while (isvar s.[p]) do
                                        acc:=!acc^(c2s s.[p]);
                                        this#setpos(p+1)
                                done;
                                !acc
                |x -> this#setpos(p+1); (c2s x)
        end;;

let parse scr = let rec parse1 scr = 
		let c = scr#getnext 
		in match c with
			 "!" -> let v = (scr#getnext)
				in let d = (scr#getnext)
				in if(isvar v.[0]) & (d = ".") then Fun(v, parse1 scr) else raise(SyntErr("valutazione !", scr#getpos))
			|"+" -> Bfun "+"
			|"*" -> Bfun "*"
			|"-" -> Bfun "-"
			|"/" -> Bfun "/"
      |"<" -> Bfun "<"
			|">" -> Bfun ">"
      |"let" -> let v1 = (scr#getnext)
                 in let u = (scr#getnext) 
                    in if(isvar v1.[0]) & (u = "=") then
                          let checkin s =
                             let i = (scr#getnext)
                             in if(i="in") then (parse1 scr)
                                else raise(SyntErr("valutazione in", scr#getpos))
                             in let e = parse1 scr
                                in let w = checkin scr
                                   in Let(v1, e, w)
                       else raise(SyntErr("valutazione let", scr#getpos))
      |"if" -> let e1 = (parse1 scr)
                in let v1 = (scr#getnext)
                   in if(v1 = "then") then
                         let e2 = (parse1 scr)
                         in let v2 = (scr#getnext)
                            in if(v2 = "else") then
                                 let e3 = (parse1 scr)
                                  in Cond(e1, e2, e3)
                               else raise(SyntErr("valutazione else", scr#getpos))
                      else raise(SyntErr("valutazione then", scr#getpos))
      |"def" -> let v1 = (scr#getnext)
                  in if(isvar v1.[0]) then let e = (parse1 scr) in Def( v1, e)
                     else raise(SyntErr("valutazione def", scr#getpos))
      | "(" -> let v1 = (parse1 scr)
				 in let rec mkapp v =
				 	let q = scr#getpos
				 	in if(scr#getnext) = ")" then v
				 	   else (scr#setpos(q);let v2 = parse1 scr in mkapp(App(v, v2)))
				    in mkapp v1  
			| v when (isvar v.[0]) -> Var v 
			| n when (isint n.[0]) -> Int(int_of_string n)
			| _ -> raise(SyntErr("carattere non conosciuto", scr#getpos))
                                in (scr#setpos(0) ; parse1 (scr#addbrakets; scr) );;


(*INTERPRETE*)



let rec evaluated = function
		  Fun(_,_) -> true
		| u -> let rec partial_application n = function
							  Int x -> true
                                                        | Bool b -> true
							| Bfun v -> n < 2
							| App(u, v) -> (evaluated v && partial_application(n+1) u)
							| _ -> false
		       in partial_application 0 u;;

let mk_delta opname op =function 
			 App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Int(op x y)
			 | _ -> raise (Reduce("valutazione delta int"));;
       
let mk_if opname op =function 
       App(App(Bfun opr, Int x), Int y) when (opr=opname) -> Bool(op x y)
       | _ -> raise (Reduce("valutazione delta bool"));;

let delta_plus = mk_delta "+" ( + );;
let delta_minus = mk_delta "-" ( - );;
let delta_times = mk_delta "*" ( * );;
let delta_div = mk_delta "/" ( / );;
let delta_less = mk_if "<" ( < );;
let delta_more = mk_if ">" ( > );;


let delta_rules = [delta_plus; delta_minus; delta_times; delta_div; delta_less; delta_more];;

let rec tryone funlist arg = match funlist with
			[] -> raise (Reduce("valutazione tryone"))
			| f::fx -> try f arg with (Reduce(_)) -> tryone fx arg;;

let delta = tryone delta_rules

let rec subst x v a = match a with
		| Var y -> if x = y then v else a
		| Fun(y, a1) -> if x = y then a else Fun(y, subst x v a1)
		| App(a1, a2) -> App(subst x v a1, subst x v a2)
		| Let(y, a1, a2) -> if x = y then Let(y, subst x v a1, a2)
				     else Let(y, subst x v a1, subst x v a2)
    | Cond(e1, e2, e3) -> Cond( subst x v e1, subst x v e2, subst x v e3)
		| e -> e;;

let beta = function
(* rimosso test evaluated su v*)
	| App(Fun(x, a), v) -> subst x v a
	| Let(x, v, a) -> subst x v a
	| _ -> raise (Reduce("valutazione beta"));;

let all_rules = beta::delta_rules;;

let top_reduction = tryone all_rules;;

let rec eval_step = function
    (* valutazione Var quando corrisponde ad una funzione definita con DEF, da richiamare. *)
    | Var v when (contains_val !velist v) -> get_val !velist v
		| App(a1,a2) when not(evaluated a1) -> App(eval_step a1, a2)
		(*| App(a1, a2) when not (evaluated a2) -> App(a1, eval_step a2)*)
		(*| Let(x, a1, a2) when not(evaluated a1) -> Let(x, eval_step a1, a2)*)
    | Cond(i, t, e) when not (evaluated i) -> Cond ((eval_step i), t, e) 
    | Cond(i, t, e) -> (
                        match i with 
                        Bool l -> if l then 
                                        if (not (evaluated t)) then
                                            eval_step t 
                                        else
                                            t
                                    else
                                        if (not (evaluated e)) then
                                            eval_step e 
                                        else
                                            e
                        |_ -> raise (Reduce("valutazione evalstep cond")))
    | Def(v, e) -> velist := (v, e)::!velist; e
		| a -> top_reduction a;;

let rec eval e = if evaluated e then e else eval(eval_step e);;

let myml code = let scr = new scanner (code) in eval(parse scr);