package mopsa

  1. Overview
  2. Docs
package mopsa
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file U_ast_printer.ml

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
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
(****************************************************************************)
(*                                                                          *)
(* This file is part of MOPSA, a Modular Open Platform for Static Analysis. *)
(*                                                                          *)
(* Copyright (C) 2019 The MOPSA Project.                                    *)
(*                                                                          *)
(* This program is free software: you can redistribute it and/or modify     *)
(* it under the terms of the GNU Lesser General Public License as published *)
(* by the Free Software Foundation, either version 3 of the License, or     *)
(* (at your option) any later version.                                      *)
(*                                                                          *)
(* This program is distributed in the hope that it will be useful,          *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of           *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            *)
(* GNU Lesser General Public License for more details.                      *)
(*                                                                          *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this program.  If not, see <http://www.gnu.org/licenses/>.    *)
(*                                                                          *)
(****************************************************************************)

(**
  Pretty-printer for abstract syntax trees.
 *)

open U_ast
open Lexing


(* operators *)
(* ********* *)


let string_of_unary_op = function
  | AST_UNARY_PLUS -> "+"
  | AST_UNARY_MINUS -> "-"
  | AST_NOT -> "!"
  | AST_ROUND -> "round"

let string_of_binary_op = function
  | AST_MULTIPLY -> "*"
  | AST_DIVIDE -> "/"
  | AST_PLUS -> "+"
  | AST_MINUS -> "-"
  | AST_EQUAL -> "=="
  | AST_NOT_EQUAL -> "!="
  | AST_LESS -> "<"
  | AST_LESS_EQUAL -> "<="
  | AST_GREATER -> ">"
  | AST_GREATER_EQUAL -> ">="
  | AST_AND -> "&&"
  | AST_OR -> "||"
  | AST_CONCAT -> "^"

let print_unary_op fmt op =
  Format.pp_print_string fmt (string_of_unary_op op)

let print_binary_op fmt op =
  Format.pp_print_string fmt (string_of_binary_op op)

(* 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 ((AST_MULTIPLY | AST_DIVIDE),_,_) -> 6
  | AST_binary ((AST_PLUS | AST_MINUS),_,_) -> 5
  | _ -> 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


let print_ext pp fmt (a, _) =
  pp fmt a

(* types *)
(* ***** *)

let rec print_typ fmt t =
  match t with
  | AST_INT -> Format.pp_print_string fmt "int"
  | AST_REAL -> Format.pp_print_string fmt "real"
  | AST_ARRAY t -> Format.printf "[%a]" print_typ t
  | AST_STRING -> Format.pp_print_string fmt "string"
  | AST_CHAR -> Format.pp_print_string fmt "char"

and print_typ_opt fmt = function
  | None -> Format.pp_print_string fmt "void"
  | Some x -> print_typ fmt x

and print_typed_var fmt ((t, v), _) =
  Format.fprintf fmt "%a %a"
    print_typ t
    print_var v

(* expressions *)
(* *********** *)

and print_var fmt v =
  Format.pp_print_string fmt v

and print_var_ext fmt ve =
  print_ext print_var fmt ve

and print_expr fmt e =
  match e with
  | AST_fun_call(f, args) ->
    Format.fprintf fmt "%a(%a)"
      print_var_ext f
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",")
         print_expr_ext
      ) args

  | AST_unit_const ->
    Format.fprintf fmt "()"
  | 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 (s, _)
  | AST_real_const(s, _) -> Format.pp_print_string fmt s
  | AST_string_const(s, _) -> Format.fprintf fmt "\"%s\"" s
  | AST_bool_const(b, _) -> Format.pp_print_bool fmt b
  | AST_char_const(c, _) -> Format.fprintf fmt "\'%c\'" c
  | AST_array_const(ea, _) ->
    Format.fprintf fmt "[%a]"
      (
        Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt "; ")
          (print_expr_ext)
      )
      (Array.to_list ea)
  | AST_rand ((i1,_),(i2,_)) ->
    Format.fprintf fmt "rand(%s,%s)" i1 i2

  | AST_randf ((i1,_),(i2,_)) ->
    Format.fprintf fmt "randf(%s,%s)" i1 i2

  | AST_rand_string -> 
    Format.fprintf fmt "rand_string()"

  | AST_identifier (v,_) -> print_var fmt v

  | AST_array_access ((e1, _), (e2, _)) ->
    Format.fprintf fmt "%a[%a]"
      print_expr e1
      print_expr e2

  | AST_len (e, _) ->
    Format.fprintf fmt "|%a|"
      print_expr e

and print_expr_ext fmt (e, _) =
  print_expr fmt e

(* statements *)
(* ********** *)

and print_stat fmt = function

  | AST_block l ->
    Format.fprintf fmt "%a;"
      (Format.pp_print_list
         ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,")
         print_stat_ext
      )
      l

  | AST_assign ((e',_),(e,_)) ->
    Format.fprintf fmt "%a = %a"
      print_expr e' print_expr e

  | AST_if (e, b1, None) ->
    Format.fprintf fmt "@[<v 2>if (%a) {@,%a@,}@]"
      print_expr_ext e print_stat_ext b1

  | AST_if (e, b, Some b2) ->
    Format.fprintf fmt "@[<v 2>if (%a) {@,%a@,} else {%a@,}@]"
      print_expr_ext e print_stat_ext b
      print_stat_ext b2

  | AST_while (e, s) ->
    Format.fprintf fmt "@[<v 2>while (%a) {@,%a@,}@]"
      print_expr_ext e
      print_stat_ext s

  | AST_for (v, e, e', s) ->
    Format.fprintf fmt "@[<v 2>for %a = %a to %a {@,%a@,}@]"
      print_var_ext v
      print_expr_ext e
      print_expr_ext e'
      print_stat_ext s

  | AST_assert e ->
    Format.fprintf fmt "assert (%a)"
      print_expr_ext e

  | AST_assume e ->
    Format.fprintf fmt "assume (%a)"
      print_expr_ext e

  | AST_print ->
    Format.fprintf fmt "print ()"

  | AST_return (Some e) ->
    Format.fprintf fmt "return (%a)"
      print_expr_ext e

  | AST_return None ->
    Format.fprintf fmt "return"

  | AST_expr (e,_) ->
    Format.fprintf fmt "%a"
      print_expr e

  | AST_continue ->
    Format.pp_print_string fmt "continue"

  | AST_break ->
    Format.pp_print_string fmt "break"


and print_stat_ext fmt (s, _) =
  print_stat fmt s

and print_declaration fmt ((s, o) : declaration) =
  match o with
  | None -> print_typed_var fmt s
  | Some e -> Format.printf "%a = %a"
                print_typed_var s
                print_expr_ext e

and print_declaration_ext fmt x =
  print_ext print_declaration fmt x

and print_fundec fmt (f: fundec) =
  Format.fprintf fmt "@[<v>@[<v 2>%a %a(%a) {@,%a;@,%a;@]@,}@]"
    print_typ_opt f.return_type
    print_var f.funname
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
       print_typed_var
    ) f.parameters
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,")
       print_declaration_ext
    ) f.locvars
    print_stat_ext f.body

and print_fundec_ext fmt f =
  print_ext print_fundec fmt f
(* programs *)
(* ******** *)

let print_prog fmt p =
  Format.fprintf fmt "@[<v>%a;@,%a@,%a@]"
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,")
       print_declaration_ext
    ) p.gvars
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@,")
       print_fundec_ext
    ) p.funs
    print_stat_ext p.main
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct