函数式语言的Ocaml解释器

大家好， 对于学校项目，我必须实现一个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

该语言的基本类型有整数、布尔、字符、函数和函数对象以外的任何类型的列表。函数有一个作为标识符的参数列表，ide的表达式Den给出与标识符关联的可表达值，标识符的类型为ide=string类型。本地声明是标识符和表达式的列表（Let of（ide*exp）list*exp）

为这种动态范围语言编写一个类型推断系统和一个解释器。要采用的约束策略是深度约束策略。表达式求值的结果是合适的值和类型。对于函数，它应该返回一个闭合表达式，而闭合意味着表达式中的每个标识符必须是本地声明或参数。”

“在前一点实现的解释器可能是渴望或懒惰的，其中渴望意味着传递给函数的参数在传递时进行计算，而懒惰意味着在实际使用时执行参数的计算”

“类型推断函数（type_inf）应接收一个表达式，并应返回其类型，该类型是以下类型的元素”

我已经实现了类型、环境、类型检查器和sem\u-eager，但是在懒惰的方面有一些问题，不知道我的sem\u-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)

（**语法**）
类型泛型=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 |；；
类型ide=string；；
类型exp=
|国际电信号
|布尔的埃博洛
|焦耳
|空的
|exp*exp的缺点
|艾德之穴
|exp*exp的产品
|exp*exp之和
|exp*exp的差值
|exp的Mod*exp
|exp*exp的Div
|Lessint of exp*exp
|exp*exp的Eqint
|exp的值为零
|Lesschar of exp*exp
|exp*exp的Eqchar
|或exp*exp
|exp*exp的和
|不属于经验
|如果exp*exp*exp的其他项
|Let of（ide*exp）list*exp
|ide列表的乐趣*exp
|exp*exp列表的应用
;;
（**类型**）
类型类型=
|色调
|特布尔
|特查尔
|类型列表
|Tfun类型列表*类型
|通用的Tgen；；
（**辅助功能**）
让rec type_leg x=将x与
|Eint（v）->正确
|Ebool（v）->正确
|Echar（v）->正确
|空->真
|假的；；
让版次列表=
让rec aux acc=功能
|[]->acc
|h:：t->aux（h:：acc）t输入
辅助[]列表；；
（**环境**）
类型env=（ide*exp）list；；
设rho:env=[]；；
让我们插入_值（（id:ide），el）（r:env）=如果类型为_支腿（el），那么（id，el）：：r其他r；；
let rec insert letlist（rho:env）=将letlist与
|[]->rho
|hd:：tl->insert tl（insert_值hd rho）；；
让rec getExp（id:ide）（rho:env）=将rho与
|[]->（空）
|hd:：tl->如果fst（hd）=id，那么snd（hd）else getExp id tl
;;
字符串的异常类型错误；；
（**类型推断**）
让rec type_inf（e:exp）（rho:env）=将e与
|色调
|电子书（n）->t工具
|埃查尔（北）->Tchar
|空->类型_inf（Echar（'E'））rho
|反对党（v，l）->
（将（类型_inf v rho，l）与
|（t，Empty）->如果type_-inf（Empty）rho=type_-inf（Echar（'E'））rho，那么Tlist（t）else升高（TypeError“error”）
|（t，l）->如果temp=Tlist（t），则将temp=（type_inf l rho）放入，然后键入_inf l rho else raise（TypeError“Different type”））
|Den（id）->type_inf（getExp id rho）rho
|产品（e1，e2）->（将（类型\U inf e1 rho，类型\U inf e2 rho）与
|（淡色，淡色）->淡色
|_->升高（类型错误“非色调”））
|求和（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（淡色，淡色）->淡色
|_->升高（类型错误“非色调”））
|Diff（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（淡色，淡色）->淡色
|_->升高（类型错误“非色调”））
|Mod（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（淡色，淡色）->淡色
|_->升高（类型错误“非色调”））
|Div（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（淡色，淡色）->淡色
|_->升高（类型错误“非色调”））
|Lessint（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（着色，着色）->t池
|升高（类型错误“TODO”））
|Eqint（e1，e2）->（匹配（类型inf e1 rho，类型inf e2 rho）与
|（着色，着色）->t池
|升高（类型错误“TODO”））
|Iszero e1->（匹配（类型为\u inf e1 rho）与
|着色->t工具
|->raise（类型错误“”）
|Lesschar（e1，e2）->（将（类型inf e1 rho，类型inf e2 rho）与
|（Tchar，Tchar）->Tbool
|->raise（类型错误“”）
|Eqchar（e1，e2）->（将（类型inf e1 rho，类型inf e2 rho）与
|（Tchar，Tchar）->Tbool
|->raise（类型错误“”）
|或（e1，e2）->（将（类型_-inf-e1-rho，类型_-inf-e2-rho）与
|（Tbool，Tbool）->Tbool
|->raise（类型错误“”）
|和（e1，e2）->（将（类型_-inf-e1-rho，类型_-inf-e2-rho）与
|（Tbool，Tbool）->Tbool
|->raise（类型错误“”）
|非e1->（匹配（类型_inf e1 rho）与
|t冷却液->冷却液
|上升（类型错误“cis”））
|Ifthenelse（g，e1，e2）->（将（类型inf g rho，类型inf e1 rho，类型inf e2 rho）与
|（b，exp1，exp2）当exp1=exp2&&b=Tbool->exp1
|_->raise（类型错误“error”））
|Let（l，ex）->type_inf ex（插入l rho）
|Fun（l，ex）->Tfun（getTypeFun l[]，type\u inf ex rho）
|应用（ex，l）->类型\u inf ex rho
和getTypeFun l temp=将l与匹配
[]->rev temp
|hd:：tl->if type_leg（Den（hd））然后getTypeFun tl（（type_inf（Den（hd））rho）：：temp）
else gettypefuntl（（Tgen（A））：：temp）；；
（**SEM_**）
让rec sem_eager（e:exp）（rho:env）=将e与
|Eint（n）-