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 indent_if_needed st f
=
77 match Ast_c.unwrap_st st
with
78 Compound _
-> pr_space
(); f
()
80 (*no newline at the end - someone else will do that*)
81 start_block(); f
(); pr_unindent
() in
84 let pp_list printer l
=
85 l
+> List.iter
(fun (e
, opt
) ->
86 assert (List.length opt
<= 1); (* opt must be a comma? *)
87 opt
+> List.iter
(function x
-> pr_elem x
; pr_space
());
90 let rec pp_expression = fun ((exp
, typ
), ii
) ->
92 | Ident
(ident
), [] -> pp_name ident
93 (* only a MultiString can have multiple ii *)
94 | Constant
(MultiString _
), is
-> is
+> List.iter pr_elem
95 | Constant
(c
), [i
] -> pr_elem i
96 | FunCall
(e
, es
), [i1
;i2
] ->
97 pp_expression e
; pr_elem i1
;
101 | CondExpr
(e1
, e2
, e3
), [i1
;i2
] ->
102 pp_expression e1
; pr_space
(); pr_elem i1
; pr_space
();
103 do_option
(function x
-> pp_expression x
; pr_space
()) e2
; pr_elem i2
;
104 pr_space
(); pp_expression e3
105 | Sequence
(e1
, e2
), [i
] ->
106 pp_expression e1
; pr_elem i
; pr_space
(); pp_expression e2
107 | Assignment
(e1
, op
, e2
), [i
] ->
108 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
110 | Postfix
(e
, op
), [i
] -> pp_expression e
; pr_elem i
;
111 | Infix
(e
, op
), [i
] -> pr_elem i
; pp_expression e
;
112 | Unary
(e
, op
), [i
] -> pr_elem i
; pp_expression e
113 | Binary
(e1
, op
, e2
), [i
] ->
114 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
116 | ArrayAccess
(e1
, e2
), [i1
;i2
] ->
117 pp_expression e1
; pr_elem i1
; pp_expression e2
; pr_elem i2
118 | RecordAccess
(e
, name
), [i1
] ->
119 pp_expression e
; pr_elem i1
; pp_name name
;
120 | RecordPtAccess
(e
, name
), [i1
] ->
121 pp_expression e
; pr_elem i1
; pp_name name
;
123 | SizeOfExpr
(e
), [i
] ->
125 (match Ast_c.unwrap e
with
126 ParenExpr
(e
), _
-> ()
129 | SizeOfType
(t
), [i1
;i2
;i3
] ->
130 pr_elem i1
; pr_elem i2
; pp_type t
; pr_elem i3
131 | Cast
(t
, e
), [i1
;i2
] ->
132 pr_elem i1
; pp_type t
; pr_elem i2
; pp_expression e
134 | StatementExpr
(statxs
, [ii1
;ii2
]), [i1
;i2
] ->
137 statxs
+> List.iter pp_statement_seq
;
140 | Constructor
(t
, init
), [lp
;rp
] ->
146 | ParenExpr
(e
), [i1
;i2
] -> pr_elem i1
; pp_expression e
; pr_elem i2
;
148 | New
(t
), [i1
] -> pr_elem i1
; pp_argument t
149 | Delete
(t
), [i1
] -> pr_elem i1
; pp_expression t
151 | (Ident
(_
) | Constant _
| FunCall
(_
,_
) | CondExpr
(_
,_
,_
)
154 | Postfix
(_
,_
) | Infix
(_
,_
) | Unary
(_
,_
) | Binary
(_
,_
,_
)
155 | ArrayAccess
(_
,_
) | RecordAccess
(_
,_
) | RecordPtAccess
(_
,_
)
156 | SizeOfExpr
(_
) | SizeOfType
(_
) | Cast
(_
,_
)
157 | StatementExpr
(_
) | Constructor _
158 | ParenExpr
(_
) | New
(_
) | Delete
(_
)),_
-> raise Impossible
161 if !Flag_parsing_c.pretty_print_type_info
163 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"/*");
165 (fun (ty
,_test
) -> ty
+>
167 (fun (x
,l
) -> pp_type x
;
169 Ast_c.LocalVar _
-> ", local"
171 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
s)));
172 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*/");
175 and pp_arg_list es
= pp_list pp_argument es
177 and pp_argument argument
=
178 let rec pp_action (ActMisc ii
) = ii
+> List.iter pr_elem
in
180 | Left e
-> pp_expression e
183 | ArgType param
-> pp_param param
184 | ArgAction action
-> pp_action action
)
186 (* ---------------------- *)
187 and pp_name
= function
188 | RegularName
(s, ii
) ->
189 let (i1
) = Common.tuple_of_list1 ii
in
191 | CppConcatenatedName xs
->
192 xs
+> List.iter
(fun ((x
,ii1
), ii2
) ->
193 ii2
+> List.iter pr_elem
;
194 ii1
+> List.iter pr_elem
;
196 | CppVariadicName
(s, ii
) ->
197 ii
+> List.iter pr_elem
198 | CppIdentBuilder
((s,iis
), xs
) ->
199 let (iis
, iop
, icp
) = Common.tuple_of_list3 iis
in
202 xs
+> List.iter
(fun ((x
,iix
), iicomma
) ->
203 iicomma
+> List.iter pr_elem
;
204 iix
+> List.iter pr_elem
;
208 (* ---------------------- *)
209 and pp_statement
= fun st
->
210 match Ast_c.get_st_and_ii st
with
211 | Labeled
(Label
(name
, st
)), ii
->
212 let (i2
) = Common.tuple_of_list1 ii
in
213 pr_outdent
(); pp_name name
; pr_elem i2
; pr_nl
(); pp_statement st
214 | Labeled
(Case
(e
, st
)), [i1
;i2
] ->
216 pr_elem i1
; pp_expression e
; pr_elem i2
; pr_nl
(); pr_indent
();
218 | Labeled
(CaseRange
(e
, e2
, st
)), [i1
;i2
;i3
] ->
220 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_expression e2
; pr_elem i3
;
221 pr_nl
(); pr_indent
();
223 | Labeled
(Default st
), [i1
;i2
] ->
224 pr_unindent
(); pr_elem i1
; pr_elem i2
; pr_nl
(); pr_indent
();
226 | Compound statxs
, [i1
;i2
] ->
227 pr_elem i1
; start_block();
228 statxs
+> Common.print_between pr_nl pp_statement_seq
;
229 end_block(); pr_elem i2
;
231 | ExprStatement
(None
), [i
] -> pr_elem i
;
232 | ExprStatement
(None
), [] -> ()
233 | ExprStatement
(Some e
), [i
] -> pp_expression e
; pr_elem i
234 (* the last ExprStatement of a for does not have a trailing
235 ';' hence the [] for ii *)
236 | ExprStatement
(Some e
), [] -> pp_expression e
;
237 | Selection
(If
(e
, st1
, st2
)), i1
::i2
::i3
::is
->
238 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
239 indent_if_needed st1
(function _
-> pp_statement st1
);
240 (match (Ast_c.get_st_and_ii st2
, is
) with
241 | ((ExprStatement None
, []), []) -> ()
242 | ((ExprStatement None
, []), [iifakend
]) -> pr_elem iifakend
243 | _st2
, [i4
;iifakend
] -> pr_elem i4
;
244 indent_if_needed st2
(function _
-> pp_statement st2
);
246 | x
-> raise Impossible
248 | Selection
(Switch
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
249 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
250 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
251 | Iteration
(While
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
252 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
253 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
254 | Iteration
(DoWhile
(st
, e
)), [i1
;i2
;i3
;i4
;i5
;iifakend
] ->
256 indent_if_needed st
(function _
-> pp_statement st
);
257 pr_elem i2
; pr_elem i3
; pp_expression e
;
258 pr_elem i4
; pr_elem i5
;
262 | Iteration
(For
((e1opt
,il1
),(e2opt
,il2
),(e3opt
, il3
),st
)),
263 [i1
;i2
;i3
;iifakend
] ->
265 pr_elem i1
; pr_space
();
267 pp_statement
(Ast_c.mk_st
(ExprStatement e1opt
) il1
);
268 pp_statement
(Ast_c.mk_st
(ExprStatement e2opt
) il2
);
270 pp_statement
(Ast_c.mk_st
(ExprStatement e3opt
) il3
);
272 indent_if_needed st
(function _
-> pp_statement st
);
275 | Iteration
(MacroIteration
(s,es
,st
)), [i1
;i2
;i3
;iifakend
] ->
276 pr_elem i1
; pr_space
();
279 es
+> List.iter
(fun (e
, opt
) ->
280 assert (List.length opt
<= 1);
281 opt
+> List.iter pr_elem
;
286 indent_if_needed st
(function _
-> pp_statement st
);
289 | Jump
(Goto name
), ii
->
290 let (i1
, i3
) = Common.tuple_of_list2 ii
in
291 pr_elem i1
; pr_space
(); pp_name name
; pr_elem i3
;
292 | Jump
((Continue
|Break
|Return
)), [i1
;i2
] -> pr_elem i1
; pr_elem i2
;
293 | Jump
(ReturnExpr e
), [i1
;i2
] ->
294 pr_elem i1
; pr_space
(); pp_expression e
; pr_elem i2
295 | Jump
(GotoComputed e
), [i1
;i2
;i3
] ->
296 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
298 | Decl decl
, [] -> pp_decl decl
301 | [iasm
;iopar
;icpar
;iptvirg
] ->
302 pr_elem iasm
; pr_elem iopar
;
304 pr_elem icpar
; pr_elem iptvirg
305 | [iasm
;ivolatile
;iopar
;icpar
;iptvirg
] ->
306 pr_elem iasm
; pr_elem ivolatile
; pr_elem iopar
;
308 pr_elem icpar
; pr_elem iptvirg
309 | _
-> raise Impossible
312 | NestedFunc def
, ii
->
316 ii
+> List.iter pr_elem
;
318 | (Labeled
(Case
(_
,_
))
319 | Labeled
(CaseRange
(_
,_
,_
)) | Labeled
(Default _
)
320 | Compound _
| ExprStatement _
321 | Selection
(If
(_
, _
, _
)) | Selection
(Switch
(_
, _
))
322 | Iteration
(While
(_
, _
)) | Iteration
(DoWhile
(_
, _
))
323 | Iteration
(For
((_
,_
), (_
,_
), (_
, _
), _
))
324 | Iteration
(MacroIteration
(_
,_
,_
))
325 | Jump
((Continue
|Break
|Return
)) | Jump
(ReturnExpr _
)
326 | Jump
(GotoComputed _
)
328 ), _
-> raise Impossible
330 and pp_statement_seq
= function
331 | StmtElem st
-> pp_statement st
332 | IfdefStmt ifdef
-> pp_ifdef ifdef
333 | CppDirectiveStmt cpp
-> pp_directive cpp
334 | IfdefStmt2
(ifdef
, xxs
) -> pp_ifdef_tree_sequence ifdef xxs
336 (* ifdef XXX elsif YYY elsif ZZZ endif *)
337 and pp_ifdef_tree_sequence ifdef xxs
=
341 pp_ifdef_tree_sequence_aux ifxs xxs
342 | _
-> raise Impossible
344 (* XXX elsif YYY elsif ZZZ endif *)
345 and pp_ifdef_tree_sequence_aux ifdefs xxs
=
346 Common.zip ifdefs xxs
+> List.iter
(fun (ifdef
, xs
) ->
347 xs
+> List.iter pp_statement_seq
;
355 (* ---------------------- *)
356 and pp_asmbody
(string_list
, colon_list
) =
357 string_list
+> List.iter pr_elem
;
358 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
359 ii
+> List.iter pr_elem
;
360 xs
+> List.iter
(fun (x
,iicomma
) ->
361 assert ((List.length iicomma
) <= 1);
362 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
364 | ColonMisc
, ii
-> ii
+> List.iter pr_elem
;
365 | ColonExpr e
, [istring
;iopar
;icpar
] ->
370 (* the following case used to be just raise Impossible, but
371 the code __asm__ __volatile__ ("dcbz 0, %[input]"
372 ::[input]"r"(&coherence_data[i]));
373 in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *)
374 | (ColonExpr e
), ii
->
375 (match List.rev ii
with
376 icpar
::iopar
::istring
::rest
->
377 List.iter pr_elem
(List.rev rest
);
382 | _
-> raise Impossible
))
386 (* ---------------------- *)
391 pp_type_with_ident_rest
398 and (pp_type_with_ident
:
399 (string * info
) option -> (storage
* il
) option ->
400 fullType
-> attribute list
->
402 fun ident sto ft attrs
->
404 (match (ident
, Ast_c.unwrap_typeC ft
) with
405 (Some _
,_
) | (_
,Pointer _
) -> pr_space
()
407 pp_type_with_ident_rest ident ft attrs
410 and (pp_base_type
: fullType
-> (storage
* il
) option -> unit) =
411 fun (qu
, (ty
, iity
)) sto
->
414 | None
-> [] | Some
(s, iis
) -> (*assert (List.length iis = 1);*) iis
416 let print_sto_qu (sto
, (qu
, iiqu
)) =
417 let all_ii = get_sto sto
++ iiqu
in
419 +> List.sort
Ast_c.compare_pos
420 +> Common.print_between pr_space pr_elem
423 let print_sto_qu_ty (sto
, (qu
, iiqu
), iity
) =
424 let all_ii = get_sto sto
++ iiqu
++ iity
in
425 let all_ii2 = all_ii +> List.sort
Ast_c.compare_pos
in
429 (* TODO in fact for pointer, the qualifier is after the type
430 * cf -test strangeorder
433 all_ii2 +> Common.print_between pr_space pr_elem
435 else all_ii2 +> Common.print_between pr_space pr_elem
440 | (Pointer t
, [i
]) -> pp_base_type t sto
441 | (ParenType t
, _
) -> pp_base_type t sto
442 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_base_type t sto
443 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
444 pp_base_type returnt sto
;
447 | (StructUnion
(su
, sopt
, fields
),iis
) ->
448 print_sto_qu (sto
, qu
);
451 | Some
s , [i1
;i2
;i3
;i4
] ->
452 pr_elem i1
; pr_elem i2
; pr_elem i3
;
453 | None
, [i1
;i2
;i3
] ->
454 pr_elem i1
; pr_elem i2
;
455 | x
-> raise Impossible
458 fields
+> List.iter pp_field
;
461 | Some
s , [i1
;i2
;i3
;i4
] -> pr_elem i4
462 | None
, [i1
;i2
;i3
] -> pr_elem i3
;
463 | x
-> raise Impossible
468 | (Enum
(sopt
, enumt
), iis
) ->
469 print_sto_qu (sto
, qu
);
471 (match sopt
, iis
with
472 | (Some
s, ([i1
;i2
;i3
;i4
]|[i1
;i2
;i3
;i4
;_
])) ->
473 pr_elem i1
; pr_elem i2
; pr_elem i3
;
474 | (None
, ([i1
;i2
;i3
]|[i1
;i2
;i3
;_
])) ->
475 pr_elem i1
; pr_elem i2
476 | x
-> raise Impossible
479 enumt
+> List.iter
(fun ((name
, eopt
), iicomma
) ->
480 assert (List.length iicomma
<= 1);
481 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
483 eopt
+> Common.do_option
(fun (ieq
, e
) ->
488 (match sopt
, iis
with
489 | (Some
s, [i1
;i2
;i3
;i4
]) -> pr_elem i4
490 | (Some
s, [i1
;i2
;i3
;i4
;i5
]) ->
491 pr_elem i5
; pr_elem i4
(* trailing comma *)
492 | (None
, [i1
;i2
;i3
]) -> pr_elem i3
493 | (None
, [i1
;i2
;i3
;i4
]) ->
494 pr_elem i4
; pr_elem i3
(* trailing comma *)
497 | x
-> raise Impossible
501 | (BaseType _
, iis
) ->
502 print_sto_qu_ty (sto
, qu
, iis
);
504 | (StructUnionName
(s, structunion
), iis
) ->
505 assert (List.length iis
=|= 2);
506 print_sto_qu_ty (sto
, qu
, iis
);
508 | (EnumName
s, iis
) ->
509 assert (List.length iis
=|= 2);
510 print_sto_qu_ty (sto
, qu
, iis
);
512 | (TypeName
(name
,typ
), noii
) ->
514 let (_s
, iis
) = get_s_and_info_of_name name
in
515 print_sto_qu_ty (sto
, qu
, [iis
]);
517 if !Flag_parsing_c.pretty_print_typedef_value
519 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"{*");
520 typ
+> Common.do_option
(fun typ
->
523 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*}");
526 | (TypeOfExpr
(e
), iis
) ->
527 print_sto_qu (sto
, qu
);
529 | [itypeof
;iopar
;icpar
] ->
530 pr_elem itypeof
; pr_elem iopar
;
533 | _
-> raise Impossible
536 | (TypeOfType
(t
), iis
) ->
537 print_sto_qu (sto
, qu
);
539 | [itypeof
;iopar
;icpar
] ->
540 pr_elem itypeof
; pr_elem iopar
;
543 | _
-> raise Impossible
546 | (Pointer _
| (*ParenType _ |*) Array _
| FunctionType _
547 (* | StructUnion _ | Enum _ | BaseType _ *)
548 (* | StructUnionName _ | EnumName _ | TypeName _ *)
549 (* | TypeOfExpr _ | TypeOfType _ *)
550 ), _
-> raise Impossible
552 and pp_field_list fields
= fields
+> Common.print_between pr_nl pp_field
553 and pp_field
= function
554 DeclarationField
(FieldDeclList
(onefield_multivars
,iiptvirg
))->
555 (match onefield_multivars
with
557 (* handling the first var. Special case, with the
558 first var, we print the whole type *)
561 (Simple
(nameopt
, typ
)), iivirg
->
562 (* first var cant have a preceding ',' *)
563 assert (List.length iivirg
=|= 0);
567 | Some name
-> Some
(get_s_and_info_of_name name
)
569 pp_type_with_ident
identinfo None typ
Ast_c.noattr
;
571 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
572 (* first var cant have a preceding ',' *)
573 assert (List.length iivirg
=|= 0);
578 let (s, is
) = get_s_and_info_of_name name
in
580 (Some
(s, is
)) None typ
Ast_c.noattr
;
585 ); (* match x, first onefield_multivars *)
588 xs
+> List.iter
(function
589 | (Simple
(nameopt
, typ
)), iivirg
->
590 iivirg
+> List.iter pr_elem
;
594 | Some name
-> Some
(get_s_and_info_of_name name
)
596 pp_type_with_ident_rest
identinfo typ
Ast_c.noattr
598 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
599 iivirg
+> List.iter pr_elem
;
602 let (s,is
) = get_s_and_info_of_name name
in
603 pp_type_with_ident_rest
604 (Some
(s, is
)) typ
Ast_c.noattr
;
608 (* was raise Impossible, but have no idea why because
609 nameless bit fields are accepted by the parser and
610 nothing seems to be done to give them names *)
613 )); (* iter other vars *)
615 | [] -> raise Impossible
616 ); (* onefield_multivars *)
617 assert (List.length iiptvirg
=|= 1);
618 iiptvirg
+> List.iter pr_elem
;
621 | MacroDeclField
((s, es
), ii
) ->
622 let (iis
, lp
, rp
, iiend
, ifakestart
) =
623 Common.tuple_of_list5 ii
in
624 (* iis::lp::rp::iiend::ifakestart::iisto
625 iisto +> List.iter pr_elem; (* static and const *)
630 es
+> List.iter
(fun (e
, opt
) ->
631 assert (List.length opt
<= 1);
632 opt
+> List.iter pr_elem
;
641 | EmptyField iipttvirg_when_emptyfield
->
642 pr_elem iipttvirg_when_emptyfield
644 | CppDirectiveStruct cpp
-> pp_directive cpp
645 | IfdefStruct ifdef
-> pp_ifdef ifdef
647 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
649 and (pp_type_with_ident_rest
: (string * info
) option ->
650 fullType
-> attribute list
-> unit) =
652 fun ident
(((qu
, iiqu
), (ty
, iity
)) as fullt
) attrs
->
654 let print_ident ident
= Common.do_option
(fun (s, iis
) ->
655 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
661 (* the work is to do in base_type !! *)
662 | (NoType _
, iis
) -> ()
663 | (BaseType _
, iis
) -> print_ident ident
664 | (Enum
(sopt
, enumt
), iis
) -> print_ident ident
665 | (StructUnion
(_
, sopt
, fields
),iis
) -> print_ident ident
666 | (StructUnionName
(s, structunion
), iis
) -> print_ident ident
667 | (EnumName
s, iis
) -> print_ident ident
668 | (TypeName
(_name
,_typ
), iis
) -> print_ident ident
669 | (TypeOfExpr
(e
), iis
) -> print_ident ident
670 | (TypeOfType
(e
), iis
) -> print_ident ident
674 | (Pointer t
, [i
]) ->
675 (* subtil: void ( *done)(int i) is a Pointer
676 (FunctionType (return=void, params=int i) *)
677 (*WRONG I THINK, use left & right function *)
678 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
680 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
681 pp_type_with_ident_rest ident t attrs
;
683 (* ugly special case ... todo? maybe sufficient in practice *)
684 | (ParenType ttop
, [i1
;i2
]) ->
685 (match Ast_c.get_ty_and_ii ttop
with
686 | (_q1
, (Pointer t2
, [ipointer
])) ->
687 (match Ast_c.get_ty_and_ii t2
with
688 | (q2
, (FunctionType t
, ii3
)) ->
690 pp_type_left
(q2
, mk_tybis
(FunctionType t
) ii3
);
695 pp_type_right
(q2
, mk_tybis
(FunctionType t
) ii3
);
697 pr2 "PB PARENTYPE ZARB, I forget about the ()";
698 pp_type_with_ident_rest ident ttop attrs
;
700 (* another ugly special case *)
701 | _q1
, (Array
(eopt
,t2
), [iarray1
;iarray2
]) ->
702 (match Ast_c.get_ty_and_ii t2
with
703 | (_q2
, (Pointer t3
, [ipointer
])) ->
704 (match Ast_c.get_ty_and_ii t3
with
705 | (q3
, (FunctionType t
, iifunc
)) ->
707 pp_type_left
(q3
, mk_tybis
(FunctionType t
) iifunc
);
712 do_option
pp_expression eopt
;
715 pp_type_right
(q3
, mk_tybis
(FunctionType t
) iifunc
)
717 pr2 "PB PARENTYPE ZARB, I forget about the ()";
718 pp_type_with_ident_rest ident ttop attrs
;
721 pr2 "PB PARENTYPE ZARB, I forget about the ()";
722 pp_type_with_ident_rest ident ttop attrs
;
726 pr2 "PB PARENTYPE ZARB, I forget about the ()";
727 pp_type_with_ident_rest ident ttop attrs
;
731 | (Array
(eopt
, t
), [i1
;i2
]) ->
734 iiqu
+> List.iter pr_elem
;
740 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
743 iiqu
+> List.iter pr_elem
;
749 | (FunctionType _
| Array _
| ParenType _
| Pointer _
), _
->
753 and (pp_type_left
: fullType
-> unit) =
754 fun ((qu
, iiqu
), (ty
, iity
)) ->
756 (NoType
,_
) -> failwith
"pp_type_left: unexpected NoType"
757 | (Pointer t
, [i
]) ->
759 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
762 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_type_left t
763 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) -> pp_type_left returnt
765 | (ParenType t
, _
) -> failwith
"parenType"
768 | (BaseType _
, iis
) -> ()
769 | (Enum
(sopt
, enumt
), iis
) -> ()
770 | (StructUnion
(_
, sopt
, fields
),iis
) -> ()
771 | (StructUnionName
(s, structunion
), iis
) -> ()
772 | (EnumName
s, iis
) -> ()
773 | (TypeName
(_name
,_typ
), iis
) -> ()
775 | TypeOfType _
, _
-> ()
776 | TypeOfExpr _
, _
-> ()
778 | (FunctionType _
| Array _
| Pointer _
), _
-> raise Impossible
782 let {p_namei
= nameopt
;
783 p_register
= (b
,iib
);
784 p_type
=t
;} = param
in
786 iib
+> List.iter pr_elem
;
792 let (s,i1
) = get_s_and_info_of_name name
in
794 (Some
(s, i1
)) None t
Ast_c.noattr
799 and pp_type_right
(((qu
, iiqu
), (ty
, iity
)) : fullType
) =
801 (NoType
,_
) -> failwith
"pp_type_right: unexpected NoType"
802 | (Pointer t
, [i
]) -> pp_type_right t
804 | (Array
(eopt
, t
), [i1
;i2
]) ->
806 eopt
+> do_option
pp_expression;
810 | (ParenType t
, _
) -> failwith
"parenType"
811 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
815 ts
+> List.iter
(fun (param
,iicomma
) ->
816 assert ((List.length iicomma
) <= 1);
817 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
821 iib
+> List.iter pr_elem
;
825 | (BaseType _
, iis
) -> ()
826 | (Enum
(sopt
, enumt
), iis
) -> ()
827 | (StructUnion
(_
, sopt
, fields
),iis
)-> ()
828 | (StructUnionName
(s, structunion
), iis
) -> ()
829 | (EnumName
s, iis
) -> ()
830 | (TypeName
(name
,_typ
), iis
) -> ()
832 | TypeOfType _
, _
-> ()
833 | TypeOfExpr _
, _
-> ()
835 | (FunctionType _
| Array _
| Pointer _
), _
-> raise Impossible
838 pp_type_with_ident None None t
Ast_c.noattr
840 (* ---------------------- *)
841 and pp_decl
= function
842 | DeclList
((({v_namei
= var
;
847 iivirg
::ifakestart
::iisto
) ->
851 (* old: iisto +> List.iter pr_elem; *)
854 (* handling the first var. Special case, we print the whole type *)
856 | Some
(name
, iniopt
) ->
857 let (s,iis
) = get_s_and_info_of_name name
in
859 (Some
(s, iis
)) (Some
(storage
, iisto
))
863 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
864 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
865 pr_elem lp
; pp_arg_list init
; pr_elem rp
866 | Ast_c.ConstrInit _
-> raise Impossible
)
867 | None
-> pp_type returnType
870 (* for other vars, we just call pp_type_with_ident_rest. *)
871 xs
+> List.iter
(function
872 | ({v_namei
= Some
(name
, iniopt
);
874 v_storage
= storage2
;
878 let (s,iis
) = get_s_and_info_of_name name
in
879 assert (storage2
=*= storage
);
880 iivirg
+> List.iter pr_elem
;
881 pp_type_with_ident_rest
882 (Some
(s, iis
)) returnType attrs
;
885 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
886 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
887 pr_elem lp
; pp_arg_list init
; pr_elem rp
888 | Ast_c.ConstrInit _
-> raise Impossible
);
891 | x
-> raise Impossible
896 | MacroDecl
((s, es
, true), iis
::lp
::rp
::iiend
::ifakestart
::iisto
) ->
898 iisto
+> List.iter pr_elem
; (* static and const *)
901 es
+> List.iter
(fun (e
, opt
) ->
902 assert (List.length opt
<= 1);
903 opt
+> List.iter pr_elem
;
910 | MacroDecl
((s, es
, false), iis
::lp
::rp
::ifakestart
::iisto
) ->
912 iisto
+> List.iter pr_elem
; (* static and const *)
915 es
+> List.iter
(fun (e
, opt
) ->
916 assert (List.length opt
<= 1);
917 opt
+> List.iter pr_elem
;
924 ((s, es
, ini
), iis
::lp
::rp
::eq
::iiend
::ifakestart
::iisto
) ->
926 iisto
+> List.iter pr_elem
; (* static and const *)
929 es
+> List.iter
(fun (e
, opt
) ->
930 assert (List.length opt
<= 1);
931 opt
+> List.iter pr_elem
;
940 | (DeclList
(_
, _
) | (MacroDecl _
) | (MacroDeclInit _
)) ->
943 (* ---------------------- *)
944 and pp_init
(init
, iinit
) =
945 match init
, iinit
with
946 | InitExpr e
, [] -> pp_expression e
;
947 | InitList xs
, i1
::i2
::iicommaopt
->
948 pr_elem i1
; start_block();
949 xs
+> List.iter
(fun (x
, ii
) ->
950 assert (List.length ii
<= 1);
951 ii
+> List.iter
(function e
-> pr_elem e
; pr_nl
());
954 iicommaopt
+> List.iter pr_elem
;
958 | InitDesignators
(xs
, initialiser
), [i1
] -> (* : *)
959 xs
+> List.iter pp_designator
;
963 (* no use of '=' in the "Old" style *)
964 | InitFieldOld
(string, initialiser
), [i1
;i2
] -> (* label: in oldgcc *)
965 pr_elem i1
; pr_elem i2
; pp_init initialiser
966 | InitIndexOld
(expression
, initialiser
), [i1
;i2
] -> (* [1] in oldgcc *)
967 pr_elem i1
; pp_expression expression
; pr_elem i2
;
970 | (InitIndexOld _
| InitFieldOld _
| InitDesignators _
971 | InitList _
| InitExpr _
972 ), _
-> raise Impossible
974 and pp_init_list ini
= pp_list pp_init ini
976 and pp_designator
= function
977 | DesignatorField
(s), [i1
; i2
] ->
978 pr_elem i1
; pr_elem i2
;
979 | DesignatorIndex
(expression
), [i1
;i2
] ->
980 pr_elem i1
; pp_expression expression
; pr_elem i2
;
982 | DesignatorRange
(e1
, e2
), [iocro
;iellipsis
;iccro
] ->
983 pr_elem iocro
; pp_expression e1
; pr_elem iellipsis
;
984 pp_expression e2
; pr_elem iccro
;
986 | (DesignatorField _
| DesignatorIndex _
| DesignatorRange _
987 ), _
-> raise Impossible
990 (* ---------------------- *)
991 and pp_attributes pr_elem pr_space attrs
=
992 attrs
+> List.iter
(fun (attr
, ii
) ->
993 ii
+> List.iter pr_elem
;
996 (* ---------------------- *)
998 let defbis, ii
= def
in
1000 | iifunc1
::iifunc2
::i1
::i2
::ifakestart
::isto
->
1002 f_type
= (returnt
, (paramst
, (b
, iib
)));
1010 pp_type_with_ident None
(Some
(sto
, isto
))
1011 returnt
Ast_c.noattr
;
1013 pp_attributes pr_elem pr_space attrs
;
1019 (* not anymore, cf tests/optional_name_parameter and
1020 macro_parameter_shortcut.c
1022 | [(((bool, None, t), ii_b_s), iicomma)] ->
1025 | qu, (BaseType Void, ii) -> true
1028 assert (null iicomma);
1029 assert (null ii_b_s);
1030 pp_type_with_ident None None t
1033 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
1034 iicomma +> List.iter pr_elem;
1036 (match b, s, ii_b_s with
1037 | false, Some s, [i1] ->
1038 pp_type_with_ident (Some (s, i1)) None t;
1039 | true, Some s, [i1;i2] ->
1041 pp_type_with_ident (Some (s, i2)) None t;
1043 (* in definition we have name for params, except when f(void) *)
1044 | _
, None
, _
-> raise Impossible
1045 | false, None
, [] ->
1047 | _
-> raise Impossible
1050 (* normally ii represent the ",..." but it is also abused
1051 with the f(void) case *)
1052 (* assert (List.length iib <= 2);*)
1053 iib
+> List.iter pr_elem
;
1056 pp_param_list paramst
;
1057 iib
+> List.iter pr_elem
;
1060 pr_elem iifunc2
; pr_space
();
1062 statxs
+> List.iter pp_statement_seq
;
1064 | _
-> raise Impossible
1066 and pp_param_list paramst
= pp_list pp_param paramst
1068 (* ---------------------- *)
1070 and pp_ifdef ifdef
=
1072 | IfdefDirective
(ifdef
, ii
) ->
1073 List.iter pr_elem ii
1076 and pp_directive
= function
1077 | Include
{i_include
= (s, ii
);} ->
1078 let (i1
,i2
) = Common.tuple_of_list2 ii
in
1079 pr_elem i1
; pr_space
(); pr_elem i2
1080 | Define
((s,ii
), (defkind
, defval
)) ->
1081 let (idefine
,iident
,ieol
) = Common.tuple_of_list3 ii
in
1085 let define_val = function
1086 | DefineExpr e
-> pp_expression e
1087 | DefineStmt st
-> pp_statement st
1088 | DefineDoWhileZero
((st
,e
), ii
) ->
1090 | [ido
;iwhile
;iopar
;icpar
] ->
1093 pr_elem iwhile
; pr_elem iopar
;
1096 | _
-> raise Impossible
1098 | DefineFunction def
-> pp_def def
1100 | DefineType ty
-> pp_type ty
1101 | DefineText
(s, ii
) -> List.iter pr_elem ii
1103 | DefineInit ini
-> pp_init ini
1105 | DefineTodo
-> pr2 "DefineTodo"
1108 | DefineVar
| Undef
-> ()
1109 | DefineFunc
(params
, ii
) ->
1110 let (i1
,i2
) = tuple_of_list2 ii
in
1112 params
+> List.iter
(fun ((s,iis
), iicomma
) ->
1113 assert (List.length iicomma
<= 1);
1114 iicomma
+> List.iter pr_elem
;
1115 iis
+> List.iter pr_elem
;
1122 | PragmaAndCo
(ii
) ->
1123 List.iter pr_elem ii
in
1128 let pp_toplevel = function
1129 | Declaration decl
-> pp_decl decl
1130 | Definition def
-> pp_def def
1132 | CppTop directive
-> pp_directive directive
1135 | MacroTop
(s, es
, [i1
;i2
;i3
;i4
]) ->
1138 es
+> List.iter
(fun (e
, opt
) ->
1139 assert (List.length opt
<= 1);
1140 opt
+> List.iter pr_elem
;
1147 | EmptyDef ii
-> ii
+> List.iter pr_elem
1148 | NotParsedCorrectly ii
->
1149 assert (List.length ii
>= 1);
1150 ii
+> List.iter pr_elem
1151 | FinalDef info
-> pr_elem
(Ast_c.rewrap_str
"" info
)
1153 | IfdefTop ifdefdir
-> pp_ifdef ifdefdir
1155 | (MacroTop _
) -> raise Impossible
in
1161 match F.unwrap n
with
1162 | F.FunHeader
({f_name
=idb
;
1163 f_type
= (rett
, (paramst
,(isvaargs
,iidotsb
)));
1166 f_attr
= attrs
},ii
) ->
1172 attrs +> List.iter (vk_attribute bigf);
1174 paramst +> List.iter (fun (param, iicomma) ->
1175 vk_param bigf param;
1183 (* vk_decl bigf decl *)
1186 | F.ExprStatement
(st
, (eopt
, ii
)) ->
1187 pp_statement
(Ast_c.mk_st
(ExprStatement eopt
) ii
)
1189 | F.IfHeader
(_
, (e
,ii
))
1190 | F.SwitchHeader
(_
, (e
,ii
))
1191 | F.WhileHeader
(_
, (e
,ii
))
1192 | F.DoWhileTail
(e
,ii
) ->
1200 | F.ForHeader
(_st
, (((e1opt
,i1
), (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
1202 iif i1; iif i2; iif i3;
1204 e1opt +> do_option (vk_expr bigf);
1205 e2opt +> do_option (vk_expr bigf);
1206 e3opt +> do_option (vk_expr bigf);
1210 | F.MacroIterHeader
(_s
, ((s,es
), ii
)) ->
1213 vk_argument_list bigf es;
1218 | F.ReturnExpr
(_st
, (e
,ii
)) ->
1219 (* iif ii; vk_expr bigf e*)
1223 | F.Case
(_st
, (e
,ii
)) ->
1224 (* iif ii; vk_expr bigf e *)
1227 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
1228 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1233 | F.CaseNode i
-> ()
1236 (* vk_expr bigf e *)
1239 | F.DefineType ft
->
1240 (* vk_type bigf ft *)
1243 | F.DefineHeader
((s,ii
), (defkind
)) ->
1246 vk_define_kind bigf defkind;
1251 | F.DefineDoWhileZeroHeader
(((),ii
)) ->
1256 | F.Include
{i_include
= (s, ii
);} ->
1261 | F.MacroTop
(s, args
, ii
) ->
1263 vk_argument_list bigf args *)
1267 | F.Break
(st
,((),ii
)) ->
1270 | F.Continue
(st
,((),ii
)) ->
1273 | F.Default
(st
,((),ii
)) ->
1276 | F.Return
(st
,((),ii
)) ->
1279 | F.Goto
(st
, name
, ((),ii
)) ->
1282 | F.Label
(st
, name
, ((),ii
)) ->
1285 | F.EndStatement iopt
->
1286 (* do_option infof iopt *)
1288 | F.DoHeader
(st
, info
) ->
1294 | F.SeqEnd
(i
, info
) ->
1297 | F.SeqStart
(st
, i
, info
) ->
1301 | F.MacroStmt
(st
, ((),ii
)) ->
1304 | F.Asm
(st
, (asmbody
,ii
)) ->
1307 vk_asmbody bigf asmbody
1312 | F.IfdefHeader
(info
) ->
1314 | F.IfdefElse
(info
) ->
1316 | F.IfdefEndif
(info
) ->
1323 | (F.TopNode
|F.EndNode
|
1324 F.ErrorExit
|F.Exit
|F.Enter
|F.LoopFallThroughNode
|F.FallThroughNode
|
1325 F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1330 { expression
= pp_expression;
1331 arg_list
= pp_arg_list
;
1333 statement
= pp_statement
;
1336 field_list
= pp_field_list
;
1338 init_list
= pp_init_list
;
1340 paramlist
= pp_param_list
;
1342 type_with_ident
= pp_type_with_ident
;
1343 toplevel
= pp_toplevel;
1347 (*****************************************************************************)
1349 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1351 let s = Ast_c.str_of_info info
in
1352 if !Flag_parsing_c.pretty_print_comment_info
then begin
1353 let before = !(info
.comments_tag
).mbefore
in
1354 if not
(null
before) then begin
1356 before +> List.iter
(fun (comment_like
, pinfo
) ->
1357 let s = pinfo
.Common.str
in
1365 let pr_space _
= Format.print_space
()
1368 let pr_indent _
= ()
1369 let pr_outdent _
= ()
1370 let pr_unindent _
= ()
1375 ~
pr_elem ~
pr_space ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1377 let pp_expression_simple = ppc.expression
1378 let pp_decl_simple = ppc.decl
1379 let pp_field_simple = ppc.field
1380 let pp_statement_simple = ppc.statement
1381 let pp_type_simple = ppc.ty
1382 let pp_init_simple = ppc.init
1383 let pp_toplevel_simple = ppc.toplevel
1384 let pp_flow_simple = ppc.flow
1387 let pp_elem_sp ~
pr_elem ~
pr_space =
1390 ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1392 let pp_expression_gen ~
pr_elem ~
pr_space =
1393 (pp_elem_sp pr_elem pr_space).expression
1395 let pp_arg_list_gen ~
pr_elem ~
pr_space =
1396 (pp_elem_sp pr_elem pr_space).arg_list
1398 let pp_arg_gen ~
pr_elem ~
pr_space =
1399 (pp_elem_sp pr_elem pr_space).arg
1401 let pp_statement_gen ~
pr_elem ~
pr_space =
1402 (pp_elem_sp pr_elem pr_space).statement
1404 let pp_decl_gen ~
pr_elem ~
pr_space =
1405 (pp_elem_sp pr_elem pr_space).decl
1407 let pp_field_gen ~
pr_elem ~
pr_space =
1408 (pp_elem_sp pr_elem pr_space).field
1410 let pp_field_list_gen ~
pr_elem ~
pr_space =
1411 (pp_elem_sp pr_elem pr_space).field_list
1413 let pp_init_gen ~
pr_elem ~
pr_space =
1414 (pp_elem_sp pr_elem pr_space).init
1416 let pp_init_list_gen ~
pr_elem ~
pr_space =
1417 (pp_elem_sp pr_elem pr_space).init_list
1419 let pp_param_gen ~
pr_elem ~
pr_space =
1420 (pp_elem_sp pr_elem pr_space).param
1422 let pp_param_list_gen ~
pr_elem ~
pr_space =
1423 (pp_elem_sp pr_elem pr_space).paramlist
1425 let pp_type_gen ~
pr_elem ~
pr_space =
1426 (pp_elem_sp pr_elem pr_space).ty
1428 let pp_type_with_ident_gen pr_elem pr_space =
1429 (pp_elem_sp pr_elem pr_space).type_with_ident
1431 let pp_program_gen ~
pr_elem ~
pr_space =
1432 (pp_elem_sp pr_elem pr_space).toplevel
1435 let string_of_expression e
=
1436 Common.format_to_string
(fun () ->
1437 pp_expression_simple e
1440 let string_of_toplevel top
=
1441 Common.format_to_string
(fun () ->
1442 pp_toplevel_simple top
1445 let (debug_info_of_node
:
1446 Ograph_extended.nodei
-> Control_flow_c.cflow
-> string) =
1448 let node = flow#nodes#assoc nodei
in
1449 let s = Common.format_to_string
(fun () ->
1452 let pos = Lib_parsing_c.min_pinfo_of_node
node in
1453 (spf
"%s(n%d)--> %s" (Common.string_of_parse_info_bis
pos) nodei
s)