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