ocaml eval函数来自类型define

时间:2013-02-15 08:15:57

标签: ocaml eval

HI我有以下定义类型,并尝试将该函数作为示例进行评估:

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函数的第二个bin匹配中得到了一个错误: 此模式匹配expr类型的值 但是预计会匹配类型值的模式 int option * int option

type binop = Plus |减去| Mul |分区

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)

1 个答案:

答案 0 :(得分:6)

小心,嵌套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) -> (* ... *)