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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
(*
Cours "Sémantique et Application à la Vérification de programmes"
Antoine Miné 2014
Ecole normale supérieure, Paris, France / CNRS / INRIA
*)
(*
Pretty-printer for abstract syntax trees.
*)
open Abstract_syntax_tree
open Lexing
(* locations *)
(* ********* *)
let string_of_position p =
Printf.sprintf "%s:%i:%i" p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol)
let string_of_extent (p,q) =
if p.pos_fname = q.pos_fname then
if p.pos_lnum = q.pos_lnum then
if p.pos_cnum = q.pos_cnum then
Printf.sprintf "%s:%i.%i" p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol)
else
Printf.sprintf "%s:%i.%i-%i" p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol) (q.pos_cnum - q.pos_bol)
else
Printf.sprintf "%s:%i.%i-%i.%i" p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol) q.pos_lnum (q.pos_cnum - q.pos_bol)
else
Printf.sprintf "%s:%i.%i-%s:%i.%i" p.pos_fname p.pos_lnum (p.pos_cnum - p.pos_bol) q.pos_fname q.pos_lnum (q.pos_cnum - q.pos_bol)
(* operators *)
(* ********* *)
let string_of_unary_op = function
| AST_UNARY_PLUS -> "+"
| AST_UNARY_MINUS -> "-"
| AST_NOT -> "!"
let string_of_binary_op = function
| AST_MULTIPLY -> "*"
| AST_DIVIDE -> "/"
| AST_MODULO -> "%"
| AST_PLUS -> "+"
| AST_MINUS -> "-"
| AST_EQUAL -> "=="
| AST_NOT_EQUAL -> "!="
| AST_LESS -> "<"
| AST_LESS_EQUAL -> "<="
| AST_GREATER -> ">"
| AST_GREATER_EQUAL -> ">="
| AST_AND -> "&&"
| AST_OR -> "||"
(* higher values mean higher precedence *)
let binary_precedence = function
| AST_MULTIPLY | AST_DIVIDE | AST_MODULO -> 6
| AST_PLUS | AST_MINUS -> 5
| AST_EQUAL | AST_NOT_EQUAL -> 4
| AST_LESS | AST_LESS_EQUAL | AST_GREATER | AST_GREATER_EQUAL -> 3
| AST_AND -> 2
| AST_OR -> 1
(* precedence of the operator at the root of the expression;
this is used to avoid printing unnecessary parentheses
*)
let expr_precedence = function
| AST_unary (op, _) -> 99
| AST_binary(op, _, _) -> binary_precedence op
| _ -> 100
(* utility to print lists *)
let print_list f sep fmt l =
let rec aux = function
| [] -> ()
| [a] -> f fmt a
| a::b -> f fmt a; Format.pp_print_string fmt sep; aux b
in
aux l
(* types *)
(* ***** *)
let string_of_typ = function
| AST_TYP_INT -> "int"
| AST_TYP_BOOL -> "bool"
| AST_TYP_AUTO -> "auto"
(* expressions *)
(* *********** *)
let print_id fmt v =
Format.pp_print_string fmt v
let rec print_expr fmt e =
match e with
| AST_unary (op,(e1,_)) ->
Format.pp_print_string fmt (string_of_unary_op op);
if expr_precedence e1 <= expr_precedence e
then Format.fprintf fmt " (%a)" print_expr e1
else Format.fprintf fmt " %a" print_expr e1
| AST_binary (op,(e1,_),(e2,_)) ->
if expr_precedence e1 < expr_precedence e
then Format.fprintf fmt "(%a) " print_expr e1
else Format.fprintf fmt "%a " print_expr e1;
Format.pp_print_string fmt (string_of_binary_op op);
if expr_precedence e2 <= expr_precedence e
then Format.fprintf fmt " (%a)" print_expr e2
else Format.fprintf fmt " %a" print_expr e2
| AST_int_const (i,_) -> Format.pp_print_string fmt i
| AST_int_rand ((i1,_),(i2,_)) -> Format.fprintf fmt "rand(%s, %s)" i1 i2
| AST_bool_const b -> Format.pp_print_bool fmt b
| AST_identifier (v,_) -> print_id fmt v
| AST_expr_call ((i,_),l) ->
Format.fprintf fmt "%a(%a)"
print_id i (print_list print_expr ",") (List.map fst l)
let print_lvalue fmt v =
Format.pp_print_string fmt v
(* statements *)
(* ********** *)
let indent ind = ind^" "
(* ind is a string of spaces (indentation) to put at the begining of each line
*)
let rec print_stat ind fmt = function
| AST_block b ->
print_block ind fmt b
| AST_assign ((v,_),(e,_)) ->
Format.fprintf fmt "%s%a = %a;@\n"
ind print_lvalue v print_expr e
| AST_if ((e,_), (b1,_), None) ->
Format.fprintf fmt "%sif (%a)@\n%a"
ind print_expr e (print_stat (indent ind)) b1
| AST_if ((e,_), (b1,_), Some (b2,_)) ->
Format.fprintf fmt "%sif (%a)@\n%a%selse@\n%a"
ind print_expr e (print_stat (indent ind)) b1
ind (print_stat (indent ind)) b2
| AST_while ((e,_),(b,_)) ->
Format.fprintf fmt "%swhile (%a)@\n%a"
ind print_expr e (print_stat (indent ind)) b
| AST_assert ((e,_)) ->
Format.fprintf fmt "%sassert (%a);@\n"
ind print_expr e
| AST_print l ->
Format.fprintf fmt "%sprint (%a);@\n"
ind (print_list print_id ",") (List.map fst l)
| AST_local d ->
Format.fprintf fmt "%s%a" ind print_var_decl d
| AST_stat_call ((i,_),l) ->
Format.fprintf fmt "%s%a(%a);@\n"
ind print_id i (print_list print_expr ",") (List.map fst l)
| AST_return None ->
Format.fprintf fmt "%sreturn;@\n" ind
| AST_return (Some (e,_)) ->
Format.fprintf fmt "%sreturn %a;@\n"
ind print_expr e
| AST_BREAK ->
Format.fprintf fmt "%sbreak;@\n" ind
| AST_HALT ->
Format.fprintf fmt "%shalt;@\n" ind
| AST_label (l,_) ->
Format.fprintf fmt "%s%a:@\n" ind print_id l
| AST_goto (l,_) ->
Format.fprintf fmt "%sgoto %a;@\n" ind print_id l
and print_block ind fmt b =
Format.fprintf fmt "%s{@\n" ind;
List.iter (fun (bb,_) -> print_stat (indent ind) fmt bb) b;
Format.fprintf fmt "%s}@\n" ind
(* declarations *)
(* ************ *)
and print_var_decl fmt ((t,_),l) =
Format.fprintf fmt "%s %a;@\n"
(string_of_typ t) (print_list print_var_init ", ") l
and print_var_init fmt ((i,_),eo) =
print_id fmt i;
match eo with
| None -> ()
| Some (e,_) -> Format.fprintf fmt " = %a" print_expr e
let print_arg_decl fmt ((t,_),(i,_)) =
Format.fprintf fmt "%s %a"
(string_of_typ t) print_id i
let print_fun_decl fmt f =
Format.fprintf fmt "%s %a(%a)@\n%a"
(match fst (f.fun_typ) with None -> "void" | Some t -> string_of_typ t)
print_id (fst f.fun_name)
(print_list print_arg_decl ", ") f.fun_args
(print_block "") f.fun_body
let print_toplevel fmt = function
| AST_stat (s,_) -> print_stat "" fmt s
| AST_fun_decl (f,_) -> print_fun_decl fmt f
(* programs *)
(* ******** *)
let print_prog fmt (p,_) =
List.iter (print_toplevel fmt) p
|
