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