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