HCoop / bpt / coccinelle.git / blob
? search:


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