From: Tan Kian-ting Date: Mon, 25 Mar 2024 14:20:21 +0000 (+0800) Subject: add pass uniquify_var and interp_var X-Git-Url: https://git.kianting.info/?a=commitdiff_plain;h=HEAD;p=uann add pass uniquify_var and interp_var --- diff --git a/ocaml_yacc/calc.ml b/ocaml_yacc/calc.ml index edb18d4..6d5954a 100644 --- a/ocaml_yacc/calc.ml +++ b/ocaml_yacc/calc.ml @@ -7,22 +7,33 @@ let rec ast_to_string ast = match ast with | 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 x_init = +class interp_int = object (self) - val mutable x = x_init - method interp code = match code with + method interp (env : environment) code = match code with | Ast.Int x -> x | Ast.Node [Ast.Leaf "+"; lhs; rhs] -> - let x1 = self#interp lhs in - let x2 = self#interp rhs in + 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 lhs in - let x2 = self#interp rhs in + 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 x in + 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 @@ -32,6 +43,45 @@ class interp_int x_init = | _ -> 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 @@ -39,10 +89,14 @@ class interp_int x_init = let _ = try let lexbuf = Lexing.from_channel stdin in - let interp = new interp_int 0 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 - Printf.printf "%d" (interp#interp result); print_newline(); flush stdout + 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