1 (* Yoann Padioleau, Julia Lawall
3 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
4 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU
6 * This program is free software; you can redistribute it and/or
7 * modify it under the terms of the GNU General Public License (GPL)
8 * version 2 as published by the Free Software Foundation.
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * file license.txt for more details.
19 module F
= Control_flow_c
21 (*****************************************************************************)
23 (*****************************************************************************)
24 let pr2, pr2_once
= Common.mk_pr2_wrappers
Flag_parsing_c.verbose_unparsing
26 (*****************************************************************************)
28 (*****************************************************************************)
30 type type_with_ident
=
31 (string * Ast_c.info
) option ->
32 (Ast_c.storage
* Ast_c.il
) option ->
34 Ast_c.attribute list
-> unit
36 type 'a printer
= 'a
-> unit
38 type pretty_printers
= {
39 expression
: Ast_c.expression printer
;
40 arg_list
: (Ast_c.argument
Ast_c.wrap2 list
) printer
;
41 arg
: Ast_c.argument printer
;
42 statement
: Ast_c.statement printer
;
43 decl
: Ast_c.declaration printer
;
44 field
: Ast_c.field printer
;
45 field_list
: Ast_c.field list printer
;
46 init
: Ast_c.initialiser printer
;
47 init_list
: (Ast_c.initialiser wrap2 list
) printer
;
48 param
: Ast_c.parameterType printer
;
49 paramlist
: (Ast_c.parameterType
Ast_c.wrap2 list
) printer
;
50 ty
: Ast_c.fullType printer
;
51 type_with_ident
: type_with_ident
;
52 toplevel
: Ast_c.toplevel printer
;
53 flow
: Control_flow_c.node printer
58 (*****************************************************************************)
60 (* This module is used by unparse_c, but because unparse_c have also
61 * the list of tokens, pretty_print_c could be useless in the future
62 * (except that the ast_c have some fake tokens not present in the list
63 * of tokens so it's still useful). But this module is also useful to
64 * unparse C when you don't have the ordered list of tokens separately,
65 * or tokens without position information, for instance when you want
66 * to pretty print some piece of C that was generated, or some
67 * abstract-lined piece of code, etc. *)
69 let mk_pretty_printers
71 ~pr_nl ~pr_indent ~pr_outdent ~pr_unindent
73 let start_block () = pr_nl
(); pr_indent
() in
74 let end_block () = pr_unindent
(); pr_nl
() in
76 let pr_nl_slash _ = (* multiline macro *)
77 let slash = (Ast_c.fakeInfo
() +> Ast_c.rewrap_str
" \\") in
78 pr_elem
slash; pr_nl
() in
80 let indent_if_needed st f
=
81 match Ast_c.unwrap_st st
with
82 Compound _
-> pr_space
(); f
()
84 (*no newline at the end - someone else will do that*)
85 start_block(); f
(); pr_unindent
() in
88 let pp_list printer l
=
89 l
+> List.iter
(fun (e
, opt
) ->
90 assert (List.length opt
<= 1); (* opt must be a comma? *)
91 opt
+> List.iter
(function x
-> pr_elem x
; pr_space
());
94 let rec pp_expression = fun ((exp
, typ
), ii
) ->
96 | Ident
(ident
), [] -> pp_name ident
97 (* only a MultiString can have multiple ii *)
98 | Constant
(MultiString _
), is
-> is
+> List.iter pr_elem
99 | Constant
(c
), [i
] -> pr_elem i
100 | FunCall
(e
, es
), [i1
;i2
] ->
101 pp_expression e
; pr_elem i1
;
105 | CondExpr
(e1
, e2
, e3
), [i1
;i2
] ->
106 pp_expression e1
; pr_space
(); pr_elem i1
; pr_space
();
107 do_option
(function x
-> pp_expression x
; pr_space
()) e2
; pr_elem i2
;
108 pr_space
(); pp_expression e3
109 | Sequence
(e1
, e2
), [i
] ->
110 pp_expression e1
; pr_elem i
; pr_space
(); pp_expression e2
111 | Assignment
(e1
, op
, e2
), [i
] ->
112 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
114 | Postfix
(e
, op
), [i
] -> pp_expression e
; pr_elem i
;
115 | Infix
(e
, op
), [i
] -> pr_elem i
; pp_expression e
;
116 | Unary
(e
, op
), [i
] -> pr_elem i
; pp_expression e
117 | Binary
(e1
, op
, e2
), [i
] ->
118 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
120 | ArrayAccess
(e1
, e2
), [i1
;i2
] ->
121 pp_expression e1
; pr_elem i1
; pp_expression e2
; pr_elem i2
122 | RecordAccess
(e
, name
), [i1
] ->
123 pp_expression e
; pr_elem i1
; pp_name name
;
124 | RecordPtAccess
(e
, name
), [i1
] ->
125 pp_expression e
; pr_elem i1
; pp_name name
;
127 | SizeOfExpr
(e
), [i
] ->
129 (match Ast_c.unwrap e
with
130 ParenExpr
(e
), _
-> ()
133 | SizeOfType
(t
), [i1
;i2
;i3
] ->
134 pr_elem i1
; pr_elem i2
; pp_type t
; pr_elem i3
135 | Cast
(t
, e
), [i1
;i2
] ->
136 pr_elem i1
; pp_type t
; pr_elem i2
; pp_expression e
138 | StatementExpr
(statxs
, [ii1
;ii2
]), [i1
;i2
] ->
141 statxs
+> List.iter pp_statement_seq
;
144 | Constructor
(t
, init
), [lp
;rp
] ->
150 | ParenExpr
(e
), [i1
;i2
] -> pr_elem i1
; pp_expression e
; pr_elem i2
;
152 | New
(None
, t
), [i1
] -> pr_elem i1
; pp_argument t
153 | New
(Some ts
, t
), [i1
; i2
; i3
] ->
154 pr_elem i1
; pr_elem i2
; pp_arg_list ts
; pr_elem i3
; pp_argument t
155 | Delete
(t
), [i1
] -> pr_elem i1
; pp_expression t
157 | (Ident
(_
) | Constant _
| FunCall
(_
,_
) | CondExpr
(_
,_
,_
)
160 | Postfix
(_
,_
) | Infix
(_
,_
) | Unary
(_
,_
) | Binary
(_
,_
,_
)
161 | ArrayAccess
(_
,_
) | RecordAccess
(_
,_
) | RecordPtAccess
(_
,_
)
162 | SizeOfExpr
(_
) | SizeOfType
(_
) | Cast
(_
,_
)
163 | StatementExpr
(_
) | Constructor _
164 | ParenExpr
(_
) | New
(_
) | Delete
(_
)),_
-> raise
(Impossible
95)
167 if !Flag_parsing_c.pretty_print_type_info
169 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"/*");
171 (fun (ty
,_test
) -> ty
+>
173 (fun (x
,l
) -> pp_type x
;
175 Ast_c.LocalVar _
-> ", local"
177 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
s)));
178 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*/");
181 and pp_arg_list es
= pp_list pp_argument es
183 and pp_argument argument
=
184 let rec pp_action (ActMisc ii
) = ii
+> List.iter pr_elem
in
186 | Left e
-> pp_expression e
189 | ArgType param
-> pp_param param
190 | ArgAction action
-> pp_action action
)
192 (* ---------------------- *)
193 and pp_name
= function
194 | RegularName
(s, ii
) ->
195 let (i1
) = Common.tuple_of_list1 ii
in
197 | CppConcatenatedName xs
->
198 xs
+> List.iter
(fun ((x
,ii1
), ii2
) ->
199 ii2
+> List.iter pr_elem
;
200 ii1
+> List.iter pr_elem
;
202 | CppVariadicName
(s, ii
) ->
203 ii
+> List.iter pr_elem
204 | CppIdentBuilder
((s,iis
), xs
) ->
205 let (iis
, iop
, icp
) = Common.tuple_of_list3 iis
in
208 xs
+> List.iter
(fun ((x
,iix
), iicomma
) ->
209 iicomma
+> List.iter pr_elem
;
210 iix
+> List.iter pr_elem
;
214 (* ---------------------- *)
215 and pp_statement
= fun st
->
216 match Ast_c.get_st_and_ii st
with
217 | Labeled
(Label
(name
, st
)), ii
->
218 let (i2
) = Common.tuple_of_list1 ii
in
219 pr_outdent
(); pp_name name
; pr_elem i2
; pr_nl
(); pp_statement st
220 | Labeled
(Case
(e
, st
)), [i1
;i2
] ->
222 pr_elem i1
; pp_expression e
; pr_elem i2
; pr_nl
(); pr_indent
();
224 | Labeled
(CaseRange
(e
, e2
, st
)), [i1
;i2
;i3
] ->
226 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_expression e2
; pr_elem i3
;
227 pr_nl
(); pr_indent
();
229 | Labeled
(Default st
), [i1
;i2
] ->
230 pr_unindent
(); pr_elem i1
; pr_elem i2
; pr_nl
(); pr_indent
();
232 | Compound statxs
, [i1
;i2
] ->
233 pr_elem i1
; start_block();
234 statxs
+> Common.print_between pr_nl pp_statement_seq
;
235 end_block(); pr_elem i2
;
237 | ExprStatement
(None
), [i
] -> pr_elem i
;
238 | ExprStatement
(None
), [] -> ()
239 | ExprStatement
(Some e
), [i
] -> pp_expression e
; pr_elem i
240 (* the last ExprStatement of a for does not have a trailing
241 ';' hence the [] for ii *)
242 | ExprStatement
(Some e
), [] -> pp_expression e
;
243 | Selection
(If
(e
, st1
, st2
)), i1
::i2
::i3
::is
->
244 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
245 indent_if_needed st1
(function _
-> pp_statement st1
);
246 (match (Ast_c.get_st_and_ii st2
, is
) with
247 | ((ExprStatement None
, []), []) -> ()
248 | ((ExprStatement None
, []), [iifakend
]) -> pr_elem iifakend
249 | _st2
, [i4
;iifakend
] -> pr_elem i4
;
250 indent_if_needed st2
(function _
-> pp_statement st2
);
252 | x
-> raise
(Impossible
96)
254 | Selection
(Switch
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
255 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
256 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
257 | Iteration
(While
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
258 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
259 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
260 | Iteration
(DoWhile
(st
, e
)), [i1
;i2
;i3
;i4
;i5
;iifakend
] ->
262 indent_if_needed st
(function _
-> pp_statement st
);
263 pr_elem i2
; pr_elem i3
; pp_expression e
;
264 pr_elem i4
; pr_elem i5
;
268 | Iteration
(For
(first
,(e2opt
,il2
),(e3opt
, il3
),st
)),
269 [i1
;i2
;i3
;iifakend
] ->
271 pr_elem i1
; pr_space
();
274 ForExp
(e1opt
,il1
) ->
275 pp_statement
(Ast_c.mk_st
(ExprStatement e1opt
) il1
)
276 | ForDecl decl
-> pp_decl decl
);
277 pp_statement
(Ast_c.mk_st
(ExprStatement e2opt
) il2
);
279 pp_statement
(Ast_c.mk_st
(ExprStatement e3opt
) il3
);
281 indent_if_needed st
(function _
-> pp_statement st
);
284 | Iteration
(MacroIteration
(s,es
,st
)), [i1
;i2
;i3
;iifakend
] ->
285 pr_elem i1
; pr_space
();
288 es
+> List.iter
(fun (e
, opt
) ->
289 assert (List.length opt
<= 1);
290 opt
+> List.iter pr_elem
;
295 indent_if_needed st
(function _
-> pp_statement st
);
298 | Jump
(Goto name
), ii
->
299 let (i1
, i3
) = Common.tuple_of_list2 ii
in
300 pr_elem i1
; pr_space
(); pp_name name
; pr_elem i3
;
301 | Jump
((Continue
|Break
|Return
)), [i1
;i2
] -> pr_elem i1
; pr_elem i2
;
302 | Jump
(ReturnExpr e
), [i1
;i2
] ->
303 pr_elem i1
; pr_space
(); pp_expression e
; pr_elem i2
304 | Jump
(GotoComputed e
), [i1
;i2
;i3
] ->
305 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
307 | Decl decl
, [] -> pp_decl decl
310 | [iasm
;iopar
;icpar
;iptvirg
] ->
311 pr_elem iasm
; pr_elem iopar
;
313 pr_elem icpar
; pr_elem iptvirg
314 | [iasm
;ivolatile
;iopar
;icpar
;iptvirg
] ->
315 pr_elem iasm
; pr_elem ivolatile
; pr_elem iopar
;
317 pr_elem icpar
; pr_elem iptvirg
318 | _
-> raise
(Impossible
97)
321 | NestedFunc def
, ii
->
325 ii
+> List.iter pr_elem
;
327 | (Labeled
(Case
(_
,_
))
328 | Labeled
(CaseRange
(_
,_
,_
)) | Labeled
(Default _
)
329 | Compound _
| ExprStatement _
330 | Selection
(If
(_
, _
, _
)) | Selection
(Switch
(_
, _
))
331 | Iteration
(While
(_
, _
)) | Iteration
(DoWhile
(_
, _
))
332 | Iteration
(For
(_
, (_
,_
), (_
, _
), _
))
333 | Iteration
(MacroIteration
(_
,_
,_
))
334 | Jump
((Continue
|Break
|Return
)) | Jump
(ReturnExpr _
)
335 | Jump
(GotoComputed _
)
337 ), _
-> raise
(Impossible
98)
339 and pp_statement_seq
= function
340 | StmtElem st
-> pp_statement st
341 | IfdefStmt ifdef
-> pp_ifdef ifdef
342 | CppDirectiveStmt cpp
-> pp_directive cpp
343 | IfdefStmt2
(ifdef
, xxs
) -> pp_ifdef_tree_sequence ifdef xxs
345 (* ifdef XXX elsif YYY elsif ZZZ endif *)
346 and pp_ifdef_tree_sequence ifdef xxs
=
350 pp_ifdef_tree_sequence_aux ifxs xxs
351 | _
-> raise
(Impossible
99)
353 (* XXX elsif YYY elsif ZZZ endif *)
354 and pp_ifdef_tree_sequence_aux ifdefs xxs
=
355 Common.zip ifdefs xxs
+> List.iter
(fun (ifdef
, xs
) ->
356 xs
+> List.iter pp_statement_seq
;
364 (* ---------------------- *)
365 and pp_asmbody
(string_list
, colon_list
) =
366 string_list
+> List.iter pr_elem
;
367 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
368 ii
+> List.iter pr_elem
;
369 xs
+> List.iter
(fun (x
,iicomma
) ->
370 assert ((List.length iicomma
) <= 1);
371 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
373 | ColonMisc
, ii
-> ii
+> List.iter pr_elem
;
374 | ColonExpr e
, [istring
;iopar
;icpar
] ->
379 (* the following case used to be just raise Impossible, but
380 the code __asm__ __volatile__ ("dcbz 0, %[input]"
381 ::[input]"r"(&coherence_data[i]));
382 in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *)
383 | (ColonExpr e
), ii
->
384 (match List.rev ii
with
385 icpar
::iopar
::istring
::rest
->
386 List.iter pr_elem
(List.rev rest
);
391 | _
-> raise
(Impossible
100)))
395 (* ---------------------- *)
400 pp_type_with_ident_rest
407 and (pp_type_with_ident
:
408 (string * info
) option -> (storage
* il
) option ->
409 fullType
-> attribute list
->
411 fun ident sto ft attrs
->
413 (match (ident
, Ast_c.unwrap_typeC ft
) with
414 (Some _
,_
) | (_
,Pointer _
) -> pr_space
()
416 pp_type_with_ident_rest ident ft attrs
419 and (pp_base_type
: fullType
-> (storage
* il
) option -> unit) =
420 fun (qu
, (ty
, iity
)) sto
->
423 | None
-> [] | Some
(s, iis
) -> (*assert (List.length iis = 1);*) iis
425 let print_sto_qu (sto
, (qu
, iiqu
)) =
426 let all_ii = get_sto sto
++ iiqu
in
428 +> List.sort
Ast_c.compare_pos
429 +> Common.print_between pr_space pr_elem
432 let print_sto_qu_ty (sto
, (qu
, iiqu
), iity
) =
433 let all_ii = get_sto sto
++ iiqu
++ iity
in
434 let all_ii2 = all_ii +> List.sort
Ast_c.compare_pos
in
438 (* TODO in fact for pointer, the qualifier is after the type
439 * cf -test strangeorder
442 all_ii2 +> Common.print_between pr_space pr_elem
444 else all_ii2 +> Common.print_between pr_space pr_elem
449 | (Pointer t
, [i
]) -> pp_base_type t sto
450 | (ParenType t
, _
) -> pp_base_type t sto
451 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_base_type t sto
452 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
453 pp_base_type returnt sto
;
456 | (StructUnion
(su
, sopt
, fields
),iis
) ->
457 print_sto_qu (sto
, qu
);
460 | Some
s , [i1
;i2
;i3
;i4
] ->
461 pr_elem i1
; pr_elem i2
; pr_elem i3
;
462 | None
, [i1
;i2
;i3
] ->
463 pr_elem i1
; pr_elem i2
;
464 | x
-> raise
(Impossible
101)
467 fields
+> List.iter pp_field
;
470 | Some
s , [i1
;i2
;i3
;i4
] -> pr_elem i4
471 | None
, [i1
;i2
;i3
] -> pr_elem i3
;
472 | x
-> raise
(Impossible
102)
477 | (Enum
(sopt
, enumt
), iis
) ->
478 print_sto_qu (sto
, qu
);
480 (match sopt
, iis
with
481 | (Some
s, ([i1
;i2
;i3
;i4
]|[i1
;i2
;i3
;i4
;_
])) ->
482 pr_elem i1
; pr_elem i2
; pr_elem i3
;
483 | (None
, ([i1
;i2
;i3
]|[i1
;i2
;i3
;_
])) ->
484 pr_elem i1
; pr_elem i2
485 | x
-> raise
(Impossible
103)
488 enumt
+> List.iter
(fun ((name
, eopt
), iicomma
) ->
489 assert (List.length iicomma
<= 1);
490 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
492 eopt
+> Common.do_option
(fun (ieq
, e
) ->
497 (match sopt
, iis
with
498 | (Some
s, [i1
;i2
;i3
;i4
]) -> pr_elem i4
499 | (Some
s, [i1
;i2
;i3
;i4
;i5
]) ->
500 pr_elem i5
; pr_elem i4
(* trailing comma *)
501 | (None
, [i1
;i2
;i3
]) -> pr_elem i3
502 | (None
, [i1
;i2
;i3
;i4
]) ->
503 pr_elem i4
; pr_elem i3
(* trailing comma *)
506 | x
-> raise
(Impossible
104)
510 | (BaseType _
, iis
) ->
511 print_sto_qu_ty (sto
, qu
, iis
);
513 | (StructUnionName
(s, structunion
), iis
) ->
514 assert (List.length iis
=|= 2);
515 print_sto_qu_ty (sto
, qu
, iis
);
517 | (EnumName
s, iis
) ->
518 assert (List.length iis
=|= 2);
519 print_sto_qu_ty (sto
, qu
, iis
);
521 | (TypeName
(name
,typ
), noii
) ->
523 let (_s
, iis
) = get_s_and_info_of_name name
in
524 print_sto_qu_ty (sto
, qu
, [iis
]);
526 if !Flag_parsing_c.pretty_print_typedef_value
528 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"{*");
529 typ
+> Common.do_option
(fun typ
->
532 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*}");
535 | (TypeOfExpr
(e
), iis
) ->
536 print_sto_qu (sto
, qu
);
538 | [itypeof
;iopar
;icpar
] ->
539 pr_elem itypeof
; pr_elem iopar
;
542 | _
-> raise
(Impossible
105)
545 | (TypeOfType
(t
), iis
) ->
546 print_sto_qu (sto
, qu
);
548 | [itypeof
;iopar
;icpar
] ->
549 pr_elem itypeof
; pr_elem iopar
;
552 | _
-> raise
(Impossible
106)
555 | (Pointer _
| (*ParenType _ |*) Array _
| FunctionType _
556 (* | StructUnion _ | Enum _ | BaseType _ *)
557 (* | StructUnionName _ | EnumName _ | TypeName _ *)
558 (* | TypeOfExpr _ | TypeOfType _ *)
559 ), _
-> raise
(Impossible
107)
561 and pp_field_list fields
= fields
+> Common.print_between pr_nl pp_field
562 and pp_field
= function
563 DeclarationField
(FieldDeclList
(onefield_multivars
,iiptvirg
))->
564 (match onefield_multivars
with
566 (* handling the first var. Special case, with the
567 first var, we print the whole type *)
570 (Simple
(nameopt
, typ
)), iivirg
->
571 (* first var cant have a preceding ',' *)
572 assert (List.length iivirg
=|= 0);
576 | Some name
-> Some
(get_s_and_info_of_name name
)
578 pp_type_with_ident
identinfo None typ
Ast_c.noattr
;
580 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
581 (* first var cant have a preceding ',' *)
582 assert (List.length iivirg
=|= 0);
587 let (s, is
) = get_s_and_info_of_name name
in
589 (Some
(s, is
)) None typ
Ast_c.noattr
;
594 ); (* match x, first onefield_multivars *)
597 xs
+> List.iter
(function
598 | (Simple
(nameopt
, typ
)), iivirg
->
599 iivirg
+> List.iter pr_elem
;
603 | Some name
-> Some
(get_s_and_info_of_name name
)
605 pp_type_with_ident_rest
identinfo typ
Ast_c.noattr
607 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
608 iivirg
+> List.iter pr_elem
;
611 let (s,is
) = get_s_and_info_of_name name
in
612 pp_type_with_ident_rest
613 (Some
(s, is
)) typ
Ast_c.noattr
;
617 (* was raise Impossible, but have no idea why because
618 nameless bit fields are accepted by the parser and
619 nothing seems to be done to give them names *)
622 )); (* iter other vars *)
624 | [] -> raise
(Impossible
108)
625 ); (* onefield_multivars *)
626 assert (List.length iiptvirg
=|= 1);
627 iiptvirg
+> List.iter pr_elem
;
630 | MacroDeclField
((s, es
), ii
) ->
631 let (iis
, lp
, rp
, iiend
, ifakestart
) =
632 Common.tuple_of_list5 ii
in
633 (* iis::lp::rp::iiend::ifakestart::iisto
634 iisto +> List.iter pr_elem; (* static and const *)
639 es
+> List.iter
(fun (e
, opt
) ->
640 assert (List.length opt
<= 1);
641 opt
+> List.iter pr_elem
;
650 | EmptyField iipttvirg_when_emptyfield
->
651 pr_elem iipttvirg_when_emptyfield
653 | CppDirectiveStruct cpp
-> pp_directive cpp
654 | IfdefStruct ifdef
-> pp_ifdef ifdef
656 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
658 and (pp_type_with_ident_rest
: (string * info
) option ->
659 fullType
-> attribute list
-> unit) =
661 fun ident
(((qu
, iiqu
), (ty
, iity
)) as fullt
) attrs
->
663 let print_ident ident
= Common.do_option
(fun (s, iis
) ->
664 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
670 (* the work is to do in base_type !! *)
671 | (NoType
, iis
) -> ()
672 | (BaseType _
, iis
) -> print_ident ident
673 | (Enum
(sopt
, enumt
), iis
) -> print_ident ident
674 | (StructUnion
(_
, sopt
, fields
),iis
) -> print_ident ident
675 | (StructUnionName
(s, structunion
), iis
) -> print_ident ident
676 | (EnumName
s, iis
) -> print_ident ident
677 | (TypeName
(_name
,_typ
), iis
) -> print_ident ident
678 | (TypeOfExpr
(e
), iis
) -> print_ident ident
679 | (TypeOfType
(e
), iis
) -> print_ident ident
683 | (Pointer t
, [i
]) ->
684 (* subtil: void ( *done)(int i) is a Pointer
685 (FunctionType (return=void, params=int i) *)
686 (*WRONG I THINK, use left & right function *)
687 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
689 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
690 pp_type_with_ident_rest ident t attrs
;
692 (* ugly special case ... todo? maybe sufficient in practice *)
693 | (ParenType ttop
, [i1
;i2
]) ->
694 (match Ast_c.get_ty_and_ii ttop
with
695 | (_q1
, (Pointer t2
, [ipointer
])) ->
696 (match Ast_c.get_ty_and_ii t2
with
697 | (q2
, (FunctionType t
, ii3
)) ->
699 pp_type_left
(q2
, mk_tybis
(FunctionType t
) ii3
);
704 pp_type_right
(q2
, mk_tybis
(FunctionType t
) ii3
);
706 pr2 "PB PARENTYPE ZARB, I forget about the ()";
707 pp_type_with_ident_rest ident ttop attrs
;
709 (* another ugly special case *)
710 | _q1
, (Array
(eopt
,t2
), [iarray1
;iarray2
]) ->
711 (match Ast_c.get_ty_and_ii t2
with
712 | (_q2
, (Pointer t3
, [ipointer
])) ->
713 (match Ast_c.get_ty_and_ii t3
with
714 | (q3
, (FunctionType t
, iifunc
)) ->
716 pp_type_left
(q3
, mk_tybis
(FunctionType t
) iifunc
);
721 do_option
pp_expression eopt
;
724 pp_type_right
(q3
, mk_tybis
(FunctionType t
) iifunc
)
726 pr2 "PB PARENTYPE ZARB, I forget about the ()";
727 pp_type_with_ident_rest ident ttop attrs
;
730 pr2 "PB PARENTYPE ZARB, I forget about the ()";
731 pp_type_with_ident_rest ident ttop attrs
;
735 pr2 "PB PARENTYPE ZARB, I forget about the ()";
736 pp_type_with_ident_rest ident ttop attrs
;
740 | (Array
(eopt
, t
), [i1
;i2
]) ->
743 iiqu
+> List.iter pr_elem
;
749 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
752 iiqu
+> List.iter pr_elem
;
758 | (FunctionType _
| Array _
| ParenType _
| Pointer _
), _
->
759 raise
(Impossible
109)
762 and (pp_type_left
: fullType
-> unit) =
763 fun ((qu
, iiqu
), (ty
, iity
)) ->
765 (NoType
,_
) -> failwith
"pp_type_left: unexpected NoType"
766 | (Pointer t
, [i
]) ->
768 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
771 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_type_left t
772 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) -> pp_type_left returnt
774 | (ParenType t
, _
) -> failwith
"parenType"
777 | (BaseType _
, iis
) -> ()
778 | (Enum
(sopt
, enumt
), iis
) -> ()
779 | (StructUnion
(_
, sopt
, fields
),iis
) -> ()
780 | (StructUnionName
(s, structunion
), iis
) -> ()
781 | (EnumName
s, iis
) -> ()
782 | (TypeName
(_name
,_typ
), iis
) -> ()
784 | TypeOfType _
, _
-> ()
785 | TypeOfExpr _
, _
-> ()
787 | (FunctionType _
| Array _
| Pointer _
), _
-> raise
(Impossible
110)
791 let {p_namei
= nameopt
;
792 p_register
= (b
,iib
);
793 p_type
=t
;} = param
in
795 iib
+> List.iter pr_elem
;
801 let (s,i1
) = get_s_and_info_of_name name
in
803 (Some
(s, i1
)) None t
Ast_c.noattr
808 and pp_type_right
(((qu
, iiqu
), (ty
, iity
)) : fullType
) =
810 (NoType
,_
) -> failwith
"pp_type_right: unexpected NoType"
811 | (Pointer t
, [i
]) -> pp_type_right t
813 | (Array
(eopt
, t
), [i1
;i2
]) ->
815 eopt
+> do_option
pp_expression;
819 | (ParenType t
, _
) -> failwith
"parenType"
820 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
824 ts
+> List.iter
(fun (param
,iicomma
) ->
825 assert ((List.length iicomma
) <= 1);
826 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
830 iib
+> List.iter pr_elem
;
834 | (BaseType _
, iis
) -> ()
835 | (Enum
(sopt
, enumt
), iis
) -> ()
836 | (StructUnion
(_
, sopt
, fields
),iis
)-> ()
837 | (StructUnionName
(s, structunion
), iis
) -> ()
838 | (EnumName
s, iis
) -> ()
839 | (TypeName
(name
,_typ
), iis
) -> ()
841 | TypeOfType _
, _
-> ()
842 | TypeOfExpr _
, _
-> ()
844 | (FunctionType _
| Array _
| Pointer _
), _
-> raise
(Impossible
111)
847 pp_type_with_ident None None t
Ast_c.noattr
849 (* ---------------------- *)
850 and pp_decl
= function
851 | DeclList
((({v_namei
= var
;
856 iivirg
::ifakestart
::iisto
) ->
860 (* old: iisto +> List.iter pr_elem; *)
863 (* handling the first var. Special case, we print the whole type *)
865 | Some
(name
, iniopt
) ->
866 let (s,iis
) = get_s_and_info_of_name name
in
868 (Some
(s, iis
)) (Some
(storage
, iisto
))
872 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
873 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
874 pr_elem lp
; pp_arg_list init
; pr_elem rp
875 | Ast_c.ConstrInit _
-> raise
(Impossible
112))
876 | None
-> pp_type returnType
879 (* for other vars, we just call pp_type_with_ident_rest. *)
880 xs
+> List.iter
(function
881 | ({v_namei
= Some
(name
, iniopt
);
883 v_storage
= storage2
;
887 let (s,iis
) = get_s_and_info_of_name name
in
888 assert (storage2
=*= storage
);
889 iivirg
+> List.iter pr_elem
;
890 pp_type_with_ident_rest
891 (Some
(s, iis
)) returnType attrs
;
894 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
895 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
896 pr_elem lp
; pp_arg_list init
; pr_elem rp
897 | Ast_c.ConstrInit _
-> raise
(Impossible
113));
900 | x
-> raise
(Impossible
114)
905 | MacroDecl
((s, es
, true), iis
::lp
::rp
::iiend
::ifakestart
::iisto
) ->
907 iisto
+> List.iter pr_elem
; (* static and const *)
910 es
+> List.iter
(fun (e
, opt
) ->
911 assert (List.length opt
<= 1);
912 opt
+> List.iter pr_elem
;
919 | MacroDecl
((s, es
, false), iis
::lp
::rp
::ifakestart
::iisto
) ->
921 iisto
+> List.iter pr_elem
; (* static and const *)
924 es
+> List.iter
(fun (e
, opt
) ->
925 assert (List.length opt
<= 1);
926 opt
+> List.iter pr_elem
;
933 ((s, es
, ini
), iis
::lp
::rp
::eq
::iiend
::ifakestart
::iisto
) ->
935 iisto
+> List.iter pr_elem
; (* static and const *)
938 es
+> List.iter
(fun (e
, opt
) ->
939 assert (List.length opt
<= 1);
940 opt
+> List.iter pr_elem
;
949 | (DeclList
(_
, _
) | (MacroDecl _
) | (MacroDeclInit _
)) ->
950 raise
(Impossible
115)
952 (* ---------------------- *)
953 and pp_init
(init
, iinit
) =
954 match init
, iinit
with
955 | InitExpr e
, [] -> pp_expression e
;
956 | InitList xs
, i1
::i2
::iicommaopt
->
957 pr_elem i1
; start_block();
958 xs
+> List.iter
(fun (x
, ii
) ->
959 assert (List.length ii
<= 1);
960 ii
+> List.iter
(function e
-> pr_elem e
; pr_nl
());
963 iicommaopt
+> List.iter pr_elem
;
967 | InitDesignators
(xs
, initialiser
), [i1
] -> (* : *)
968 xs
+> List.iter pp_designator
;
972 (* no use of '=' in the "Old" style *)
973 | InitFieldOld
(string, initialiser
), [i1
;i2
] -> (* label: in oldgcc *)
974 pr_elem i1
; pr_elem i2
; pp_init initialiser
975 | InitIndexOld
(expression
, initialiser
), [i1
;i2
] -> (* [1] in oldgcc *)
976 pr_elem i1
; pp_expression expression
; pr_elem i2
;
979 | (InitIndexOld _
| InitFieldOld _
| InitDesignators _
980 | InitList _
| InitExpr _
981 ), _
-> raise
(Impossible
116)
983 and pp_init_list ini
= pp_list pp_init ini
985 and pp_designator
= function
986 | DesignatorField
(s), [i1
; i2
] ->
987 pr_elem i1
; pr_elem i2
;
988 | DesignatorIndex
(expression
), [i1
;i2
] ->
989 pr_elem i1
; pp_expression expression
; pr_elem i2
;
991 | DesignatorRange
(e1
, e2
), [iocro
;iellipsis
;iccro
] ->
992 pr_elem iocro
; pp_expression e1
; pr_elem iellipsis
;
993 pp_expression e2
; pr_elem iccro
;
995 | (DesignatorField _
| DesignatorIndex _
| DesignatorRange _
996 ), _
-> raise
(Impossible
117)
999 (* ---------------------- *)
1000 and pp_attributes pr_elem pr_space attrs
=
1001 attrs
+> List.iter
(fun (attr
, ii
) ->
1002 ii
+> List.iter pr_elem
;
1005 (* ---------------------- *)
1007 let defbis, ii
= def
in
1009 | iifunc1
::iifunc2
::i1
::i2
::ifakestart
::isto
->
1011 f_type
= (returnt
, (paramst
, (b
, iib
)));
1019 pp_type_with_ident None
(Some
(sto
, isto
))
1020 returnt
Ast_c.noattr
;
1022 pp_attributes pr_elem pr_space attrs
;
1028 (* not anymore, cf tests/optional_name_parameter and
1029 macro_parameter_shortcut.c
1031 | [(((bool, None, t), ii_b_s), iicomma)] ->
1034 | qu, (BaseType Void, ii) -> true
1037 assert (null iicomma);
1038 assert (null ii_b_s);
1039 pp_type_with_ident None None t
1042 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
1043 iicomma +> List.iter pr_elem;
1045 (match b, s, ii_b_s with
1046 | false, Some s, [i1] ->
1047 pp_type_with_ident (Some (s, i1)) None t;
1048 | true, Some s, [i1;i2] ->
1050 pp_type_with_ident (Some (s, i2)) None t;
1052 (* in definition we have name for params, except when f(void) *)
1053 | _
, None
, _
-> raise Impossible
1054 | false, None
, [] ->
1056 | _
-> raise Impossible
1059 (* normally ii represent the ",..." but it is also abused
1060 with the f(void) case *)
1061 (* assert (List.length iib <= 2);*)
1062 iib
+> List.iter pr_elem
;
1065 pp_param_list paramst
;
1066 iib
+> List.iter pr_elem
;
1069 pr_elem iifunc2
; pr_space
();
1071 statxs
+> List.iter pp_statement_seq
;
1073 | _
-> raise
(Impossible
118)
1075 and pp_param_list paramst
= pp_list pp_param paramst
1077 (* ---------------------- *)
1079 and pp_ifdef ifdef
=
1081 | IfdefDirective
(ifdef
, ii
) ->
1082 List.iter pr_elem ii
1085 and pp_directive
= function
1086 | Include
{i_include
= (s, ii
);} ->
1087 let (i1
,i2
) = Common.tuple_of_list2 ii
in
1088 pr_elem i1
; pr_space
(); pr_elem i2
1089 | Define
((s,ii
), (defkind
, defval
)) ->
1090 let (idefine
,iident
,ieol
) = Common.tuple_of_list3 ii
in
1094 let define_val = function
1095 | DefineExpr e
-> pp_expression e
1096 | DefineStmt st
-> pp_statement st
1097 | DefineDoWhileZero
((st
,e
), ii
) ->
1099 | [ido
;iwhile
;iopar
;icpar
] ->
1102 pr_elem iwhile
; pr_elem iopar
;
1105 | _
-> raise
(Impossible
119)
1107 | DefineFunction def
-> pp_def def
1109 | DefineType ty
-> pp_type ty
1110 | DefineText
(s, ii
) -> List.iter pr_elem ii
1112 | DefineInit ini
-> pp_init ini
1114 ss
+> List.iter pp_statement
1115 | DefineTodo
-> pr2 "DefineTodo"
1118 | DefineVar
| Undef
-> ()
1119 | DefineFunc
(params
, ii
) ->
1120 let (i1
,i2
) = tuple_of_list2 ii
in
1122 params
+> List.iter
(fun ((s,iis
), iicomma
) ->
1123 assert (List.length iicomma
<= 1);
1124 iicomma
+> List.iter pr_elem
;
1125 iis
+> List.iter pr_elem
;
1132 | PragmaAndCo
(ii
) ->
1133 List.iter pr_elem ii
in
1138 let rec pp_toplevel = function
1139 | Declaration decl
-> pp_decl decl
1140 | Definition def
-> pp_def def
1142 | CppTop directive
-> pp_directive directive
1145 | MacroTop
(s, es
, [i1
;i2
;i3
;i4
]) ->
1148 es
+> List.iter
(fun (e
, opt
) ->
1149 assert (List.length opt
<= 1);
1150 opt
+> List.iter pr_elem
;
1157 | EmptyDef ii
-> ii
+> List.iter pr_elem
1158 | NotParsedCorrectly ii
->
1159 assert (List.length ii
>= 1);
1160 ii
+> List.iter pr_elem
1161 | FinalDef info
-> pr_elem
(Ast_c.rewrap_str
"" info
)
1163 | IfdefTop ifdefdir
-> pp_ifdef ifdefdir
1165 | Namespace
(tls
, [i1
; i2
; i3
; i4
]) ->
1166 pr_elem i1
; pr_elem i2
; pr_elem i3
;
1167 List.iter
pp_toplevel tls
;
1169 | (MacroTop _
) | (Namespace _
) -> raise
(Impossible
120) in
1175 match F.unwrap n
with
1176 | F.FunHeader
({f_name
=idb
;
1177 f_type
= (rett
, (paramst
,(isvaargs
,iidotsb
)));
1180 f_attr
= attrs
},ii
) ->
1186 attrs +> List.iter (vk_attribute bigf);
1188 paramst +> List.iter (fun (param, iicomma) ->
1189 vk_param bigf param;
1197 (* vk_decl bigf decl *)
1200 | F.ExprStatement
(st
, (eopt
, ii
)) ->
1201 pp_statement
(Ast_c.mk_st
(ExprStatement eopt
) ii
)
1203 | F.IfHeader
(_
, (e
,ii
))
1204 | F.SwitchHeader
(_
, (e
,ii
))
1205 | F.WhileHeader
(_
, (e
,ii
))
1206 | F.DoWhileTail
(e
,ii
) ->
1214 | F.ForHeader
(_st
, ((first
, (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
1216 iif i1; iif i2; iif i3;
1218 e1opt +> do_option (vk_expr bigf);
1219 e2opt +> do_option (vk_expr bigf);
1220 e3opt +> do_option (vk_expr bigf);
1224 | F.MacroIterHeader
(_s
, ((s,es
), ii
)) ->
1227 vk_argument_list bigf es;
1232 | F.ReturnExpr
(_st
, (e
,ii
)) ->
1233 (* iif ii; vk_expr bigf e*)
1237 | F.Case
(_st
, (e
,ii
)) ->
1238 (* iif ii; vk_expr bigf e *)
1241 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
1242 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1247 | F.CaseNode i
-> ()
1250 (* vk_expr bigf e *)
1253 | F.DefineType ft
->
1254 (* vk_type bigf ft *)
1257 | F.DefineHeader
((s,ii
), (defkind
)) ->
1260 vk_define_kind bigf defkind;
1265 | F.DefineDoWhileZeroHeader
(((),ii
)) ->
1270 | F.Include
{i_include
= (s, ii
);} ->
1275 | F.MacroTop
(s, args
, ii
) ->
1277 vk_argument_list bigf args *)
1281 | F.Break
(st
,((),ii
)) ->
1284 | F.Continue
(st
,((),ii
)) ->
1287 | F.Default
(st
,((),ii
)) ->
1290 | F.Return
(st
,((),ii
)) ->
1293 | F.Goto
(st
, name
, ((),ii
)) ->
1296 | F.Label
(st
, name
, ((),ii
)) ->
1299 | F.EndStatement iopt
->
1300 (* do_option infof iopt *)
1302 | F.DoHeader
(st
, info
) ->
1308 | F.SeqEnd
(i
, info
) ->
1311 | F.SeqStart
(st
, i
, info
) ->
1315 | F.MacroStmt
(st
, ((),ii
)) ->
1318 | F.Asm
(st
, (asmbody
,ii
)) ->
1321 vk_asmbody bigf asmbody
1326 | F.IfdefHeader
(info
) ->
1328 | F.IfdefElse
(info
) ->
1330 | F.IfdefEndif
(info
) ->
1337 | (F.TopNode
|F.EndNode
|
1338 F.ErrorExit
|F.Exit
|F.Enter
|F.LoopFallThroughNode
|F.FallThroughNode
|
1339 F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1344 { expression
= pp_expression;
1345 arg_list
= pp_arg_list
;
1347 statement
= pp_statement
;
1350 field_list
= pp_field_list
;
1352 init_list
= pp_init_list
;
1354 paramlist
= pp_param_list
;
1356 type_with_ident
= pp_type_with_ident
;
1357 toplevel
= pp_toplevel;
1361 (*****************************************************************************)
1363 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1365 let s = Ast_c.str_of_info info
in
1366 if !Flag_parsing_c.pretty_print_comment_info
then begin
1367 let before = !(info
.comments_tag
).mbefore
in
1368 if not
(null
before) then begin
1370 before +> List.iter
(fun (comment_like
, pinfo
) ->
1371 let s = pinfo
.Common.str
in
1379 let pr_space _
= Format.print_space
()
1382 let pr_indent _
= ()
1383 let pr_outdent _
= ()
1384 let pr_unindent _
= ()
1389 ~
pr_elem ~
pr_space ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1391 let pp_expression_simple = ppc.expression
1392 let pp_decl_simple = ppc.decl
1393 let pp_field_simple = ppc.field
1394 let pp_statement_simple = ppc.statement
1395 let pp_type_simple = ppc.ty
1396 let pp_init_simple = ppc.init
1397 let pp_toplevel_simple = ppc.toplevel
1398 let pp_flow_simple = ppc.flow
1401 let pp_elem_sp ~
pr_elem ~
pr_space =
1404 ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1406 let pp_expression_gen ~
pr_elem ~
pr_space =
1407 (pp_elem_sp pr_elem pr_space).expression
1409 let pp_arg_list_gen ~
pr_elem ~
pr_space =
1410 (pp_elem_sp pr_elem pr_space).arg_list
1412 let pp_arg_gen ~
pr_elem ~
pr_space =
1413 (pp_elem_sp pr_elem pr_space).arg
1415 let pp_statement_gen ~
pr_elem ~
pr_space =
1416 (pp_elem_sp pr_elem pr_space).statement
1418 let pp_decl_gen ~
pr_elem ~
pr_space =
1419 (pp_elem_sp pr_elem pr_space).decl
1421 let pp_field_gen ~
pr_elem ~
pr_space =
1422 (pp_elem_sp pr_elem pr_space).field
1424 let pp_field_list_gen ~
pr_elem ~
pr_space =
1425 (pp_elem_sp pr_elem pr_space).field_list
1427 let pp_init_gen ~
pr_elem ~
pr_space =
1428 (pp_elem_sp pr_elem pr_space).init
1430 let pp_init_list_gen ~
pr_elem ~
pr_space =
1431 (pp_elem_sp pr_elem pr_space).init_list
1433 let pp_param_gen ~
pr_elem ~
pr_space =
1434 (pp_elem_sp pr_elem pr_space).param
1436 let pp_param_list_gen ~
pr_elem ~
pr_space =
1437 (pp_elem_sp pr_elem pr_space).paramlist
1439 let pp_type_gen ~
pr_elem ~
pr_space =
1440 (pp_elem_sp pr_elem pr_space).ty
1442 let pp_type_with_ident_gen pr_elem pr_space =
1443 (pp_elem_sp pr_elem pr_space).type_with_ident
1445 let pp_program_gen ~
pr_elem ~
pr_space =
1446 (pp_elem_sp pr_elem pr_space).toplevel
1449 let string_of_expression e
=
1450 Common.format_to_string
(fun () ->
1451 pp_expression_simple e
1454 let string_of_toplevel top
=
1455 Common.format_to_string
(fun () ->
1456 pp_toplevel_simple top
1459 let (debug_info_of_node
:
1460 Ograph_extended.nodei
-> Control_flow_c.cflow
-> string) =
1462 let node = flow#nodes#assoc nodei
in
1463 let s = Common.format_to_string
(fun () ->
1466 let pos = Lib_parsing_c.min_pinfo_of_node
node in
1467 (spf
"%s(n%d)--> %s" (Common.string_of_parse_info_bis
pos) nodei
s)