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
|
(*
PRETTY PRINTER
These functions enable the dumping of an AST
Used for debugging the parser.
*)
open Parser
open Typing
open Ast
let csl f l =
List.fold_left
(fun x t -> (if x = "" then "" else x ^ ", ") ^ (f t)) "" l
(* 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
| T_Void -> "void" | T_Int -> "int"
| TPoint(k) -> "*" ^ (var_type_str k)
| TClass s -> ""
| Typenull -> "NULL"
let rec expr_string e = match e.te_desc with
| TEInt(i) -> string_of_int i
| TENull -> "NULL"
| TEThis -> "this"
| TEIdent(i) -> i
| TEAssign(k, p) -> "(" ^ (expr_string k) ^ " = " ^ (expr_string p) ^ ")"
| TECallFun(i, f) -> i ^ "(" ^ (csl expr_string f) ^ ")"
(* ici, le second ast a changé par rapport au premier *)
| TEUnary(e, f) -> (unop_str e) ^ (expr_string f)
| TEBinary(e1, o, e2) -> "(" ^ (expr_string e1) ^ " " ^ (binop_str o) ^ " " ^ (expr_string e2) ^ ")"
(* | TEMember(e1, x) -> "(" ^ (expr_string e1) ^ ")." ^ x
| TENew(c, arg) -> "new " ^ c ^ " (" ^ (csl expr_string arg) ^ ")"*)
| _ -> ""
let rec print_stmt l x =
for i = 1 to l do print_string " " done;
match x.ts_desc with
| TSEmpty -> print_string ";\n"
| TSExpr(e) -> print_string ((expr_string e) ^ "\n")
| TSIf(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
| TSWhile(e, a) -> print_string ("while " ^ (expr_string e) ^ "\n");
print_stmt (l+1) a;
| TSFor(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
| TSBlock(b) -> print_block l b
| TSReturn(None) -> print_string "return\n"
| TSReturn(Some k) -> print_string ("return " ^ (expr_string k) ^ "\n")
| TSDeclare((ty,b), i) -> let addr = (if b then "&" else "") in
print_string (addr ^ i ^ " : " ^ (var_type_str ty) ^ "\n")
| TSDeclareAssignExpr((ty,b), i, e) -> let addr = (if b then "&" else "") in
print_string (addr ^ i ^ " : " ^ (var_type_str ty) ^ " = " ^ (expr_string e) ^ "\n")
| TSDeclareAssignConstructor(t, i, _, c, a) -> () (*print_string
(i ^ " : " ^ (var_type_str t) ^ " = " ^ c ^ "(" ^
(csl expr_string a) ^ ")\n")*)
| TSWriteCout(k) -> print_string ("std::cout" ^
(List.fold_left (fun x k -> x ^ " << " ^ (match k with
| TSEExpr e -> expr_string e
| TSEStr("\n") -> "std::endl"
| TSEStr s -> "`" ^ s ^ "`")) "" k) ^ "\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 =
(match p.tp_class with | Some c -> c ^ "::" | None -> "") ^ p.tp_name
^ " (" ^ (csl
(fun ((ty,b), i) -> let addr = (if b then "&" else "") in
addr ^ i ^ " : " ^ (var_type_str ty)
)
p.tp_args)
^ ") : " ^ (match p.tp_ret_type with | Some (ty,b) -> var_type_str ty | None -> "constructor")
(*let print_class_decl c =
print_string ("class " ^ c.c_name ^
(match c.c_supers with | None -> "" | Some(s) -> " : " ^
(List.fold_left (fun x t -> x ^ " public " ^ t) "" s)) ^ " {\n");
List.iter (function
| CVar(t, i) -> print_string (" " ^ i ^ " : " ^ (var_type_str t) ^ "\n")
| CMethod(p) -> print_string (" " ^ (proto_str p) ^ "\n")
| CVirtualMethod(p) -> print_string (" virtual " ^ (proto_str p) ^ "\n")
) c.c_members;
print_string "}\n"*)
let print_prog p =
List.iter (function
| TDGlobal(ty,i) ->
print_string ("decl " ^ i ^ " : " ^ (var_type_str ty) ^ "\n")
| TDFunction(p,b) -> print_string (proto_str p ^"\n");
print_block 0 b
| TDClass(c) -> () (* print_class_decl c *)
)
p.prog_decls
|
