1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
open Parser
open Ast
let token_str = function
| CLASS -> "class"
| ELSE -> "else"
| FALSE -> "false"
| FOR -> "for"
| IF -> "if"
| INT -> "int"
| NEW -> "new"
| NULL -> "NULL"
| PUBLIC -> "public"
| RETURN -> "return"
| THIS -> "this"
| TRUE -> "true"
| VIRTUAL -> "virtual"
| VOID -> "void"
| WHILE -> "while"
| IDENT(s) -> "'"^s^"'"
| TIDENT(s) -> "\""^s^"\""
| ASSIGN -> "="
| LOR -> "||"
| LAND -> "&&"
| EQ -> "=="
| NE -> "!="
| LT -> "<"
| LE -> "<="
| GT -> ">"
| GE -> ">="
| PLUS -> "+"
| MINUS -> "-"
| TIMES -> "*"
| DIV -> "/"
| MOD -> "%"
| NOT -> "!"
| INCR -> "++"
| DECR -> "--"
| REF -> "&"
(* and also : unary dereference, plus, minus *)
| LPAREN -> "("
| RPAREN -> ")"
| RARROW -> "->"
| DOT -> "."
(* OTHER SYMBOLZ *)
| SEMICOLON -> ";"
| DOUBLECOLON -> "::"
| LFLOW -> "<<"
| LBRACE -> "{"
| RBRACE -> "}"
| COMMA -> ","
| COLON -> ":"
(* DATAZ *)
| INTVAL(i) -> "#" ^ (string_of_int i)
| STRVAL(s) -> "`" ^ s ^ "`"
(* STUPIDITIEZS *)
| STD_COUT -> "std::cout"
| INCLUDE_IOSTREAM -> "#include <iostream>"
| EOF -> "end."
let print_tok t =
print_string ((token_str t) ^ "\n")
(* printing AST's *)
let binop_str = function
| Equal -> "==" | NotEqual -> "!=" | Lt -> "<" | Le -> "<="
| Gt -> ">" | Ge -> ">=" | Add -> "+" | Sub -> "-" | Mul -> "*" | Div -> "/"
| Modulo -> "%" | Land -> "&&" | Lor -> "||"
let unop_str = function
| PreIncr -> "++." | PostIncr -> ".++" | PreDecr -> "--." | PostDecr -> ".--"
| Ref -> "&" | Deref -> "&" | Not -> "!" | Minus -> "-" | Plus -> "+"
let rec var_type_str = function
| TVoid -> "void" | TInt -> "int" | TIdent(i) -> i
| TPtr(k) -> "*" ^ (var_type_str k)
| TRef(k) -> "&" ^ (var_type_str k)
let rec expr_string = function
| EInt(i) -> string_of_int i
| EBool(b) -> (if b then "true" else "false")
| ENull -> "NULL"
| EIdent(i) -> i
| EAssign(k, p) -> "(" ^ (expr_string k) ^ " = " ^ (expr_string p) ^ ")"
| ECall(e, f) -> (expr_string e) ^ "(" ^ (List.fold_left (fun x k -> x ^ ", " ^ (expr_string k)) "" f) ^ ")"
| EUnary(e, f) -> (unop_str e) ^ (expr_string f)
| EBinary(e1, o, e2) -> "(" ^ (expr_string e1) ^ " " ^ (binop_str o) ^ " " ^ (expr_string e2) ^ ")"
let rec print_stmt l x =
for i = 1 to l do print_string " " done;
match x with
| SEmpty -> print_string ";\n"
| SExpr(e) -> print_string ((expr_string e) ^ "\n")
| SIf(e, a, b) -> print_string ("if " ^ (expr_string e) ^ "\n");
print_stmt (l+1) a;
for i = 1 to l do print_string " " done;
print_string "else\n";
print_stmt (l+1) b
| SWhile(e, a) -> print_string ("while " ^ (expr_string e) ^ "\n");
print_stmt (l+1) a;
| SFor(i, c, f, s) -> print_string
("for " ^
(List.fold_left (fun x k -> x ^ ", " ^ (expr_string k)) "" i) ^ "; " ^
(match c with | None -> "" | Some(a) -> expr_string a) ^ "; " ^
(List.fold_left (fun x k -> x ^ ", " ^ (expr_string k)) "" f) ^ "\n");
print_stmt (l+1) s
| SBlock(b) -> print_block l b
| SReturn(None) -> print_string "return\n"
| SReturn(Some k) -> print_string ("return" ^ (expr_string k) ^ "\n")
| SDeclare(i, t, None) -> print_string (i ^ " : " ^ (var_type_str t) ^ "\n")
| SDeclare(i, t, Some e) -> print_string (i ^ " : " ^ (var_type_str t) ^ " = " ^ (expr_string e) ^ "\n")
and print_block n b =
let prefix = String.make n ' ' in
print_string (prefix ^ "{\n");
List.iter
(fun s -> print_stmt (n+1) s)
b;
print_string (prefix ^ "}\n")
let proto_str p =
p.p_name ^ " (" ^ (List.fold_left (fun x (i, t) -> x ^ ", " ^ i ^ " : " ^ (var_type_str t)) "" p.p_args)
^ ") : " ^ (var_type_str p.p_ret_type)
let print_prog p =
List.iter (function
| DGlobal(i, t) -> print_string ("decl " ^ i ^ " : " ^ (var_type_str t) ^ "\n")
| DFunction(p, b) -> print_string (proto_str p ^"\n");
print_block 0 b) p
|
