Source

blaise / eval.ml

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 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.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 (Stdlib.call fname args) with
  | Some(i) -> i
  | None -> let f = Hashtbl.find lf fname 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
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.