104 lines
3.2 KiB
OCaml
104 lines
3.2 KiB
OCaml
exception Exc of string
|
|
|
|
(* File calc.ml *)
|
|
let rec ast_to_string ast = match ast with
|
|
| Ast.Leaf s -> s
|
|
| Ast.Int i -> string_of_int i
|
|
| Ast.Node ls -> "[" ^ String.concat " " (List.map ast_to_string ls) ^ "]"
|
|
;;
|
|
|
|
(**environment for the interpreter*)
|
|
class environment =
|
|
object (self)
|
|
val mutable tbl : (string, int) Hashtbl.t = Hashtbl.create 10
|
|
method add_val key data = Hashtbl.add tbl key data
|
|
method get_val key = Hashtbl.find tbl key
|
|
method get_tbl = tbl
|
|
end;;
|
|
|
|
|
|
|
|
|
|
(** interpreter for interp_int*)
|
|
class interp_int =
|
|
object (self)
|
|
method interp (env : environment) code = match code with
|
|
| Ast.Int x -> x
|
|
| Ast.Node [Ast.Leaf "+"; lhs; rhs] ->
|
|
let x1 = self#interp env lhs in
|
|
let x2 = self#interp env rhs in
|
|
x1+x2
|
|
| Ast.Node [Ast.Leaf "-"; lhs; rhs] ->
|
|
let x1 = self#interp env lhs in
|
|
let x2 = self#interp env rhs in
|
|
x1-x2
|
|
| Ast.Node [Ast.Leaf "-"; x] ->
|
|
let x1 = self#interp env x in
|
|
0-x1
|
|
| Ast.Node [Ast.Leaf "%apply" ; Ast.Leaf "read"; Ast.Int 0] ->
|
|
let input = read_int_opt () in
|
|
match input with
|
|
| Some(y) -> y
|
|
| _ -> raise (Exc "input invalid number")
|
|
| _ -> raise (Exc "unsupported")
|
|
end;;
|
|
|
|
(** interpreter for interp_var*)
|
|
class interp_var =
|
|
object (self)
|
|
inherit interp_int as super
|
|
method interp (env : environment) code = match code with
|
|
| Ast.Leaf var -> env#get_val var
|
|
| Ast.Node [Ast.Leaf "%let"; Ast.Node[typ; Ast.Leaf var; data]; body] ->
|
|
let new_val = self#interp env data in
|
|
let _ = env#add_val var new_val in
|
|
self#interp env body
|
|
|
|
| _ -> super#interp env code
|
|
end;;
|
|
|
|
let prime_op = ["+"; "-"];;
|
|
|
|
(** PASS1 : uniquify the variable*)
|
|
let rec uniquify_var_pass ast (tbl : (string, int) Hashtbl.t) = match ast with
|
|
| Ast.Int x -> ast
|
|
| Ast.Leaf var -> Ast.Leaf (var ^ "." ^ (string_of_int(Hashtbl.find tbl var)))
|
|
| Ast.Node [Ast.Leaf "-" ; x] -> Ast.Node [Ast.Leaf "-"; uniquify_var_pass x tbl]
|
|
|
|
|
|
| Ast.Node [Ast.Leaf "%let"; Ast.Node[typ; Ast.Leaf var; data]; body] ->
|
|
let _ = if not(Hashtbl.mem tbl var) then
|
|
(Hashtbl.add tbl var 0) else
|
|
Hashtbl.replace tbl var ((Hashtbl.find tbl var)+1) in
|
|
let new_var = Ast.Leaf (var ^ "." ^(string_of_int(Hashtbl.find tbl var))) in
|
|
let rhs = uniquify_var_pass data tbl in
|
|
Ast.Node [Ast.Leaf "%let"; Ast.Node[typ; new_var; rhs];
|
|
uniquify_var_pass body tbl]
|
|
| Ast.Node [Ast.Leaf op ; lhs; rhs] -> if List.mem op prime_op then
|
|
Ast.Node [Ast.Leaf op ;
|
|
uniquify_var_pass lhs tbl;
|
|
uniquify_var_pass rhs tbl] else
|
|
Ast.Node [uniquify_var_pass (Ast.Leaf op) tbl;
|
|
uniquify_var_pass lhs tbl;
|
|
uniquify_var_pass rhs tbl]
|
|
| _ -> ast
|
|
|
|
|
|
|
|
(**main body*)
|
|
let _ =
|
|
try
|
|
let lexbuf = Lexing.from_channel stdin in
|
|
let env = new environment in
|
|
let interp = new interp_var in
|
|
while true do
|
|
let hasht = (Hashtbl.create 10) in
|
|
let result = Parser.main Lexer.token lexbuf in
|
|
let result2 = uniquify_var_pass result hasht in
|
|
Printf.printf "%s\n" (ast_to_string result2);
|
|
Printf.printf "%d" (interp#interp env result2); print_newline(); flush stdout
|
|
done
|
|
with Lexer.Eof ->
|
|
exit 0
|
|
|
|
|