# blaise / eval.ml

 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 exception Returned of Ast.expr;; exception Not_implemented;; let int_of_bool b = if b then 1 else 0 let bool_of_int n = not (n = 0) let eval_binop op i1 i2 = match op with | "+" -> i1 + i2 | "-" -> i1 - i2 | "*" -> i1 * i2 | "/" -> i1 / i2 | ">" -> int_of_bool (i1 > i2) | "<" -> int_of_bool (i1 < i2) | "<=" -> int_of_bool (i1 <= i2) | ">=" -> int_of_bool (i1 >= i2) | "==" -> int_of_bool (i1 == i2) | "||" -> int_of_bool ((bool_of_int i1) || (bool_of_int i2)) | "&&" -> int_of_bool ((bool_of_int i1) && (bool_of_int i2)) | op -> failwith ("Unknown operator " ^ op) let eval_uniop op i = match op with | "!" -> int_of_bool (not (bool_of_int i)) | "-" -> -i | op -> failwith ("Unknown operator " ^ op) let rec get_func f = function | [] -> raise Not_found | x :: xs when x.Ast.fname = f -> x | x :: xs -> get_func f xs let rec eval_expr env lf = function | Ast.Int(n) -> n | Ast.Var(v) -> Hashtbl.find env v | Ast.BinOp(e1, op, e2) -> eval_binop op (eval_expr env lf e1) (eval_expr env lf e2) | Ast.UniOp(op, e) -> eval_uniop op (eval_expr env lf e) | Ast.Call(f, exprl) -> call_func f env lf (eval_list_expr env lf exprl) and eval_list_expr env lf = List.map (function x -> eval_expr env lf x) and eval_statement env lf = function | Ast.Assign(v, e) -> Hashtbl.replace env v (eval_expr env lf e); () | Ast.Expr(e) -> ignore (eval_expr env lf e); () | Ast.If(e, thenl, elsel) -> if bool_of_int (eval_expr env lf e) then eval_statement_list env lf thenl else eval_statement_list env lf elsel; () | Ast.While(e, stl) -> while bool_of_int (eval_expr env lf e) do eval_statement_list env lf stl done; () | Ast.Return(e) -> raise (Returned (Ast.Int (eval_expr env lf e))) and eval_statement_list env lf = function | [] -> () | st :: sts -> eval_statement env lf st; eval_statement_list env lf sts and call_func fname env lf args = match fname with | "write" -> List.iter (fun x -> print_int x; print_newline ()) args; 0 | "read" -> read_int () | s -> let f = Hashtbl.find lf s in eval_func f lf args and eval_func f lf args = let env = Hashtbl.create ((List.length args) + (List.length f.Ast.fvars)) in List.iter2 (fun x y -> Hashtbl.replace env x y) f.Ast.fparams args; try eval_statement_list env lf f.Ast.fbody; 0 with Returned(e) -> match e with | Ast.Int(i) -> i | _ -> raise Not_implemented let eval_main lf entry = let env = Hashtbl.create (List.length entry.Ast.mainvars) in eval_statement_list env lf entry.Ast.mainbody let get_functions prg = let lf = Hashtbl.create 0 in let rec add_hashtbl = function | [] -> () | x :: xs -> Hashtbl.add lf x.Ast.fname x; add_hashtbl xs in add_hashtbl prg.Ast.func; lf let eval prg = eval_main (get_functions prg) prg.Ast.main