こんにちは私は次の定義タイプを持っており、例として関数を評価しようとしています:
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関数の2番目のビンの一致でエラーが発生しました:このパターンはexpr型の値と一致しますが、int型オプション*intオプションの値と一致するパターンが期待されていました
タイプbinop=Plus | マイナス| マル| 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)