HCoop / bpt / coccinelle.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Release coccinelle-0.1.8
[bpt/coccinelle.git] / parsing_c / pretty_print_c.ml
CommitLineData
0708f913
C		 1(* Yoann Padioleau, Julia Lawall
2 *
3 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU
34e49164
C		 4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License (GPL)
7 * version 2 as published by the Free Software Foundation.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * file license.txt for more details.
13 *)
14open Common
15
708f4980 16
34e49164
C		 17open Ast_c
18
708f4980
C		 19(*****************************************************************************)
20(* Wrappers *)
21(*****************************************************************************)
22let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_unparsing
23
24(*****************************************************************************)
113803cf 25
34e49164
C		 26type pr_elem_func = Ast_c.info -> unit
27type pr_space_func = unit -> unit
113803cf
C		 28type pr_nl_func = unit -> unit
29type pr_indent_func = unit -> unit
30type pr_outdent_func = unit -> unit
31type pr_unindent_func = unit -> unit
32
33type expression_printer = Ast_c.expression -> unit
34type arg_list_printer = Ast_c.argument Ast_c.wrap2 list -> unit
35type statement_printer = Ast_c.statement -> unit
36type declaration_printer = Ast_c.declaration -> unit
37type initialiser_printer = Ast_c.initialiser -> unit
38type param_printer = Ast_c.parameterType -> unit
39type type_printer = Ast_c.fullType -> unit
40type type_with_ident_printer =
41 (string * Ast_c.info) option ->
42 (Ast_c.storage * Ast_c.il) option -> Ast_c.fullType ->
43 Ast_c.attribute list -> unit
44type toplevel_printer = Ast_c.toplevel -> unit
45type flow_printer = Control_flow_c.node -> unit
46
47(* result type *)
48type pretty_printers =
49 {expression : expression_printer;
50 arg_list : arg_list_printer;
51 statement : statement_printer;
52 decl : declaration_printer;
53 init : initialiser_printer;
54 param : param_printer;
55 ty : type_printer;
56 type_with_ident : type_with_ident_printer;
57 toplevel : toplevel_printer;
58 flow : flow_printer}
34e49164 59
485bce71
C		 60module F = Control_flow_c
61
34e49164
C		 62(*****************************************************************************)
63
64(* This module is used by unparse_c, but because unparse_c have also
113803cf 65 * the list of tokens, pretty_print_c could be useless in the future
34e49164
C		 66 * (except that the ast_c have some fake tokens not present in the list
67 * of tokens so it's still useful). But this module is also useful to
68 * unparse C when you don't have the ordered list of tokens separately,
69 * or tokens without position information, for instance when you want
70 * to pretty print some piece of C that was generated, or some
71 * abstract-lined piece of code, etc. *)
72
113803cf
C		 73let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent =
74 let start_block () = pr_nl(); pr_indent() in
75 let end_block () = pr_unindent(); pr_nl() in
76
708f4980
C		 77 let indent_if_needed st f =
78 match Ast_c.unwrap_st st with
113803cf
C		 79 Compound _ -> pr_space(); f()
80 | _ ->
81 (*no newline at the end - someone else will do that*)
82 start_block(); f(); pr_unindent() in
83
34e49164
C		 84 let rec pp_expression = fun ((exp, typ), ii) ->
85 (match exp, ii with
b1b2de81 86 | Ident (ident), [] -> pp_name ident
34e49164 87 (* only a MultiString can have multiple ii *)
0708f913 88 | Constant (MultiString _), is -> is +> List.iter pr_elem
34e49164
C		 89 | Constant (c), [i] -> pr_elem i
90 | FunCall (e, es), [i1;i2] ->
91 pp_expression e; pr_elem i1;
113803cf 92 pp_arg_list es;
34e49164
C		 93 pr_elem i2;
94
95 | CondExpr (e1, e2, e3), [i1;i2] ->
96 pp_expression e1; pr_space(); pr_elem i1; pr_space();
97 do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2;
98 pp_expression e3
99 | Sequence (e1, e2), [i] ->
100 pp_expression e1; pr_elem i; pr_space(); pp_expression e2
101 | Assignment (e1, op, e2), [i] ->
102 pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
103
104 | Postfix (e, op), [i] -> pp_expression e; pr_elem i;
105 | Infix (e, op), [i] -> pr_elem i; pp_expression e;
106 | Unary (e, op), [i] -> pr_elem i; pp_expression e
107 | Binary (e1, op, e2), [i] ->
108 pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
109
110 | ArrayAccess (e1, e2), [i1;i2] ->
111 pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2
b1b2de81
C		 112 | RecordAccess (e, name), [i1] ->
113 pp_expression e; pr_elem i1; pp_name name;
114 | RecordPtAccess (e, name), [i1] ->
115 pp_expression e; pr_elem i1; pp_name name;
113803cf 116
34e49164
C		 117 | SizeOfExpr (e), [i] -> pr_elem i; pp_expression e
118 | SizeOfType (t), [i1;i2;i3] ->
113803cf 119 pr_elem i1; pr_elem i2; pp_type t; pr_elem i3
34e49164 120 | Cast (t, e), [i1;i2] ->
113803cf
C		 121 pr_elem i1; pp_type t; pr_elem i2; pp_expression e
122
34e49164
C		 123 | StatementExpr (statxs, [ii1;ii2]), [i1;i2] ->
124 pr_elem i1;
125 pr_elem ii1;
113803cf 126 statxs +> List.iter pp_statement_seq;
34e49164
C		 127 pr_elem ii2;
128 pr_elem i2;
129 | Constructor (t, xs), lp::rp::i1::i2::iicommaopt ->
130 pr_elem lp;
113803cf 131 pp_type t;
34e49164
C		 132 pr_elem rp;
133 pr_elem i1;
134 xs +> List.iter (fun (x, ii) ->
135 assert (List.length ii <= 1);
136 ii +> List.iter (function x -> pr_elem x; pr_space());
113803cf 137 pp_init x
34e49164
C		 138 );
139 iicommaopt +> List.iter pr_elem;
140 pr_elem i2;
113803cf 141
34e49164 142 | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2;
113803cf 143
34e49164 144 | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_)
113803cf
C		 145 | Sequence (_,_)
146 | Assignment (_,_,_)
147 | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_)
148 | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_)
149 | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_)
150 | StatementExpr (_) | Constructor _
151 | ParenExpr (_)),_ -> raise Impossible
34e49164 152 );
113803cf 153
34e49164
C		 154 if !Flag_parsing_c.pretty_print_type_info
155 then begin
156 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*");
157 !typ +>
158 (fun (ty,_test) -> ty +>
113803cf
C		 159 Common.do_option
160 (fun (x,l) -> pp_type x;
161 let s = match l with
162 Ast_c.LocalVar _ -> ", local"
163 | _ -> "" in
164 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s)));
34e49164
C		 165 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/");
166 end
113803cf
C		 167
168 and pp_arg_list es =
169 es +> List.iter (fun (e, opt) ->
170 assert (List.length opt <= 1); (* opt must be a comma? *)
171 opt +> List.iter (function x -> pr_elem x; pr_space());
172 pp_argument e)
173
174 and pp_argument argument =
175 let rec pp_action (ActMisc ii) = ii +> List.iter pr_elem in
176 match argument with
177 | Left e -> pp_expression e
0708f913
C		 178 | Right weird ->
179 (match weird with
113803cf
C		 180 | ArgType param -> pp_param param
181 | ArgAction action -> pp_action action)
182
b1b2de81
C		 183(* ---------------------- *)
184 and pp_name = function
185 | RegularName (s, ii) ->
186 let (i1) = Common.tuple_of_list1 ii in
187 pr_elem i1
188 | CppConcatenatedName xs ->
189 xs +> List.iter (fun ((x,ii1), ii2) ->
190 ii2 +> List.iter pr_elem;
191 ii1 +> List.iter pr_elem;
192 )
193 | CppVariadicName (s, ii) ->
194 ii +> List.iter pr_elem
195 | CppIdentBuilder ((s,iis), xs) ->
196 let (iis, iop, icp) = Common.tuple_of_list3 iis in
197 pr_elem iis;
198 pr_elem iop;
199 xs +> List.iter (fun ((x,iix), iicomma) ->
200 iicomma +> List.iter pr_elem;
201 iix +> List.iter pr_elem;
202 );
203 pr_elem icp
204
34e49164 205(* ---------------------- *)
708f4980
C		 206 and pp_statement = fun st ->
207 match Ast_c.get_st_and_ii st with
b1b2de81
C		 208 | Labeled (Label (name, st)), ii ->
209 let (i2) = Common.tuple_of_list1 ii in
210 pr_outdent(); pp_name name; pr_elem i2; pr_nl(); pp_statement st
34e49164 211 | Labeled (Case (e, st)), [i1;i2] ->
113803cf
C		 212 pr_unindent();
213 pr_elem i1; pp_expression e; pr_elem i2; pr_nl(); pr_indent();
214 pp_statement st
34e49164 215 | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] ->
113803cf 216 pr_unindent();
34e49164 217 pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3;
113803cf 218 pr_nl(); pr_indent();
34e49164 219 pp_statement st
113803cf
C		 220 | Labeled (Default st), [i1;i2] ->
221 pr_unindent(); pr_elem i1; pr_elem i2; pr_nl(); pr_indent();
222 pp_statement st
34e49164 223 | Compound statxs, [i1;i2] ->
113803cf
C		 224 pr_elem i1; start_block();
225 statxs +> Common.print_between pr_nl pp_statement_seq;
226 end_block(); pr_elem i2;
34e49164
C		 227
228 | ExprStatement (None), [i] -> pr_elem i;
229 | ExprStatement (None), [] -> ()
230 | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i
231 (* the last ExprStatement of a for does not have a trailing
232 ';' hence the [] for ii *)
233 | ExprStatement (Some e), [] -> pp_expression e;
234 | Selection (If (e, st1, st2)), i1::i2::i3::is ->
113803cf
C		 235 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
236 indent_if_needed st1 (function _ -> pp_statement st1);
708f4980 237 (match (Ast_c.get_st_and_ii st2, is) with
34e49164
C		 238 | ((ExprStatement None, []), []) -> ()
239 | ((ExprStatement None, []), [iifakend]) -> pr_elem iifakend
708f4980 240 | _st2, [i4;iifakend] -> pr_elem i4;
113803cf
C		 241 indent_if_needed st2 (function _ -> pp_statement st2);
242 pr_elem iifakend
34e49164
C		 243 | x -> raise Impossible
244 )
245 | Selection (Switch (e, st)), [i1;i2;i3;iifakend] ->
113803cf
C		 246 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
247 indent_if_needed st (function _-> pp_statement st); pr_elem iifakend
34e49164 248 | Iteration (While (e, st)), [i1;i2;i3;iifakend] ->
113803cf
C		 249 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
250 indent_if_needed st (function _-> pp_statement st); pr_elem iifakend
34e49164 251 | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] ->
113803cf
C		 252 pr_elem i1;
253 indent_if_needed st (function _ -> pp_statement st);
254 pr_elem i2; pr_elem i3; pp_expression e;
34e49164
C		 255 pr_elem i4; pr_elem i5;
256 pr_elem iifakend
257
258
259 | Iteration (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)),
260 [i1;i2;i3;iifakend] ->
113803cf
C		 261
262 pr_elem i1; pr_space();
263 pr_elem i2;
708f4980
C		 264 pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1);
265 pp_statement (Ast_c.mk_st (ExprStatement e2opt) il2);
113803cf 266 assert (null il3);
708f4980 267 pp_statement (Ast_c.mk_st (ExprStatement e3opt) il3);
113803cf
C		 268 pr_elem i3;
269 indent_if_needed st (function _ -> pp_statement st);
270 pr_elem iifakend
271
34e49164 272 | Iteration (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] ->
113803cf 273 pr_elem i1; pr_space();
34e49164 274 pr_elem i2;
113803cf 275
34e49164
C		 276 es +> List.iter (fun (e, opt) ->
277 assert (List.length opt <= 1);
278 opt +> List.iter pr_elem;
113803cf 279 pp_argument e;
34e49164 280 );
113803cf 281
34e49164 282 pr_elem i3;
113803cf 283 indent_if_needed st (function _ -> pp_statement st);
34e49164
C		 284 pr_elem iifakend
285
b1b2de81
C		 286 | Jump (Goto name), ii ->
287 let (i1, i3) = Common.tuple_of_list2 ii in
288 pr_elem i1; pr_space(); pp_name name; pr_elem i3;
34e49164
C		 289 | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2;
290 | Jump (ReturnExpr e), [i1;i2] ->
291 pr_elem i1; pr_space(); pp_expression e; pr_elem i2
292 | Jump (GotoComputed e), [i1;i2;i3] ->
293 pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3
113803cf
C		 294
295 | Decl decl, [] -> pp_decl decl
34e49164
C		 296 | Asm asmbody, ii ->
297 (match ii with
298 | [iasm;iopar;icpar;iptvirg] ->
299 pr_elem iasm; pr_elem iopar;
113803cf 300 pp_asmbody asmbody;
34e49164
C		 301 pr_elem icpar; pr_elem iptvirg
302 | [iasm;ivolatile;iopar;icpar;iptvirg] ->
303 pr_elem iasm; pr_elem ivolatile; pr_elem iopar;
113803cf 304 pp_asmbody asmbody;
34e49164
C		 305 pr_elem icpar; pr_elem iptvirg
306 | _ -> raise Impossible
307 )
113803cf 308
34e49164
C		 309 | NestedFunc def, ii ->
310 assert (null ii);
113803cf 311 pp_def def
34e49164
C		 312 | MacroStmt, ii ->
313 ii +> List.iter pr_elem ;
113803cf 314
b1b2de81 315 | (Labeled (Case (_,_))
113803cf
C		 316 | Labeled (CaseRange (_,_,_)) | Labeled (Default _)
317 | Compound _ | ExprStatement _
318 | Selection (If (_, _, _)) | Selection (Switch (_, _))
319 | Iteration (While (_, _)) | Iteration (DoWhile (_, _))
320 | Iteration (For ((_,_), (_,_), (_, _), _))
321 | Iteration (MacroIteration (_,_,_))
b1b2de81 322 | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _)
113803cf
C		 323 | Jump (GotoComputed _)
324 | Decl _
325 ), _ -> raise Impossible
326
327 and pp_statement_seq = function
328 | StmtElem st -> pp_statement st
329 | IfdefStmt ifdef -> pp_ifdef ifdef
330 | CppDirectiveStmt cpp -> pp_directive cpp
331 | IfdefStmt2 (ifdef, xxs) -> pp_ifdef_tree_sequence ifdef xxs
332
485bce71 333(* ifdef XXX elsif YYY elsif ZZZ endif *)
113803cf
C		 334 and pp_ifdef_tree_sequence ifdef xxs =
335 match ifdef with
336 | if1::ifxs ->
337 pp_ifdef if1;
338 pp_ifdef_tree_sequence_aux ifxs xxs
339 | _ -> raise Impossible
340
485bce71 341(* XXX elsif YYY elsif ZZZ endif *)
113803cf
C		 342 and pp_ifdef_tree_sequence_aux ifdefs xxs =
343 Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) ->
344 xs +> List.iter pp_statement_seq;
345 pp_ifdef ifdef
346 )
347
348
349
350
351
485bce71 352(* ---------------------- *)
113803cf
C		 353 and pp_asmbody (string_list, colon_list) =
354 string_list +> List.iter pr_elem ;
355 colon_list +> List.iter (fun (Colon xs, ii) ->
356 ii +> List.iter pr_elem;
357 xs +> List.iter (fun (x,iicomma) ->
358 assert ((List.length iicomma) <= 1);
359 iicomma +> List.iter (function x -> pr_elem x; pr_space());
360 (match x with
361 | ColonMisc, ii -> ii +> List.iter pr_elem;
362 | ColonExpr e, [istring;iopar;icpar] ->
363 pr_elem istring;
364 pr_elem iopar;
365 pp_expression e;
366 pr_elem icpar
367 | (ColonExpr _), _ -> raise Impossible)
368 ))
369
370
34e49164 371(* ---------------------- *)
113803cf 372
485bce71 373(*
113803cf
C		 374 pp_type_with_ident
375 pp_base_type
376 pp_type_with_ident_rest
377 pp_type_left
378 pp_type_right
379 pp_type
380
381 pp_decl
485bce71 382*)
113803cf
C		 383 and (pp_type_with_ident:
384 (string * info) option -> (storage * il) option ->
385 fullType -> attribute list ->
386 unit) =
708f4980
C		 387 fun ident sto ft attrs ->
388 pp_base_type ft sto;
389 (match (ident, Ast_c.unwrap_typeC ft) with
113803cf
C		 390 (Some _,_) | (_,Pointer _) -> pr_space()
391 | _ -> ());
708f4980 392 pp_type_with_ident_rest ident ft attrs
113803cf
C		 393
394
395 and (pp_base_type: fullType -> (storage * il) option -> unit) =
396 fun (qu, (ty, iity)) sto ->
397 let get_sto sto =
398 match sto with
399 | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis
400 in
401 let print_sto_qu (sto, (qu, iiqu)) =
402 let all_ii = get_sto sto ++ iiqu in
403 all_ii
34e49164 404 +> List.sort Ast_c.compare_pos
113803cf 405 +> Common.print_between pr_space pr_elem
34e49164 406
113803cf
C		 407 in
408 let print_sto_qu_ty (sto, (qu, iiqu), iity) =
409 let all_ii = get_sto sto ++ iiqu ++ iity in
410 let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in
411
412 if all_ii <> all_ii2
413 then begin
34e49164
C		 414 (* TODO in fact for pointer, the qualifier is after the type
415 * cf -test strangeorder
416 *)
113803cf
C		 417 pr2 "STRANGEORDER";
418 all_ii2 +> Common.print_between pr_space pr_elem
419 end
420 else all_ii2 +> Common.print_between pr_space pr_elem
421 in
422
423 match ty, iity with
424 | (Pointer t, [i]) -> pp_base_type t sto
425 | (ParenType t, _) -> pp_base_type t sto
426 | (Array (eopt, t), [i1;i2]) -> pp_base_type t sto
427 | (FunctionType (returnt, paramst), [i1;i2]) ->
428 pp_base_type returnt sto
429
430
431 | (StructUnion (su, sopt, fields),iis) ->
432 print_sto_qu (sto, qu);
433
434 (match sopt,iis with
435 | Some s , [i1;i2;i3;i4] ->
436 pr_elem i1; pr_elem i2; pr_elem i3;
437 | None, [i1;i2;i3] ->
438 pr_elem i1; pr_elem i2;
439 | x -> raise Impossible
440 );
441
442 fields +> List.iter
708f4980 443 (fun (field) ->
113803cf 444
708f4980 445 match field with
113803cf
C		 446 | DeclarationField(FieldDeclList(onefield_multivars,iiptvirg))->
447 (match onefield_multivars with
448 | x::xs ->
449 (* handling the first var. Special case, with the
450 first var, we print the whole type *)
451
452 (match x with
b1b2de81 453 | (Simple (nameopt, typ)), iivirg ->
113803cf 454 (* first var cant have a preceding ',' *)
b1b2de81 455 assert (List.length iivirg =|= 0);
113803cf 456 let identinfo =
b1b2de81
C		 457 match nameopt with
458 | None -> None
708f4980 459 | Some name -> Some (get_s_and_info_of_name name)
b1b2de81 460 in
113803cf
C		 461 pp_type_with_ident identinfo None typ Ast_c.noattr;
462
b1b2de81 463 | (BitField (nameopt, typ, iidot, expr)), iivirg ->
34e49164 464 (* first var cant have a preceding ',' *)
b1b2de81
C		 465 assert (List.length iivirg =|= 0);
466 (match nameopt with
467 | None ->
113803cf 468 pp_type typ;
b1b2de81 469 | Some name ->
708f4980 470 let (s, is) = get_s_and_info_of_name name in
113803cf
C		 471 pp_type_with_ident
472 (Some (s, is)) None typ Ast_c.noattr;
b1b2de81
C		 473 );
474 pr_elem iidot;
475 pp_expression expr
476
477 ); (* match x, first onefield_multivars *)
113803cf 478
708f4980 479 (* for other vars *)
113803cf 480 xs +> List.iter (function
b1b2de81 481 | (Simple (nameopt, typ)), iivirg ->
113803cf
C		 482 iivirg +> List.iter pr_elem;
483 let identinfo =
b1b2de81
C		 484 match nameopt with
485 | None -> None
708f4980 486 | Some name -> Some (get_s_and_info_of_name name)
113803cf
C		 487 in
488 pp_type_with_ident_rest identinfo typ Ast_c.noattr
489
b1b2de81 490 | (BitField (nameopt, typ, iidot, expr)), iivirg ->
113803cf 491 iivirg +> List.iter pr_elem;
b1b2de81
C		 492 (match nameopt with
493 | Some name ->
708f4980 494 let (s,is) = get_s_and_info_of_name name in
113803cf
C		 495 pp_type_with_ident_rest
496 (Some (s, is)) typ Ast_c.noattr;
b1b2de81 497 pr_elem iidot;
113803cf
C		 498 pp_expression expr
499 | x -> raise Impossible
500 )); (* iter other vars *)
501
502 | [] -> raise Impossible
503 ); (* onefield_multivars *)
b1b2de81 504 assert (List.length iiptvirg =|= 1);
113803cf
C		 505 iiptvirg +> List.iter pr_elem;
506
507
708f4980
C		 508 | MacroDeclField ((s, es), ii) ->
509 let (iis, lp, rp, iiend, ifakestart) =
510 Common.tuple_of_list5 ii in
511 (* iis::lp::rp::iiend::ifakestart::iisto
512 iisto +> List.iter pr_elem; (* static and const *)
513 *)
514 pr_elem ifakestart;
515 pr_elem iis;
516 pr_elem lp;
517 es +> List.iter (fun (e, opt) ->
518 assert (List.length opt <= 1);
519 opt +> List.iter pr_elem;
520 pp_argument e;
521 );
522
523 pr_elem rp;
524 pr_elem iiend;
525
113803cf
C		 526
527
708f4980
C		 528 | EmptyField iipttvirg_when_emptyfield ->
529 pr_elem iipttvirg_when_emptyfield
113803cf
C		 530
531 | CppDirectiveStruct cpp -> pp_directive cpp
532 | IfdefStruct ifdef -> pp_ifdef ifdef
533 );
534
535 (match sopt,iis with
536 | Some s , [i1;i2;i3;i4] -> pr_elem i4
537 | None, [i1;i2;i3] -> pr_elem i3;
538 | x -> raise Impossible
539 );
540
541
542
543 | (Enum (sopt, enumt), iis) ->
544 print_sto_qu (sto, qu);
545
546 (match sopt, iis with
547 | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) ->
548 pr_elem i1; pr_elem i2; pr_elem i3;
549 | (None, ([i1;i2;i3]|[i1;i2;i3;_])) ->
550 pr_elem i1; pr_elem i2
551 | x -> raise Impossible
552 );
553
b1b2de81 554 enumt +> List.iter (fun ((name, eopt), iicomma) ->
113803cf
C		 555 assert (List.length iicomma <= 1);
556 iicomma +> List.iter (function x -> pr_elem x; pr_space());
b1b2de81
C		 557 pp_name name;
558 eopt +> Common.do_option (fun (ieq, e) ->
559 pr_elem ieq;
560 pp_expression e;
113803cf
C		 561 ));
562
563 (match sopt, iis with
564 | (Some s, [i1;i2;i3;i4]) -> pr_elem i4
565 | (Some s, [i1;i2;i3;i4;i5]) ->
566 pr_elem i5; pr_elem i4 (* trailing comma *)
567 | (None, [i1;i2;i3]) -> pr_elem i3
568 | (None, [i1;i2;i3;i4]) ->
569 pr_elem i4; pr_elem i3 (* trailing comma *)
570
571
572 | x -> raise Impossible
573 );
574
575
576 | (BaseType _, iis) ->
577 print_sto_qu_ty (sto, qu, iis);
578
579 | (StructUnionName (s, structunion), iis) ->
b1b2de81 580 assert (List.length iis =|= 2);
113803cf
C		 581 print_sto_qu_ty (sto, qu, iis);
582
583 | (EnumName s, iis) ->
b1b2de81 584 assert (List.length iis =|= 2);
113803cf
C		 585 print_sto_qu_ty (sto, qu, iis);
586
708f4980 587 | (TypeName (name,typ), noii) ->
b1b2de81 588 assert (null noii);
708f4980 589 let (_s, iis) = get_s_and_info_of_name name in
b1b2de81 590 print_sto_qu_ty (sto, qu, [iis]);
708f4980
C		 591
592 if !Flag_parsing_c.pretty_print_typedef_value
593 then begin
594 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "{*");
595 typ +> Common.do_option (fun typ ->
596 pp_type typ;
597 );
598 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*}");
599 end;
113803cf
C		 600
601 | (TypeOfExpr (e), iis) ->
602 print_sto_qu (sto, qu);
603 (match iis with
604 | [itypeof;iopar;icpar] ->
605 pr_elem itypeof; pr_elem iopar;
606 pp_expression e;
607 pr_elem icpar;
608 | _ -> raise Impossible
609 )
610
611 | (TypeOfType (t), iis) ->
612 print_sto_qu (sto, qu);
613 (match iis with
614 | [itypeof;iopar;icpar] ->
615 pr_elem itypeof; pr_elem iopar;
616 pp_type t;
617 pr_elem icpar;
618 | _ -> raise Impossible
619 )
620
621 | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _
485bce71
C		 622 (* | StructUnion _ | Enum _ | BaseType _ *)
623 (* | StructUnionName _ | EnumName _ | TypeName _ *)
624 (* | TypeOfExpr _ | TypeOfType _ *)
113803cf
C		 625 ), _ -> raise Impossible
626
627
628
34e49164
C		 629(* used because of DeclList, in int i,*j[23]; we dont print anymore the
630 int before *j *)
113803cf
C		 631 and (pp_type_with_ident_rest: (string * info) option ->
632 fullType -> attribute list -> unit) =
633
485bce71 634 fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs ->
708f4980 635
485bce71
C		 636 let print_ident ident = Common.do_option (fun (s, iis) ->
637 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
638 pr_elem iis
113803cf 639 ) ident
34e49164 640 in
113803cf 641
34e49164
C		 642 match ty, iity with
643 (* the work is to do in base_type !! *)
644 | (BaseType _, iis) -> print_ident ident
645 | (Enum (sopt, enumt), iis) -> print_ident ident
646 | (StructUnion (_, sopt, fields),iis) -> print_ident ident
647 | (StructUnionName (s, structunion), iis) -> print_ident ident
648 | (EnumName s, iis) -> print_ident ident
b1b2de81 649 | (TypeName (_name,_typ), iis) -> print_ident ident
34e49164
C		 650 | (TypeOfExpr (e), iis) -> print_ident ident
651 | (TypeOfType (e), iis) -> print_ident ident
113803cf
C		 652
653
654
34e49164
C		 655 | (Pointer t, [i]) ->
656 (* subtil: void ( *done)(int i) is a Pointer
657 (FunctionType (return=void, params=int i) *)
658 (*WRONG I THINK, use left & right function *)
659 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
660 pr_elem i;
661 iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
113803cf
C		 662 pp_type_with_ident_rest ident t attrs;
663
34e49164 664 (* ugly special case ... todo? maybe sufficient in practice *)
708f4980
C		 665 | (ParenType ttop, [i1;i2]) ->
666 (match Ast_c.get_ty_and_ii ttop with
667 | (_q1, (Pointer t2, [ipointer])) ->
668 (match Ast_c.get_ty_and_ii t2 with
669 | (q2, (FunctionType t, ii3)) ->
670
671 pp_type_left (q2, mk_tybis (FunctionType t) ii3);
672 pr_elem i1;
673 pr_elem ipointer;
674 print_ident ident;
675 pr_elem i2;
676 pp_type_right (q2, mk_tybis (FunctionType t) ii3);
677 | _ ->
678 pr2 "PB PARENTYPE ZARB, I forget about the ()";
679 pp_type_with_ident_rest ident ttop attrs;
680 )
681 (* another ugly special case *)
682 | _q1, (Array (eopt,t2 ), [iarray1;iarray2]) ->
683 (match Ast_c.get_ty_and_ii t2 with
684 | (_q2, (Pointer t3, [ipointer])) ->
685 (match Ast_c.get_ty_and_ii t3 with
686 | (q3, (FunctionType t, iifunc)) ->
687
688 pp_type_left (q3, mk_tybis (FunctionType t) iifunc);
689 pr_elem i1;
690 pr_elem ipointer;
691 print_ident ident;
692 pr_elem iarray1;
693 do_option pp_expression eopt;
694 pr_elem iarray2;
695 pr_elem i2;
696 pp_type_right (q3, mk_tybis (FunctionType t) iifunc)
697 | _ ->
698 pr2 "PB PARENTYPE ZARB, I forget about the ()";
699 pp_type_with_ident_rest ident ttop attrs;
700 )
701 | _ ->
702 pr2 "PB PARENTYPE ZARB, I forget about the ()";
703 pp_type_with_ident_rest ident ttop attrs;
704 )
705 | _t ->
706
707 pr2 "PB PARENTYPE ZARB, I forget about the ()";
708 pp_type_with_ident_rest ident ttop attrs;
709 )
34e49164 710
113803cf 711
34e49164 712 | (Array (eopt, t), [i1;i2]) ->
113803cf
C		 713 pp_type_left fullt;
714
34e49164
C		 715 iiqu +> List.iter pr_elem;
716 print_ident ident;
113803cf
C		 717
718 pp_type_right fullt;
719
720
34e49164 721 | (FunctionType (returnt, paramst), [i1;i2]) ->
113803cf
C		 722 pp_type_left fullt;
723
34e49164
C		 724 iiqu +> List.iter pr_elem;
725 print_ident ident;
113803cf
C		 726
727 pp_type_right fullt;
34e49164 728
113803cf
C		 729
730 | (FunctionType _ | Array _ | ParenType _ | Pointer _), _ ->
731 raise Impossible
732
733
734 and (pp_type_left: fullType -> unit) =
735 fun ((qu, iiqu), (ty, iity)) ->
34e49164
C		 736 match ty, iity with
737 | (Pointer t, [i]) ->
738 pr_elem i;
739 iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
740 pp_type_left t
113803cf 741
34e49164
C		 742 | (Array (eopt, t), [i1;i2]) -> pp_type_left t
743 | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt
113803cf 744
34e49164 745 | (ParenType t, _) -> failwith "parenType"
113803cf
C		 746
747
34e49164
C		 748 | (BaseType _, iis) -> ()
749 | (Enum (sopt, enumt), iis) -> ()
750 | (StructUnion (_, sopt, fields),iis) -> ()
751 | (StructUnionName (s, structunion), iis) -> ()
752 | (EnumName s, iis) -> ()
b1b2de81 753 | (TypeName (_name,_typ), iis) -> ()
113803cf 754
485bce71
C		 755 | TypeOfType _, _ -> ()
756 | TypeOfExpr _, _ -> ()
113803cf
C		 757
758 | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible
485bce71 759
113803cf 760
b1b2de81
C		 761 and pp_param param =
762 let {p_namei = nameopt;
763 p_register = (b,iib);
764 p_type=t;} = param in
765
766 iib +> List.iter pr_elem;
767
768 match nameopt with
769 | None ->
770 pp_type t
771 | Some name ->
708f4980 772 let (s,i1) = get_s_and_info_of_name name in
113803cf 773 pp_type_with_ident
b1b2de81
C		 774 (Some (s, i1)) None t Ast_c.noattr
775
776
113803cf
C		 777
778
779 and pp_type_right (((qu, iiqu), (ty, iity)) : fullType) =
780 match ty, iity with
781 | (Pointer t, [i]) -> pp_type_right t
782
783 | (Array (eopt, t), [i1;i2]) ->
784 pr_elem i1;
785 eopt +> do_option pp_expression;
786 pr_elem i2;
787 pp_type_right t
788
789 | (ParenType t, _) -> failwith "parenType"
790 | (FunctionType (returnt, paramst), [i1;i2]) ->
791 pr_elem i1;
792 (match paramst with
793 | (ts, (b, iib)) ->
794 ts +> List.iter (fun (param,iicomma) ->
795 assert ((List.length iicomma) <= 1);
796 iicomma +> List.iter (function x -> pr_elem x; pr_space());
34e49164 797
113803cf
C		 798 pp_param param;
799 );
800 iib +> List.iter pr_elem;
801 );
802 pr_elem i2
803
804 | (BaseType _, iis) -> ()
805 | (Enum (sopt, enumt), iis) -> ()
806 | (StructUnion (_, sopt, fields),iis)-> ()
807 | (StructUnionName (s, structunion), iis) -> ()
808 | (EnumName s, iis) -> ()
b1b2de81 809 | (TypeName (name,_typ), iis) -> ()
113803cf
C		 810
811 | TypeOfType _, _ -> ()
812 | TypeOfExpr _, _ -> ()
813
814 | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible
815
816 and pp_type t =
817 pp_type_with_ident None None t Ast_c.noattr
818
34e49164 819(* ---------------------- *)
113803cf 820 and pp_decl = function
b1b2de81
C		 821 | DeclList ((({v_namei = var;
822 v_type = returnType;
823 v_storage = storage;
824 v_attr = attrs;
113803cf 825 },[])::xs),
b1b2de81
C		 826 iivirg::ifakestart::iisto) ->
827
828 pr_elem ifakestart;
113803cf 829
b1b2de81 830 (* old: iisto +> List.iter pr_elem; *)
113803cf 831
b1b2de81
C		 832
833 (* handling the first var. Special case, we print the whole type *)
834 (match var with
835 | Some (name, iniopt) ->
708f4980 836 let (s,iis) = get_s_and_info_of_name name in
b1b2de81
C		 837 pp_type_with_ident
838 (Some (s, iis)) (Some (storage, iisto))
839 returnType attrs;
840 iniopt +> do_option (fun (iini, init) ->
841 pr_elem iini;
842 pp_init init);
843 | None -> pp_type returnType
844 );
113803cf 845
34e49164 846 (* for other vars, we just call pp_type_with_ident_rest. *)
b1b2de81
C		 847 xs +> List.iter (function
848 | ({v_namei = Some (name, iniopt);
849 v_type = returnType;
850 v_storage = storage2;
851 v_attr = attrs;
852 }, iivirg) ->
113803cf 853
708f4980 854 let (s,iis) = get_s_and_info_of_name name in
b1b2de81
C		 855 assert (storage2 =*= storage);
856 iivirg +> List.iter pr_elem;
857 pp_type_with_ident_rest
858 (Some (s, iis)) returnType attrs;
859 iniopt +> do_option (fun (iini, init) ->
860 pr_elem iini; pp_init init
861 );
862
863
864 | x -> raise Impossible
865 );
866
867 pr_elem iivirg;
868
113803cf
C		 869 | MacroDecl ((s, es), iis::lp::rp::iiend::ifakestart::iisto) ->
870 pr_elem ifakestart;
871 iisto +> List.iter pr_elem; (* static and const *)
872 pr_elem iis;
873 pr_elem lp;
874 es +> List.iter (fun (e, opt) ->
875 assert (List.length opt <= 1);
876 opt +> List.iter pr_elem;
877 pp_argument e;
878 );
879
880 pr_elem rp;
881 pr_elem iiend;
882
883 | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible
884
885
34e49164 886(* ---------------------- *)
113803cf
C		 887and pp_init (init, iinit) =
888 match init, iinit with
889 | InitExpr e, [] -> pp_expression e;
890 | InitList xs, i1::i2::iicommaopt ->
891 pr_elem i1; start_block();
892 xs +> List.iter (fun (x, ii) ->
893 assert (List.length ii <= 1);
894 ii +> List.iter (function e -> pr_elem e; pr_nl());
895 pp_init x
896 );
897 iicommaopt +> List.iter pr_elem;
898 end_block();
899 pr_elem i2;
900
901 | InitDesignators (xs, initialiser), [i1] -> (* : *)
902 xs +> List.iter pp_designator;
903 pr_elem i1;
904 pp_init initialiser
905
34e49164 906 (* no use of '=' in the "Old" style *)
113803cf
C		 907 | InitFieldOld (string, initialiser), [i1;i2] -> (* label: in oldgcc *)
908 pr_elem i1; pr_elem i2; pp_init initialiser
909 | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *)
910 pr_elem i1; pp_expression expression; pr_elem i2;
911 pp_init initialiser
912
913 | (InitIndexOld _ | InitFieldOld _ | InitDesignators _
914 | InitList _ | InitExpr _
915 ), _ -> raise Impossible
916
917
918
919 and pp_designator = function
920 | DesignatorField (s), [i1; i2] ->
921 pr_elem i1; pr_elem i2;
922 | DesignatorIndex (expression), [i1;i2] ->
923 pr_elem i1; pp_expression expression; pr_elem i2;
924
925 | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] ->
926 pr_elem iocro; pp_expression e1; pr_elem iellipsis;
927 pp_expression e2; pr_elem iccro;
928
929 | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _
930 ), _ -> raise Impossible
931
932
485bce71 933(* ---------------------- *)
113803cf
C		 934 and pp_attributes pr_elem pr_space attrs =
935 attrs +> List.iter (fun (attr, ii) ->
936 ii +> List.iter pr_elem;
937 );
938
34e49164 939(* ---------------------- *)
113803cf
C		 940 and pp_def def =
941 let defbis, ii = def in
942 match ii with
b1b2de81
C		 943 | iifunc1::iifunc2::i1::i2::ifakestart::isto ->
944 let {f_name = name;
945 f_type = (returnt, (paramst, (b, iib)));
946 f_storage = sto;
947 f_body = statxs;
948 f_attr = attrs;
949 } = defbis
113803cf 950 in
113803cf
C		 951 pr_elem ifakestart;
952
953 pp_type_with_ident None (Some (sto, isto))
954 returnt Ast_c.noattr;
955
956 pp_attributes pr_elem pr_space attrs;
b1b2de81 957 pp_name name;
113803cf 958
113803cf
C		 959 pr_elem iifunc1;
960
34e49164
C		 961 (* not anymore, cf tests/optional_name_parameter and
962 macro_parameter_shortcut.c
113803cf
C		 963 (match paramst with
964 | [(((bool, None, t), ii_b_s), iicomma)] ->
965 assert
966 (match t with
967 | qu, (BaseType Void, ii) -> true
968 | _ -> true
969 );
970 assert (null iicomma);
971 assert (null ii_b_s);
972 pp_type_with_ident None None t
34e49164 973
113803cf
C		 974 | paramst ->
975 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
976 iicomma +> List.iter pr_elem;
977
978 (match b, s, ii_b_s with
979 | false, Some s, [i1] ->
980 pp_type_with_ident (Some (s, i1)) None t;
981 | true, Some s, [i1;i2] ->
982 pr_elem i1;
983 pp_type_with_ident (Some (s, i2)) None t;
984
34e49164 985 (* in definition we have name for params, except when f(void) *)
113803cf
C		 986 | _, None, _ -> raise Impossible
987 | false, None, [] ->
988
989 | _ -> raise Impossible
990 )));
991
34e49164
C		 992 (* normally ii represent the ",..." but it is also abused
993 with the f(void) case *)
994 (* assert (List.length iib <= 2);*)
113803cf
C		 995 iib +> List.iter pr_elem;
996
34e49164 997 *)
113803cf
C		 998 paramst +> List.iter (fun (param,iicomma) ->
999 assert ((List.length iicomma) <= 1);
1000 iicomma +> List.iter (function x -> pr_elem x; pr_space());
1001
1002 pp_param param;
1003 );
1004 iib +> List.iter pr_elem;
1005
1006
1007 pr_elem iifunc2;
1008 pr_elem i1;
1009 statxs +> List.iter pp_statement_seq;
1010 pr_elem i2;
1011 | _ -> raise Impossible
1012
1013
1014
485bce71 1015(* ---------------------- *)
113803cf
C		 1016
1017 and pp_ifdef ifdef =
1018 match ifdef with
1019 | IfdefDirective (ifdef, ii) ->
1020 List.iter pr_elem ii
1021
1022
1023 and pp_directive = function
1024 | Include {i_include = (s, ii);} ->
1025 let (i1,i2) = Common.tuple_of_list2 ii in
1026 pr_elem i1; pr_elem i2
1027 | Define ((s,ii), (defkind, defval)) ->
1028 let (idefine,iident,ieol) = Common.tuple_of_list3 ii in
1029 pr_elem idefine;
1030 pr_elem iident;
34e49164 1031
113803cf
C		 1032 let define_val = function
1033 | DefineExpr e -> pp_expression e
1034 | DefineStmt st -> pp_statement st
1035 | DefineDoWhileZero ((st,e), ii) ->
1036 (match ii with
1037 | [ido;iwhile;iopar;icpar] ->
1038 pr_elem ido;
1039 pp_statement st;
1040 pr_elem iwhile; pr_elem iopar;
1041 pp_expression e;
1042 pr_elem icpar
1043 | _ -> raise Impossible
1044 )
1045 | DefineFunction def -> pp_def def
1046
1047 | DefineType ty -> pp_type ty
1048 | DefineText (s, ii) -> List.iter pr_elem ii
1049 | DefineEmpty -> ()
1050 | DefineInit ini -> pp_init ini
1051
1052 | DefineTodo -> pr2 "DefineTodo"
1053 in
1054 (match defkind with
1055 | DefineVar -> ()
1056 | DefineFunc (params, ii) ->
1057 let (i1,i2) = tuple_of_list2 ii in
1058 pr_elem i1;
1059 params +> List.iter (fun ((s,iis), iicomma) ->
1060 assert (List.length iicomma <= 1);
1061 iicomma +> List.iter pr_elem;
1062 iis +> List.iter pr_elem;
1063 );
1064 pr_elem i2;
1065 );
1066 define_val defval;
1067 pr_elem ieol
34e49164 1068
113803cf
C		 1069 | Undef (s, ii) ->
1070 List.iter pr_elem ii
1071 | PragmaAndCo (ii) ->
1072 List.iter pr_elem ii in
1073
1074
1075
1076
1077 let pp_toplevel = function
1078 | Declaration decl -> pp_decl decl
1079 | Definition def -> pp_def def
1080
1081 | CppTop directive -> pp_directive directive
1082
1083
1084 | MacroTop (s, es, [i1;i2;i3;i4]) ->
1085 pr_elem i1;
1086 pr_elem i2;
1087 es +> List.iter (fun (e, opt) ->
1088 assert (List.length opt <= 1);
1089 opt +> List.iter pr_elem;
1090 pp_argument e;
1091 );
1092 pr_elem i3;
1093 pr_elem i4;
34e49164 1094
485bce71 1095
113803cf
C		 1096 | EmptyDef ii -> ii +> List.iter pr_elem
1097 | NotParsedCorrectly ii ->
1098 assert (List.length ii >= 1);
1099 ii +> List.iter pr_elem
1100 | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info)
1101
1102 | IfdefTop ifdefdir -> pp_ifdef ifdefdir
1103
1104 | (MacroTop _) -> raise Impossible in
1105
1106
1107
1108
1109 let pp_flow n =
1110 match F.unwrap n with
1111 | F.FunHeader ({f_name =idb;
1112 f_type = (rett, (paramst,(isvaargs,iidotsb)));
1113 f_storage = stob;
1114 f_body = body;
1115 f_attr = attrs},ii) ->
1116
1117 assert(null body);
485bce71 1118 (*
113803cf
C		 1119 iif ii;
1120 iif iidotsb;
1121 attrs +> List.iter (vk_attribute bigf);
1122 vk_type bigf rett;
1123 paramst +> List.iter (fun (param, iicomma) ->
1124 vk_param bigf param;
1125 iif iicomma;
1126 );
485bce71 1127 *)
113803cf 1128 pr2 "Def";
485bce71
C		 1129
1130
113803cf 1131 | F.Decl decl ->
485bce71 1132 (* vk_decl bigf decl *)
113803cf
C		 1133 pr2 "Decl"
1134
1135 | F.ExprStatement (st, (eopt, ii)) ->
708f4980 1136 pp_statement (Ast_c.mk_st (ExprStatement eopt) ii)
113803cf
C		 1137
1138 | F.IfHeader (_, (e,ii))
1139 | F.SwitchHeader (_, (e,ii))
1140 | F.WhileHeader (_, (e,ii))
1141 | F.DoWhileTail (e,ii) ->
485bce71 1142 (*
113803cf
C		 1143 iif ii;
1144 vk_expr bigf e
485bce71 1145 *)
113803cf
C		 1146 pr2 "XXX";
1147
1148
1149 | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
485bce71 1150 (*
113803cf
C		 1151 iif i1; iif i2; iif i3;
1152 iif ii;
1153 e1opt +> do_option (vk_expr bigf);
1154 e2opt +> do_option (vk_expr bigf);
1155 e3opt +> do_option (vk_expr bigf);
485bce71 1156 *)
113803cf
C		 1157 pr2 "XXX"
1158
1159 | F.MacroIterHeader (_s, ((s,es), ii)) ->
485bce71 1160 (*
113803cf
C		 1161 iif ii;
1162 vk_argument_list bigf es;
485bce71 1163 *)
113803cf
C		 1164 pr2 "XXX"
1165
1166
1167 | F.ReturnExpr (_st, (e,ii)) ->
485bce71 1168 (* iif ii; vk_expr bigf e*)
113803cf
C		 1169 pr2 "XXX"
1170
1171
1172 | F.Case (_st, (e,ii)) ->
91eba41f 1173 (* iif ii; vk_expr bigf e *)
113803cf 1174 pr2 "XXX"
91eba41f 1175
113803cf 1176 | F.CaseRange (_st, ((e1, e2),ii)) ->
485bce71 1177 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
113803cf
C		 1178 pr2 "XXX"
1179
1180
1181
1182 | F.CaseNode i -> ()
1183
1184 | F.DefineExpr e ->
485bce71 1185 (* vk_expr bigf e *)
113803cf
C		 1186 pr2 "XXX"
1187
1188 | F.DefineType ft ->
485bce71 1189 (* vk_type bigf ft *)
113803cf
C		 1190 pr2 "XXX"
1191
1192 | F.DefineHeader ((s,ii), (defkind)) ->
485bce71 1193 (*
113803cf
C		 1194 iif ii;
1195 vk_define_kind bigf defkind;
485bce71 1196 *)
113803cf
C		 1197 pr2 "XXX"
1198
1199
1200 | F.DefineDoWhileZeroHeader (((),ii)) ->
485bce71 1201 (* iif ii *)
113803cf
C		 1202 pr2 "XXX"
1203
1204
1205 | F.Include {i_include = (s, ii);} ->
485bce71 1206 (* iif ii; *)
113803cf
C		 1207 pr2 "XXX"
1208
1209
1210 | F.MacroTop (s, args, ii) ->
485bce71 1211 (* iif ii;
113803cf
C		 1212 vk_argument_list bigf args *)
1213 pr2 "XXX"
1214
1215
485bce71
C		 1216 | F.Break (st,((),ii)) ->
1217 (* iif ii *)
113803cf 1218 pr2 "XXX"
485bce71
C		 1219 | F.Continue (st,((),ii)) ->
1220 (* iif ii *)
113803cf 1221 pr2 "XXX"
485bce71
C		 1222 | F.Default (st,((),ii)) ->
1223 (* iif ii *)
113803cf 1224 pr2 "XXX"
485bce71
C		 1225 | F.Return (st,((),ii)) ->
1226 (* iif ii *)
113803cf 1227 pr2 "XXX"
b1b2de81 1228 | F.Goto (st, name, ((),ii)) ->
485bce71 1229 (* iif ii *)
113803cf 1230 pr2 "XXX"
b1b2de81 1231 | F.Label (st, name, ((),ii)) ->
485bce71 1232 (* iif ii *)
113803cf 1233 pr2 "XXX"
485bce71
C		 1234 | F.EndStatement iopt ->
1235 (* do_option infof iopt *)
113803cf 1236 pr2 "XXX"
485bce71
C		 1237 | F.DoHeader (st, info) ->
1238 (* infof info *)
113803cf 1239 pr2 "XXX"
485bce71
C		 1240 | F.Else info ->
1241 (* infof info *)
113803cf 1242 pr2 "XXX"
485bce71
C		 1243 | F.SeqEnd (i, info) ->
1244 (* infof info *)
113803cf 1245 pr2 "XXX"
485bce71
C		 1246 | F.SeqStart (st, i, info) ->
1247 (* infof info *)
113803cf
C		 1248 pr2 "XXX"
1249
485bce71
C		 1250 | F.MacroStmt (st, ((),ii)) ->
1251 (* iif ii *)
113803cf 1252 pr2 "XXX"
485bce71
C		 1253 | F.Asm (st, (asmbody,ii)) ->
1254 (*
113803cf
C		 1255 iif ii;
1256 vk_asmbody bigf asmbody
485bce71 1257 *)
113803cf
C		 1258 pr2 "XXX"
1259
1260
485bce71 1261 | F.IfdefHeader (info) ->
113803cf 1262 pp_ifdef info
485bce71 1263 | F.IfdefElse (info) ->
113803cf 1264 pp_ifdef info
485bce71 1265 | F.IfdefEndif (info) ->
113803cf
C		 1266 pp_ifdef info
1267
91eba41f 1268 | F.DefineTodo ->
113803cf
C		 1269 pr2 "XXX"
1270
1271
1272 | (F.TopNode|F.EndNode|
1273 F.ErrorExit|F.Exit|F.Enter|
1274 F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
1275 F.Fake) ->
1276 pr2 "YYY" in
1277
1278
1279 {expression = pp_expression;
1280 arg_list = pp_arg_list;
1281 statement = pp_statement;
1282 decl = pp_decl;
1283 init = pp_init;
1284 param = pp_param;
1285 ty = pp_type;
1286 type_with_ident = pp_type_with_ident;
1287 toplevel = pp_toplevel;
1288 flow = pp_flow}
1289
1290(*****************************************************************************)
1291
1292(* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1293let pr_elem info =
1294 let s = Ast_c.str_of_info info in
0708f913
C		 1295 if !Flag_parsing_c.pretty_print_comment_info then begin
1296 let before = !(info.comments_tag).mbefore in
1297 if not (null before) then begin
1298 pp "-->";
1299 before +> List.iter (fun (comment_like, pinfo) ->
1300 let s = pinfo.Common.str in
1301 pp s
1302 );
1303 pp "<--";
1304 end;
1305 end;
113803cf
C		 1306 pp s
1307
1308let pr_space _ = Format.print_space()
485bce71 1309
113803cf
C		 1310let pr_nl _ = ()
1311let pr_indent _ = ()
1312let pr_outdent _ = ()
1313let pr_unindent _ = ()
485bce71 1314
113803cf
C		 1315let ppc =
1316 pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent
1317
1318let pp_expression_simple = ppc.expression
1319let pp_statement_simple = ppc.statement
1320let pp_type_simple = ppc.ty
1321let pp_init_simple = ppc.init
1322let pp_toplevel_simple = ppc.toplevel
1323let pp_flow_simple = ppc.flow
485bce71 1324
113803cf
C		 1325let pp_elem_sp pr_elem pr_space =
1326 pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent
485bce71 1327
113803cf
C		 1328let pp_expression_gen pr_elem pr_space =
1329 (pp_elem_sp pr_elem pr_space).expression
485bce71 1330
113803cf
C		 1331let pp_arg_list_gen pr_elem pr_space =
1332 (pp_elem_sp pr_elem pr_space).arg_list
485bce71 1333
113803cf
C		 1334let pp_statement_gen pr_elem pr_space =
1335 (pp_elem_sp pr_elem pr_space).statement
34e49164 1336
113803cf
C		 1337let pp_decl_gen pr_elem pr_space =
1338 (pp_elem_sp pr_elem pr_space).decl
34e49164 1339
113803cf
C		 1340let pp_init_gen pr_elem pr_space =
1341 (pp_elem_sp pr_elem pr_space).init
34e49164 1342
113803cf
C		 1343let pp_param_gen pr_elem pr_space =
1344 (pp_elem_sp pr_elem pr_space).param
34e49164 1345
113803cf
C		 1346let pp_type_gen pr_elem pr_space =
1347 (pp_elem_sp pr_elem pr_space).ty
34e49164 1348
113803cf
C		 1349let pp_type_with_ident_gen pr_elem pr_space =
1350 (pp_elem_sp pr_elem pr_space).type_with_ident
34e49164 1351
113803cf
C		 1352let pp_program_gen pr_elem pr_space =
1353 (pp_elem_sp pr_elem pr_space).toplevel
485bce71 1354
91eba41f
C		 1355
1356
1357let string_of_expression e =
1358 Common.format_to_string (fun () ->
1359 pp_expression_simple e
113803cf 1360 )
708f4980
C		 1361
1362let string_of_toplevel top =
1363 Common.format_to_string (fun () ->
1364 pp_toplevel_simple top
1365 )
113803cf
C		 1366
1367let (debug_info_of_node:
1368 Ograph_extended.nodei -> Control_flow_c.cflow -> string) =
1369 fun nodei flow ->
1370 let node = flow#nodes#assoc nodei in
1371 let s = Common.format_to_string (fun () ->
1372 pp_flow_simple node
1373 ) in
1374 let pos = Lib_parsing_c.min_pinfo_of_node node in
1375 (spf "%s(n%d)--> %s" (Common.string_of_parse_info_bis pos) nodei s)
1376
Unnamed repository; edit this file 'description' to name the repository.