Instructions
Objective
Write a program to fold a binary tree in order, calculate the sum of a tree, abstract syntax trees Ocaml assignment solution.
Requirements and Specifications
This is a program to fold a binary tree in order, calculate the sum of a tree, abstract syntax trees Ocaml using various tree manipulation techniques and also many abstract syntaxes.
Screenshots of output
Source Code
Eval.ml
open Ast
exception TypeError
exception UndefinedVar
exception DivByZeroError
(* Remove shadowed bindings *)
let prune_env (env : environment) : environment =
let binds = List.sort_uniq compare (List.map (fun (id, _) -> id) env) in
List.map (fun e -> (e, List.assoc e env)) binds
(* Env print function to stdout *)
let print_env_std (env : environment): unit =
List.iter (fun (var, value) ->
let vs = match value with
| Int_Val(i) -> string_of_int i
| Bool_Val(b) -> string_of_bool b in
Printf.printf "- %s => %s\n" var vs) (prune_env env)
(* Env print function to string *)
let print_env_str (env : environment): string =
List.fold_left (fun acc (var, value) ->
let vs = match value with
| Int_Val(i) -> string_of_int i
| Bool_Val(b) -> string_of_bool b in
acc ^ (Printf.sprintf "- %s => %s\n" var vs)) "" (prune_env env)
(***********************)
(****** Your Code ******)
(***********************)
(* evaluate an expression in an environment *)
let rec eval_expr (e : exp) (env : environment) : value =
let makeIOp e1 e2 f =
match (eval_expr e1 env, eval_expr e2 env) with
| (Int_Val a, Int_Val b) -> Int_Val (f a b)
| _ -> raise TypeError in
let makeBOp e1 e2 f =
match (eval_expr e1 env, eval_expr e2 env) with
| (Bool_Val a, Bool_Val b) -> Bool_Val (f a b)
| _ -> raise TypeError in
match e with
| Var s -> if List.mem_assoc s env then List.assoc s env else raise UndefinedVar
| Number n -> Int_Val n
| True -> Bool_Val true
| False -> Bool_Val false
| Plus (e1, e2) -> makeIOp e1 e2 (fun x y -> x + y)
| Minus (e1, e2) -> makeIOp e1 e2 (fun x y -> x - y)
| Times (e1, e2) -> makeIOp e1 e2 (fun x y -> x * y)
| Div (e1, e2) ->
(match (eval_expr e1 env, eval_expr e2 env) with
| (Int_Val a, Int_Val b) -> if b = 0 then raise DivByZeroError else Int_Val (a/b)
| _ -> raise TypeError)
| Mod (e1, e2) ->
(match (eval_expr e1 env, eval_expr e2 env) with
| (Int_Val a, Int_Val b) -> if b = 0 then raise DivByZeroError else Int_Val (a mod b)
| (_ , _) -> raise TypeError)
| Eq (e1, e2) ->
(match (eval_expr e1 env, eval_expr e2 env) with
| (Bool_Val a , Bool_Val b) -> Bool_Val (a=b)
| (Int_Val a, Int_Val b) -> Bool_Val (a = b)
| _ -> raise TypeError)
| Leq (e1, e2) ->
(match (eval_expr e1 env, eval_expr e2 env) with
| (Int_Val a, Int_Val b) -> Bool_Val (a <= b)
| _ -> raise TypeError)
| Lt (e1, e2) ->
(match (eval_expr e1 env, eval_expr e2 env) with
| (Int_Val a, Int_Val b) -> Bool_Val (a < b)
| _ -> raise TypeError )
| Not e1 ->
(match eval_expr e1 env with
| Bool_Val a -> Bool_Val (not a)
| _ -> raise TypeError)
| And (e1, e2) -> makeBOp e1 e2 (fun x y -> (x && y))
| Or (e1, e2) -> makeBOp e1 e2 (fun x y -> (x || y))
(* evaluate a command in an environment *)
let rec eval_command (c : com) (env : environment) : environment =
match c with
| Skip -> env
| Comp (c1, c2) -> eval_command c2 (eval_command c1 env)
| Declare (t, s) ->
(match t with
| Int_Type -> (s, Int_Val 0) :: env
| Bool_Type -> (s, Bool_Val false) :: env )
| Assg (s, e) ->
if List.mem_assoc s env then
match (List.assoc s env, eval_expr e env) with
| (Int_Val _, Int_Val x) -> (s, Int_Val x)::(List.remove_assoc s env)
| (Bool_Val _, Bool_Val x) -> (s, Bool_Val x)::(List.remove_assoc s env)
| _ -> raise TypeError
else raise UndefinedVar
| Cond (e, c1, c2) ->
(match eval_expr e env with
| Bool_Val b -> if b then eval_command c1 env else eval_command c2 env
| _ -> raise TypeError)
| While (e, c) ->
(match eval_expr e env with
| Bool_Val b -> if b then eval_command (While (e, c)) (eval_command c env) else env
| _ -> raise TypeError)
| For (e, c) ->
(match eval_expr e env with
| Int_Val n -> if n <= 0 then env else eval_command (For (Number (n - 1), c)) (eval_command c env)
| _ -> raise TypeError)
assignment.ml
open Ast
open Eval
type 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
let rec insert tree x =
match tree with
| Leaf -> Node(Leaf, x, Leaf)
| Node(l, y, r) ->
if x = y then tree
else if x < y then Node(insert l x, y, r)
else Node(l, y, insert r x)
let construct l =
List.fold_left (fun acc x -> insert acc x) Leaf l
(**********************************)
(* Problem 1: Tree In-order Fold *)
(**********************************)
let rec fold_inorder f acc t =
match t with
| Leaf -> acc
| Node (l,x,r) ->
(fold_inorder f (f (fold_inorder f acc l) x) r)
(*****************************************)
(* Problem 2: Tree Level-order Traversal *)
(*****************************************)
let levelOrder t =
let growAcc i acc = if (List.length acc) < (i + 1) then (acc@[[]]) else acc in
let rec getNodes t h acc =
match t with
| Leaf -> acc
| Node (l,x,r) ->
getNodes r (h + 1) (
getNodes l (h + 1)
(List.mapi
(fun i s -> if i = h then s@[x] else s) (growAcc h acc))) in
getNodes t 0 []
(***************************************)
(* Problem 3: Tail-recursive Tree Sum *)
(***************************************)
let rec sum_tree t =
match t with
| Leaf -> 0
| Node (l, x, r) -> sum_tree l + x + sum_tree r
let sumtailrec t =
let rec sumrec acc lst =
match lst with
| [] ->
acc
| (Leaf::tl) ->
sumrec acc tl
| ((Node (l, x, r))::tl) ->
sumrec (acc + x) (l::r::tl)
in
sumrec 0 [t]
(******************************)
(* Problem 4: Imp Interperter *)
(**** Your code in eval.ml ****)
(******************************)
(* Parse a file of Imp source code *)
let load (filename : string) : Ast.com =
let ch =
try open_in filename
with Sys_error s -> failwith ("Cannot open file: " ^ s) in
let parse : com =
try Parser.main Lexer.token (Lexing.from_channel ch)
with e ->
let msg = Printexc.to_string e
and stack = Printexc.get_backtrace () in
Printf.eprintf "there was an error: %s%s\n" msg stack;
close_in ch; failwith "Cannot parse program" in
close_in ch;
parse
(* Interpret a parsed AST with the eval_command function defined in eval.ml *)
let eval (parsed_ast : Ast.com) : environment =
let env = [] in
eval_command parsed_ast env(********)
(* Done *)
(********)
let _ = print_string ("Testing your code ...\n")
let main () =
let error_count = ref 0 in
(* Testcases for Problem 1 *)
let _ =
try
assert (fold_inorder (fun acc x -> acc @ [x]) [] (Node (Node (Leaf,1,Leaf), 2, Node (Leaf,3,Leaf))) = [1;2;3]);
assert (fold_inorder (fun acc x -> acc + x) 0 (Node (Node (Leaf,1,Leaf), 2, Node (Leaf,3,Leaf))) = 6)
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
(* Testcases for Problem 2 *)
let _ =
try
assert (levelOrder (construct [3;20;15;23;7;9]) = [[3];[20];[15;23];[7];[9]]);
assert (levelOrder (construct [41;65;20;11;50;91;29;99;32;72]) = [[41];[20;65];[11;29;50;91];[32;72;99]])
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
(* Testcases for Problem 3 *)
let _ =
try
let tree =
let rec loop tree i =
if i = 1000 then tree else loop (insert tree (Random.int 1000)) (i+1) in
loop Leaf 0 in
assert (sumtailrec tree = sum_tree tree)
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
(* Testcases for Problem 4 *)
let _ =
try
let parsed_ast = load ("programs/aexp-add.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- x => 10\n\
- y => 15\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/aexp-combined.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- w => -13\n\
- x => 1\n\
- y => 2\n\
- z => 3\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/bexp-combined.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- res1 => 1\n\
- res10 => 0\n\
- res11 => 0\n\
- res12 => 0\n\
- res13 => 1\n\
- res14 => 1\n\
- res15 => 1\n\
- res16 => 0\n\
- res2 => 0\n\
- res3 => 1\n\
- res4 => 0\n\
- res5 => 0\n\
- res6 => 1\n\
- res7 => 0\n\
- res8 => 0\n\
- res9 => 1\n\
- w => 5\n\
- x => 3\n\
- y => 5\n\
- z => -3\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/cond.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- n1 => 255\n\
- n2 => -5\n\
- res1 => 1\n\
- res2 => 255\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/fact.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- f => 120\n\
- n => 1\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/fib.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- f0 => 5\n\
- f1 => 8\n\
- k => 6\n\
- n => 5\n\
- res => 8\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/for.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- i => 101\n\
- n => 101\n\
- sum => 5151\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/palindrome.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- n => 135\n\
- res => 1\n\
- res2 => 0\n\
- reverse => 123454321\n\
- reverse2 => 531\n\
- temp => 0\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
let _ =
try
let parsed_ast = load ("programs/while.imp") in
let result = print_env_str(eval (parsed_ast)) in
assert(result =
"- n => 0\n\
- sum => 5050\n");
with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in
Printf.printf ("%d out of 12 programming questions are incorrect.\n") (!error_count)
let _ = main()