Commits

Antoine Pietri committed 05d0336

working eval.ml

  • Participants
  • Parent commits 677a81e

Comments (0)

Files changed (2)

 
 let eval file =
   let ast = get_ast file in
-  (* TODO *)
-  assert false
+  Eval.eval ast
 
 let specs =
   [
   Printf.sprintf "Usage: %s -help | -eval script | script" Sys.argv.(0)
 
 let _ =
-  Arg.parse specs pretty_print usage
+  Arg.parse specs pretty_print usage; ()
-let int_of_bool b = if b then 1 else 0
-
-and bool_of_int n = if n = 0 then 0 else 1
-
-and hashtbl_set env = raise false
+exception Returned of Ast.expr;;
+exception Not_implemented;;
 
-and 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) -> eval_func f (eval_list_expr env lf exprl)
+let int_of_bool b = if b then 1 else 0
 
-and rec eval_list_expr env lf = List.map (function x -> eval_expr env lf x)
+let bool_of_int n = not (n = 0)
 
-and eval_binop op i1 i2 = match op with
+let eval_binop op i1 i2 = match op with
   | "+"     -> i1 + i2
   | "-"     -> i1 - i2
   | "*"     -> 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)
+  | op      -> failwith ("Unknown operator " ^ op)
 
-and eval_uniop op i = match op with
-  | "!" -> int_of_bool (not bool_of_int (i))
-  | op  -> failwith ("Unknown operator " ^^ op)
+let eval_uniop op i = match op with
+  | "!" -> int_of_bool (not (bool_of_int 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 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.
+  | 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 lf args = match fname with
+  | "write" -> List.iter (function x -> Printf.printf "%d\n" x) args; 0
+  | s -> let f = List.find (function x -> s = x.Ast.fname) lf in
+      eval_func f lf args
 
 and eval_func f lf args =
-  raise false
+  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 eval prg =
+  eval_main prg.Ast.func prg.Ast.main
 
-and eval_statement_list env lf =