嗨，所有社区， 对于学校项目，我必须实现一个以这种方式定义的Ocaml解释器：
类型：
type generic = A | B | C | D | … | Z
type typ =
Tint
| Tbool
| Tchar
| Tlist of typ
| Tfun of typ list * typ
| Tgen of generic
Expressions:
type exp =
Eint of int
| Ebool of bool
| Echar of char
| Empty
| Cons of exp * exp
| Den of ide
| Prod of exp * exp
| Sum of exp * exp
| Diff of exp * exp
| Mod of exp * exp
| Div of exp * exp
| Lessint of exp * exp
| Eqint of exp * exp
| Iszero of exp
| Lesschar of exp * exp
| Eqchar of exp * exp
| Or of exp * exp
| And of exp * exp
| Not of exp
| Ifthenelse of exp * exp * exp
| Let of (ide * exp) list * exp
| Fun of ide list * exp
| Apply of exp * exp list
作为基本类型，语言具有整数，布尔，字符，函数和功能对象旁边的任何类型的列表。函数具有作为标识符的参数列表，并且表达式Den of ide给出与标识符相关联的可表达值，并且标识符的类型是类型ide = string。本地声明是标识符和表达式的列表（Let of（ide * exp）list * exp）。
＆＃34;为这种动态范围的语言编写类型推理系统和解释器。采用的约束政策是深度约束政策。表达式的评估结果是合适的值和类型。如果是函数，则应返回闭合表达式，而闭合表示表达式中的每个标识符必须是本地声明或参数。＆＃34;
＆＃34;在前一点实现的解释器可能是渴望或懒惰的，其中eager意味着传递给函数的参数在传递时被计算，而lazy意味着参数的评估是在它们执行时执行的真的用过＆＃34;。
＆＃34;类型推断函数（type_inf）应该接收一个表达式，并且应该返回它的类型，它是以下类型的元素＆＃34;
我已经实现了类型，环境，类型检查器和sem_eager，但是对于懒惰的那些有一些问题，并且不知道我的sem_eager是否正确。 有人可以看看吗？ 非常感谢，我发布了我现在已经做过的代码：
(**SYNTAX**)
type generic = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z ;;
type ide = string;;
type exp =
| Eint of int
| Ebool of bool
| Echar of char
| Empty
| Cons of exp * exp
| Den of ide
| Prod of exp * exp
| Sum of exp * exp
| Diff of exp * exp
| Mod of exp * exp
| Div of exp * exp
| Lessint of exp * exp
| Eqint of exp * exp
| Iszero of exp
| Lesschar of exp * exp
| Eqchar of exp * exp
| Or of exp * exp
| And of exp * exp
| Not of exp
| Ifthenelse of exp * exp * exp
| Let of (ide * exp) list * exp
| Fun of ide list * exp
| Apply of exp * exp list
;;
(**Types**)
type typ =
| Tint
| Tbool
| Tchar
| Tlist of typ
| Tfun of typ list * typ
| Tgen of generic;;
(**AUXILIAR FUNCTION**)
let rec type_leg x = match x with
| Eint (v) -> true
| Ebool (v) -> true
| Echar (v) -> true
| Empty -> true
| _ -> false;;
let rev list =
let rec aux acc = function
| [] -> acc
| h::t -> aux (h::acc) t in
aux [] list;;
(** ENVIRONMENT **)
type env = (ide*exp) list;;
let rho:env = [];;
let insert_value ((id:ide), el) (r:env) = if type_leg(el) then (id,el)::r else r;;
let rec insert letlist (rho:env) = match letlist with
|[] -> rho
|hd::tl -> insert tl (insert_value hd rho);;
let rec getExp (id:ide) (rho:env) = match rho with
| [] -> (Empty)
| hd::tl -> if fst(hd) = id then snd(hd) else getExp id tl
;;
exception TypeError of string;;
(**TYPE INFERENCE**)
let rec type_inf (e:exp) (rho:env) = match e with
|Eint (n) -> Tint
|Ebool (n) -> Tbool
|Echar (n) -> Tchar
|Empty -> type_inf (Echar ('E')) rho
|Cons (v, l) ->
(match (type_inf v rho, l) with
|(t,Empty) -> if type_inf (Empty) rho = type_inf (Echar ('E')) rho then Tlist (t) else raise (TypeError "error")
|(t,l) -> let temp = (type_inf l rho) in if temp = Tlist (t) then type_inf l rho else raise (TypeError "Different type"))
|Den (id) -> type_inf (getExp id rho) rho
|Prod (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
|(Tint, Tint) -> Tint
|_ -> raise (TypeError "Not a Tint"))
|Sum (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
|(Tint, Tint) -> Tint
|_ -> raise (TypeError "Not a Tint"))
|Diff (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
|(Tint, Tint) -> Tint
|_ -> raise (TypeError "Not a Tint"))
|Mod (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
|(Tint, Tint) -> Tint
|_ -> raise (TypeError "Not a Tint"))
|Div (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
|(Tint, Tint) -> Tint
|_ -> raise (TypeError "Not a Tint"))
|Lessint (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tint, Tint) -> Tbool
| _ -> raise (TypeError "TODO"))
|Eqint (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tint, Tint) -> Tbool
| _ -> raise (TypeError "TODO"))
|Iszero e1 -> (match (type_inf e1 rho) with
| Tint -> Tbool
| _ -> raise (TypeError " "))
|Lesschar (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tchar, Tchar) -> Tbool
| _ -> raise (TypeError " "))
|Eqchar (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tchar, Tchar)-> Tbool
| _ -> raise (TypeError " "))
|Or (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tbool , Tbool) -> Tbool
| _ -> raise (TypeError " "))
|And (e1, e2) -> (match (type_inf e1 rho, type_inf e2 rho) with
| (Tbool , Tbool) -> Tbool
| _ -> raise (TypeError " "))
|Not e1 -> (match (type_inf e1 rho) with
| Tbool -> Tbool
| _ -> raise (TypeError "cis"))
|Ifthenelse (g, e1, e2) -> (match (type_inf g rho, type_inf e1 rho, type_inf e2 rho) with
|(b, exp1, exp2) when exp1 = exp2 && b = Tbool -> exp1
|_ -> raise (TypeError "error"))
|Let (l , ex) -> type_inf ex (insert l rho)
|Fun (l, ex) -> Tfun (getTypeFun l [], type_inf ex rho)
|Apply (ex, l) -> type_inf ex rho
and getTypeFun l temp = match l with
[] -> rev temp
|hd::tl -> if type_leg (Den (hd)) then getTypeFun tl ( (type_inf (Den (hd)) rho)::temp)
else getTypeFun tl ((Tgen (A))::temp);;
(**SEM_EAGER**)
let rec sem_eager (e:exp) (rho:env) = match e with
|Eint (n) -> (Eint (n), type_inf (Eint (n)) rho)
|Echar (c) -> (Echar (c), type_inf (Echar (c)) rho)
|Ebool (b) -> (Ebool (b), type_inf (Ebool (b)) rho)
|Empty -> (Echar ('E'), type_inf (Echar ('E')) rho)
|Cons (v, l) -> (Cons (v,l), type_inf (Cons(v,l)) rho)
|Den (id) -> (getExp id rho, type_inf (getExp id rho) rho)
|Prod (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Eint (e1 * e2), type_inf (Eint (e1 * e2)) rho)
|_ -> failwith "errore prodotto")
|Sum (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Eint (e1 + e2), type_inf (Eint (e1 + e2)) rho)
|_ -> failwith "errore somma")
|Diff (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Eint (e1 - e2), type_inf (Eint (e1 - e2)) rho)
|_ -> failwith "errore differenza")
|Mod (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> if (not (e2 = 0)) then (Eint (e1 mod e2), type_inf (Eint (e1 mod e2)) rho) else failwith "Division for 0"
|_ -> failwith "errore modulo")
|Div (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Eint (e1 / e2), type_inf (Eint (e1 / e2)) rho)
|_ -> failwith "errore divisione")
|Lessint (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Ebool (e1 < e2), type_inf (Ebool (e1 < e2)) rho)
|_ -> failwith "errore lessInt")
|Eqint (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Eint e1, Tint), (Eint e2, Tint)) -> (Ebool (e1 = e2), type_inf (Ebool (e1 = e2)) rho)
|_ -> failwith "errore eqInt")
|Iszero (e1) -> (match (sem_eager e1 rho) with
|(Eint e1, Tint) -> (Ebool (e1 = 0), type_inf (Ebool (e1 = 0)) rho)
|_ -> failwith "errore iszero")
|Lesschar (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Echar e1, Tchar), (Echar e2, Tchar)) -> (Ebool (e1 < e2), type_inf (Ebool (e1 < e2)) rho)
|_ -> failwith "errore lesschar")
|Eqchar (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Echar e1, Tchar), (Echar e2, Tchar)) -> (Ebool (e1 = e2), type_inf (Ebool (e1 = e2)) rho)
|_ -> failwith "errore eqchar")
|Or (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Ebool e1, Tbool), (Ebool e2, Tbool)) -> (Ebool (e1 || e2), type_inf (Ebool (e1 || e2)) rho)
|_ -> failwith "errore divisione")
|And (e1, e2) -> (match (sem_eager e1 rho, sem_eager e2 rho) with
|((Ebool e1, Tbool), (Ebool e2, Tbool)) -> (Ebool (e1 && e2), type_inf (Ebool (e1 && e2)) rho)
|_ -> failwith "errore divisione")
|Not (e1) -> (match (sem_eager e1 rho) with
|(Ebool e1, Tbool) -> (Ebool (not e1), type_inf (Ebool (not e1)) rho)
|_ -> failwith "errore divisione")
|Ifthenelse (g, e1, e2) ->
if ((type_inf (e1) rho) = (type_inf (e2) rho)) then
(match (sem_eager g rho) with
|(Ebool g1, Tbool) -> if g1 then sem_eager e1 rho else sem_eager e2 rho
|_-> failwith "not a bool")
else failwith "different type"
|Let (l, ex) -> sem_eager ex (insert l rho)
|Fun (l, ex) -> (Fun (l, ex), type_inf (Fun (l, ex)) rho)
|Apply (foo, l2) ->let rho':env = [] in match foo with
|Fun (l1, ex) -> sem_eager ex (concatenv (insert (combine l1 l2 []) rho') rho [])
|_-> failwith "non è una fun"
and combine (l1:ide list) (l2:exp list) (temp:env) = match (l1,l2) with
([],[]) -> temp
|((hd1::tl1),(hd2::tl2)) -> combine tl1 tl2 ((hd1, hd2)::temp)
|(_,_) -> failwith "lenght fun list doesent match"
and concatenv (envfun:env) (envgen:env) (envres:env) = match (envfun, envgen) with
([],[]) -> envres
|(hd::tl, []) -> concatenv tl [] (hd::envres)
|(_,hd::tl) -> concatenv envfun tl (hd::envres)
;;
感谢大家看过我的代码。
答案 0 :(得分：4)