Created
May 12, 2021 18:05
-
-
Save gregberns/34591fdf4f727c3d3be3e2e2d5a6b62e to your computer and use it in GitHub Desktop.
OCaml AST - ToString and Evaluation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* | |
Below is OCaml code that defines an AST (based on an ML style language) and does two things: | |
* Takes the AST and prints it as a string | |
* Evaluates the AST expressions down where possible | |
Tests cover most of the functionality and some glaring edge cases | |
Note: I couldn't figure out how importing libraries worked (ounit), so I just wrote a custom assert function | |
Run it: | |
ocamlc -c main.ml && ocamlc -o main main.cmo && ./main | |
*) | |
(* | |
References: | |
https://www.cs.cornell.edu/courses/cs3110/2020fa/textbook/interp/simpl_subst_model.html | |
Let AST: https://www.cs.cornell.edu/courses/cs3110/2014sp/hw/4/doc/Ast.html | |
*) | |
type bop = | |
| Add | |
| Mult | |
| Lte | |
| And | |
| Or | |
type id = string | |
type expr = | |
| Var of string | |
| Int of int | |
| Bool of bool | |
| Binop of bop * expr * expr | |
| If of expr * expr * expr | |
| Let of id * expr * expr | |
| Err of string | |
let rec to_string e : string = match e with | |
| Var s -> s | |
| Int i -> string_of_int i | |
| Bool bool -> | |
(match bool with | |
| true -> "true" | |
| false -> "false") | |
| Binop (op, e1, e2) -> | |
let f o = match o with | |
| Add -> "+" | |
| Mult -> "*" | |
| Lte -> "<" | |
| And -> "&&" | |
| Or -> "||" | |
in | |
(to_string e1) ^ " " ^ (f op) ^ " " ^ (to_string e2) | |
| If (c, t, e) -> | |
"if " ^ (to_string c) ^ " then " ^ (to_string t) ^ " else " ^ (to_string e) | |
| Let (id, e1, e2) -> | |
"let " ^ id ^ " = " ^ (to_string e1) ^ " in " ^ (to_string e2) | |
| Err e -> e | |
;; | |
let rec replace_val v repl expr = | |
if (expr = v) then | |
repl | |
else | |
match expr with | |
| Binop (op, e1, e2) -> | |
Binop (op, (replace_val v repl e1), (replace_val v repl e2)) | |
| If (c, t, e) -> | |
If ((replace_val v repl c), (replace_val v repl t), (replace_val v repl e)) | |
| Let (id, e1, e2) -> | |
Let (id, (replace_val v repl e1), (replace_val v repl e2)) | |
| e -> e | |
;; | |
let rec eval (e: expr) : expr = match e with | |
| Var s -> Var s | |
| Int i -> Int i | |
| Bool b -> Bool b | |
| Binop (op, e1, e2) -> | |
(match ((eval e1), (eval e2)) with | |
| (Int i1, Int i2) -> | |
(match op with | |
| Add -> Int (i1 + i2) | |
| Mult -> Int (i1 * i2) | |
| Lte -> (if (i1 < i2) then (Bool true) else (Bool false)) | |
| _ -> Err ("Error - Invalid expr: " ^ (to_string (Binop (op, e1, e2)))) | |
) | |
| (Bool b1, Bool b2) -> | |
(match op with | |
| And -> (Bool (b1 && b2)) | |
| Or -> (Bool (b1 || b2)) | |
| _ -> Err ("Error - Invalid expr: " ^ (to_string (Binop (op, e1, e2)))) | |
) | |
| (Var v1, Var v2) -> Binop (op, Var v1, Var v2) | |
| (Var v1, e2) -> Binop (op, Var v1, e2) | |
| (e1, Var v2) -> Binop (op, e1, Var v2) | |
| (i, j) -> Err ("Error - Invalid expr: " ^ (to_string (Binop (op, i, j)))) | |
) | |
| If (c, t, e) -> | |
(match (eval c) with | |
| Bool b -> if b then (eval t) else (eval e) | |
| _ -> Err ("Error - Invalid if clause: " ^ (to_string (If (c, t, e)))) | |
) | |
| Let (id, e1, e2) -> | |
(* Err ("Error - Not Implemented") *) | |
let x = (eval e1) in eval (replace_val (Var id) x e2) | |
(* search e2 for (Val id) and replace it *) | |
| Err e -> Err e | |
;; | |
let assert_equal_expr (msg: string) (a: expr) (b: expr) = | |
(if a = b then | |
() | |
else | |
print_endline ("Failed Assert :: (" ^ msg); | |
print_endline ("a: " ^ (to_string a)); | |
print_endline ("a: " ^ (to_string b)); | |
() | |
);; | |
let assert_equal_str (msg: string) (a: string) (b: string) = | |
(if a = b then | |
() | |
else | |
(print_endline ("Failed Assert :: (" ^ msg ^ ")"); | |
print_endline ("a: " ^ a); | |
print_endline ("b: " ^ b); | |
()) | |
);; | |
(* replace_val v repl expr *) | |
let e = Binop (And, Var "x", Bool true);; | |
assert_equal_str "replace_val true && true" ("true && true") (to_string (replace_val (Var "x") (Bool true) e));; | |
(* | |
Refactoring/Simplification functions | |
!expr && !expr ~> expr || expr | |
Func | |
let f x = x --> Let (Var "f", Fun ("x", Var "x") | |
Option | |
List - let x = 3 in [1,2,x] | |
*) | |
(* x && y || z *) | |
let e = Binop (Or, Binop(And, Var "x", Var "y"), Var "z");; | |
assert_equal_str "x && y || z" ("x && y || z") (to_string e);; | |
assert_equal_str "eval x && y || z" ("x && y || z") (to_string (eval e));; | |
(* let x = true in x *) | |
let e = Let ("x", Bool true, Var "x");; | |
assert_equal_str "let x = true in x" ("let x = true in x") (to_string e);; | |
assert_equal_str "eval let x = true in x" ("true") (to_string (eval e));; | |
(* let x = 1 + 4 in x * 3 *) | |
let e = Let ("x", Binop (Add, Int 1, Int 4), Binop (Mult, Var "x", Int 3));; | |
assert_equal_str "let x = 1 + 4 in x * 3" ("let x = 1 + 4 in x * 3") (to_string e);; | |
assert_equal_str "eval let x = 1 + 4 in x * 3" ("15") (to_string (eval e));; | |
(* let x = true in let y = false in x && y *) | |
let e = Let ("x", Bool true, Let ("y", Bool false, Binop (And, Var "x", Var "y")));; | |
assert_equal_str "let x = true in let y = false in x && y" ("let x = true in let y = false in x && y") (to_string e);; | |
assert_equal_str "eval let x = true in let y = false in x && y" ("false") (to_string (eval e));; | |
(* if true && true then true || false else false && false *) | |
let e = If ( | |
Binop (And, Bool true, Bool true), | |
Binop (Or, Bool true, Bool false), | |
Binop (And, Bool false, Bool false));; | |
assert_equal_str "if true && true then true || false else false && false" | |
("if true && true then true || false else false && false") (to_string e);; | |
assert_equal_str "eval if true && true then true || false else false && false" ("true") (to_string (eval e));; | |
(* if true then true else false *) | |
let e = If (Bool true, Bool true, Bool false);; | |
assert_equal_str "if true then true else false" ("if true then true else false") (to_string e);; | |
assert_equal_str "eval if true then true else false" ("true") (to_string (eval e));; | |
(* if false then true else false *) | |
let e = If (Bool false, Bool true, Bool false);; | |
assert_equal_str "if false then true else false" ("if false then true else false") (to_string e);; | |
assert_equal_str "eval if false then true else false" ("false") (to_string (eval e));; | |
(* if 1 then 1 else 2 *) | |
let e = If (Int 1, Bool true, Bool false);; | |
assert_equal_str "if 1 then true else false" ("if 1 then true else false") (to_string e);; | |
assert_equal_str "eval if 1 then true else false" ("Error - Invalid if clause: if 1 then true else false") (to_string (eval e));; | |
(* if false then 1 else 2 *) | |
let e = If (Bool true, Int 1, Int 2);; | |
assert_equal_str "if true then 1 else 2" ("if true then 1 else 2") (to_string e);; | |
assert_equal_str "eval if true then 1 else 2" ("1") (to_string (eval e));; | |
(* true && true *) | |
let e = Binop (And, Bool true, Bool true);; | |
assert_equal_str "true and true" ("true && true") (to_string e);; | |
assert_equal_str "eval true and true" ("true") (to_string (eval e));; | |
(* true && true && true *) | |
let e = Binop (And, Bool true, Binop (And, Bool true, Bool true));; | |
assert_equal_str "true and true and true" ("true && true && true") (to_string e);; | |
assert_equal_str "eval true and true and true" ("true") (to_string (eval e));; | |
(* false || true *) | |
let e = Binop (Or, Bool false, Bool true);; | |
assert_equal_str "false or true" ("false || true") (to_string e);; | |
assert_equal_str "eval false or true" ("true") (to_string (eval e));; | |
(* false || false || true *) | |
let e = Binop (Or, Bool false, Binop (Or, Bool false, Bool true));; | |
assert_equal_str "false or false or true" ("false || false || true") (to_string e);; | |
assert_equal_str "eval false or false or true" ("true") (to_string (eval e));; | |
(* Error: 1 + true *) | |
let e = Binop (Add, Int 1, Bool true);; | |
assert_equal_str "1 + true" ("1 + true") (to_string e);; | |
assert_equal_str "eval 1 + true" ("Error - Invalid expr: 1 + true") (to_string (eval e));; | |
(* 1 + 2 *) | |
let e = Binop (Add, (Int 1), (Int 2));; | |
assert_equal_str "1 + 2" ("1 + 2") (to_string e);; | |
assert_equal_str "eval 1 + 2" ("3") (to_string (eval e));; | |
(* 1 < 2 *) | |
let e = Binop (Lte, (Int 1), (Int 2));; | |
assert_equal_str "1 < 2" ("1 < 2") (to_string e);; | |
assert_equal_str "eval 1 < 2" ("true") (to_string (eval e));; | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment