0

我正在尝试为 OCaml 中的解释器实现二叉树操作的扩展。扩展基本上是为了

  • {emptytree -> e2, node(id1,id2,id3) -> e3} 的 caseT e1。

为了实现扩展（emptytree、caseT、node），必须相应地扩展表示值的集合。现在变为：ExpVal = Int + Bool + ExpVal 列表 + ExpVal 树

OCaml中表示值的对应实现是：

type ’a tree = Empty | Node of ’a * ’a tree * ’a tree
type exp_val =
 | NumVal of int
 | BoolVal of bool
 | ListVal of exp_val list
 | TreeVal of exp_val tree

为此，这里是解释器的存根：

let rec eval : expr -> exp_val ea_result= fun e ->
match e with
| Int n -> return (NumVal n)
...
(*emptytree creates an empty tree*)
| EmptyTree -> 
    return @@ TreeVal (Empty)
(*creates a new tree with data e1 and left and right subtrees e2 and e3;
if the second or third argument is not a tree, it should produce an error*)
| Node (e1, lte, rte) ->
    eval_expr e1 >>= fun v1 ->
    eval_expr lte >>=
    tree_of_treeVal >>= fun v2 ->
    eval_expr rte >>=
    tree_of_treeVal >>= fun v3 ->
    return @@ TreeVal (Node (v1, v2, v3))
| CaseT (target, emptycase, id1, id2, id3, nodecase) -> 
    eval_expr target >>=
    tree_of_treeVal >>= fun t ->
    match t with
    | Empty -> eval_expr emptycase
    | Node (v1, v2, v3) ->
        let ids = [id1; id2; id3] in
        let evs = [v1; TreeVal v2; TreeVal v3] in
        eval_expr (extend_env_list ids evs) nodecase

emptytree、node 和 caseT 的示例测试用例如下：

# interp "emptytree";;
- : exp_val Proc.Ds.result = Ok (TreeVal Empty)
# interp "node(5, node(6, emptytree , emptytree), emptytree)";;
- : exp_val Proc.Ds.result =
Ok (TreeVal (Node (NumVal 5, Node (NumVal 6, Empty , Empty), Empty )))
# interp "
caseT emptytree of {
emptytree -> emptytree ,
node(a,l,r) -> l
}";;
- : exp_val Proc.Ds.result = Ok (TreeVal Empty)

该扩展的抽象语法节点如下：

type expr =
...
| EmptyTree
| Node of expr*expr*expr
| CaseT of expr*expr*string*string*string*expr

我定义了表达值“TreeVal”并使用以下方法提取 TreeVal 的值：

let tree_of_treeVal = function
| TreeVal t -> return t
| _ -> error "Expected a tree!"

此外，我已经有了一些辅助函数，如下所示：

let extend_env : string -> exp_val -> env ea_result =
  fun id v env ->
    Ok (ExtendEnv (id, v, env))

let rec extend_env_list =
  fun env ids evs ->
  match ids, evs with
  | [], [] -> Ok (env)
  | id::ids, ev::evs -> Ok (extend_env_list (extend_env env id ev) ids evs)
  | _, _ -> failwith "extend_env_list: Number of arguments does not match number of parameters!"

但是，当我运行顶层时，它会生成一个有趣的错误：

File "src/interp.ml", line 121, characters 33-48:
121 |                       eval_expr (extend_env_list ids evs) nodecase
                                       ^^^^^^^^^^^^^^^
Error: Unbound value extend_env_list

这对我来说似乎很有趣，因为该功能已经定义。在这一点上，我无法弄清楚如何处理和解决问题。有人能指出如何正确实现这个扩展吗？

Ps1 除了这里的那些东西，我还在这个interpreter.ml 的顶部加载了数据结构（ds.ml）和抽象语法树（ast.ml）文件。

Ps2 这是 ds.ml 中的样子：

(* This file defines expressed values and environments *)

(* operations on expressed values *)


type 'a tree = Empty | Node of 'a * 'a tree * 'a tree


type exp_val =
  | NumVal of int
  | BoolVal of bool
  | ProcVal of string*Ast.expr*env    
  | UnitVal
  | ListVal of exp_val list
  | TreeVal of exp_val tree
and
  env =
  | EmptyEnv
  | ExtendEnv of string*exp_val*env


  
(* Environment Abstracted Result *)

type 'a result = Ok of 'a | Error of string

type 'a ea_result = env -> 'a result
  
let return (v:'a) : 'a ea_result =
  fun _env ->
  Ok v

let error (s:string) : 'a ea_result =
  fun _env ->
  Error s

let (>>=) (c:'a ea_result) (f: 'a -> 'b ea_result) : 'b ea_result =
  fun env ->
  match c env with
  | Error err -> Error err
  | Ok v -> f v env

let (>>+) (c:env ea_result) (d:'a ea_result): 'a ea_result =
  fun env ->
  match c env with
  | Error err -> Error err
  | Ok newenv -> d newenv

let run (c:'a ea_result) : 'a result =
  c EmptyEnv

let lookup_env : env ea_result =
  fun env ->
  Ok env
  
(* Operations on environments *)

let empty_env : unit -> env ea_result =
  fun () ->
    return EmptyEnv

let extend_env : string -> exp_val -> env ea_result =
  fun id v env ->
    Ok (ExtendEnv(id,v,env))

let rec apply_env : string -> exp_val ea_result =
  fun id env ->
  match env with
  | EmptyEnv -> Error (id^" not found!")
  | ExtendEnv(v,ev,tail) ->
    if id=v
    then Ok ev
    else apply_env id tail

let rec extend_env_list =
  fun env ids evs ->
  match ids,evs with
  | [],[] -> Ok (env)
  | id::ids, ev::evs -> Ok (extend_env_list (extend_env env id ev) ids evs)
  | _,_ -> failwith "extend_env_list: Number of arguments does not match number of parameters!"


(* operations on expressed values *)

let int_of_numVal : exp_val -> int ea_result =  function
  |  NumVal n -> return n
  | _ -> error "Expected a number!"

let bool_of_boolVal : exp_val -> bool ea_result =  function
  |  BoolVal b -> return b
  | _ -> error "Expected a boolean!"

let list_of_listVal =  function
  | ListVal l -> return l
  | _ ->  error "Expected a list!"

let tree_of_treeVal =  function
  | TreeVal t -> return t
  | _ -> error "Expected a tree!"

let is_listVal = function
  | ListVal(_) -> return true
  | _ ->  return false


let rec string_of_list_of_strings = function
  | [] -> ""
  | [id] -> id
  | id::ids -> id ^ "," ^ string_of_list_of_strings ids


let string_of_expval = function
  | NumVal n -> "NumVal " ^ string_of_int n
  | BoolVal b -> "BoolVal " ^ string_of_bool b
  | UnitVal  -> "UnitVal"
  | _ -> failwith "string_of_expval: undefined"
                      
let rec string_of_env'  = function
  | EmptyEnv -> ""
  | ExtendEnv(id,v,env) -> string_of_env' env^" ("^id^","^string_of_expval v^")\n"

let string_of_env : string ea_result =
  fun env ->
  Ok ("Environment:\n"^ string_of_env' env)

let obtain_head l =
  match l with
  | [] -> failwith "Empty list!"
  | h::t -> h

let obtain_tail l =
  match l with
    | [] -> failwith "Empty list!"
    | h::t -> t
4

0 回答 0