ocaml的EVAL從類型功能

Question

HI定義，我有以下定義類型，並嘗試給eval函數爲例：

let evn =[("z1",Int 0);("x",Int 1);("y",Int 2);("z",Int 3);("z1",Int 4)];; 
val evn : (string * Nano.value) list = [("z1", Int 0); ("x", Int 1); ("y", Int 2); ("z", Int 3); ("z1", Int 4)] 
# let e1 =Bin(Bin(Var "x",Plus,Var "y"), Minus, Bin(Var "z",Plus,Var "z1"));; 
val e1 : Nano.expr = Bin (Bin (Var "x", Plus, Var "y"), Minus, Bin (Var "z", Plus, Var "z1")) 
# eval (evn,e1);; 
- : Nano.value = Int 0 
# eval (evn,Var "p");; 
Exception: Nano.MLFailure "Variable not bound: p". 

不知何故，我得到了在第二倉匹配一個誤差修改的eval函數說： 該模式匹配類型爲expr 的值，但預期匹配 int選項的值的模式* int選項

類型binop = Plus |減| | Mul | DIV

type expr = Const of int   
| Var of string     
| Bin of expr * binop * expr  

type value = Int of int  

type env = (string * value) list 

這裏是節目：

exception MLFailure of string 

type binop = 
    Plus 
| Minus 
| Mul 
| Div 
| Eq 
| Ne 
| Lt 
| Le 
| And 
| Or   
| Cons 

type expr = 
    Const of int 
| True 
| False  
| NilExpr 
| Var of string  
| Bin of expr * binop * expr 
| If of expr * expr * expr 
| Let of string * expr * expr 
| App of expr * expr 
| Fun of string * expr  
| Letrec of string * expr * expr 

type value = 
    Int of int   
| Bool of bool   
| Closure of env * string option * string * expr 
| Nil      
| Pair of value * value  

and env = (string * value) list 

let binopToString op = 
    match op with 
     Plus -> "+" 
    | Minus -> "-" 
    | Mul -> "*" 
    | Div -> "/" 
    | Eq -> "=" 
    | Ne -> "!=" 
    | Lt -> "<" 
    | Le -> "<=" 
    | And -> "&&" 
    | Or -> "||" 
    | Cons -> "::" 

let rec valueToString v = 
    match v with 
    Int i -> 
     Printf.sprintf "%d" i 
    | Bool b -> 
     Printf.sprintf "%b" b 
    | Closure (evn,fo,x,e) -> 
     let fs = match fo with None -> "Anon" | Some fs -> fs in 
     Printf.sprintf "{%s,%s,%s,%s}" (envToString evn) fs x (exprToString e) 
    | Pair (v1,v2) -> 
     Printf.sprintf "(%s::%s)" (valueToString v1) (valueToString v2) 
    | Nil -> 
     "[]" 

and envToString evn = 
    let xs = List.map (fun (x,v) -> Printf.sprintf "%s:%s" x (valueToString v)) evn in 
    "["^(String.concat ";" xs)^"]" 

and exprToString e = 
    match e with 
     Const i -> 
     Printf.sprintf "%d" i 
    | True -> 
     "true" 
    | False -> 
     "false" 
    | Var x -> 
     x 
    | Bin (e1,op,e2) -> 
     Printf.sprintf "%s %s %s" 
     (exprToString e1) (binopToString op) (exprToString e2) 
    | If (e1,e2,e3) -> 
     Printf.sprintf "if %s then %s else %s" 
     (exprToString e1) (exprToString e2) (exprToString e3) 
    | Let (x,e1,e2) -> 
     Printf.sprintf "let %s = %s in \n %s" 
     x (exprToString e1) (exprToString e2) 
    | App (e1,e2) -> 
     Printf.sprintf "(%s %s)" (exprToString e1) (exprToString e2) 
    | Fun (x,e) -> 
     Printf.sprintf "fun %s -> %s" x (exprToString e) 
    | Letrec (x,e1,e2) -> 
     Printf.sprintf "let rec %s = %s in \n %s" 
     x (exprToString e1) (exprToString e2) 

let rec fold f base args = 
    match args with [] -> base 
    | h::t -> fold f (f(base,h)) t 

let listAssoc (k,l) = 
    fold (fun (r,(t,v)) -> if r = None && k=t then Some v else r) None l 


let lookup (x,evn) = 
    let n = listAssoc (x,evn) in 
    match n with 
    | None -> raise (MLFailure x) 
    | Some x -> x 

let rec eval (evn,e) = match e with 
    | Const i -> Some i 
    | Var v -> lookup (v,evn) 

    | Bin(e1, Plus, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
          | (Some a, Some b) -> Some (a + b) 
          | (Some c, None) -> raise (MLFailure c) 
          | (None, Some a) -> raise (MLFailure a) 
(here is the where the erro causing *) 
    | Bin(e1, Div, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
          | (Some a, Some b) -> Some (a/b) 
          | (Some c, None) -> raise (MLFailure c) 
          | (None, Some a) -> raise (MLFailure a) 

     | Bin(e1, Minus, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
          | (Some a, Some b) -> Some (a - b) 
          | (Some c, None) -> raise (MLFailure c) 
          | (None, Some a) -> raise (MLFailure a) 

     | Bin(e1, Mul, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
          | (Some a, Some b) -> Some (a * b) 
          | (Some c, None) -> raise (MLFailure c) 
          | (None, Some a) -> raise (MLFailure a) 

Answer 1

小心，嵌套match-with不要忘記添加begin-end語句。這就是爲什麼你有這個錯誤。

let rec eval (evn,e) = match e with 
    | Const i -> Some i 
    | Var v -> lookup (v,evn) 

    | Bin(e1, Plus, e2) -> 
     begin match (eval (evn,e1), eval (evn,e2)) with 
       | (Some a, Some b) -> Some (a + b) 
       | (Some c, None) -> raise (MLFailure c) 
       | (None, Some a) -> raise (MLFailure a) 
     end 
    | Bin(e1, Div, e2) -> 
     begin match (eval (evn,e1), eval (evn,e2)) with 
       | (Some a, Some b) -> Some (a/b) 
       | (Some c, None) -> raise (MLFailure c) 
       | (None, Some a) -> raise (MLFailure a) 
     end 

    | Bin(e1, Minus, e2) -> 
     begin match (eval (evn,e1), eval (evn,e2)) with 
       | (Some a, Some b) -> Some (a - b) 
       | (Some c, None) -> raise (MLFailure c) 
       | (None, Some a) -> raise (MLFailure a) 
     end 
    | Bin(e1, Mul, e2) -> 
     begin match (eval (evn,e1), eval (evn,e2)) with 
       | (Some a, Some b) -> Some (a * b) 
       | (Some c, None) -> raise (MLFailure c) 
       | (None, Some a) -> raise (MLFailure a) 
     end 

如果你不這樣做，它就像你寫如下：

let rec eval (evn,e) = match e with 
    | Const i -> Some i 
    | Var v -> lookup (v,evn) 

    | Bin(e1, Plus, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
       | (Some a, Some b) -> Some (a + b) 
       | (Some c, None) -> raise (MLFailure c) 
       | (None, Some a) -> raise (MLFailure a) 
       | Bin(e1, Div, e2) -> match (eval (evn,e1), eval (evn,e2)) with 
         | (Some a, Some b) -> Some (a/b) 
         | (Some c, None) -> raise (MLFailure c) 
         | (None, Some a) -> raise (MLFailure a) 
         | Bin(e1, Minus, e2) -> (* ... *)