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
(t
), [i1
] -> pr_elem i1
; pp_argument t
153 | Delete
(t
), [i1
] -> pr_elem i1
; pp_expression t
155 | (Ident
(_
) | Constant _
| FunCall
(_
,_
) | CondExpr
(_
,_
,_
)
158 | Postfix
(_
,_
) | Infix
(_
,_
) | Unary
(_
,_
) | Binary
(_
,_
,_
)
159 | ArrayAccess
(_
,_
) | RecordAccess
(_
,_
) | RecordPtAccess
(_
,_
)
160 | SizeOfExpr
(_
) | SizeOfType
(_
) | Cast
(_
,_
)
161 | StatementExpr
(_
) | Constructor _
162 | ParenExpr
(_
) | New
(_
) | Delete
(_
)),_
-> raise
(Impossible
95)
165 if !Flag_parsing_c.pretty_print_type_info
167 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"/*");
169 (fun (ty
,_test
) -> ty
+>
171 (fun (x
,l
) -> pp_type x
;
173 Ast_c.LocalVar _
-> ", local"
175 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
s)));
176 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*/");
179 and pp_arg_list es
= pp_list pp_argument es
181 and pp_argument argument
=
182 let rec pp_action (ActMisc ii
) = ii
+> List.iter pr_elem
in
184 | Left e
-> pp_expression e
187 | ArgType param
-> pp_param param
188 | ArgAction action
-> pp_action action
)
190 (* ---------------------- *)
191 and pp_name
= function
192 | RegularName
(s, ii
) ->
193 let (i1
) = Common.tuple_of_list1 ii
in
195 | CppConcatenatedName xs
->
196 xs
+> List.iter
(fun ((x
,ii1
), ii2
) ->
197 ii2
+> List.iter pr_elem
;
198 ii1
+> List.iter pr_elem
;
200 | CppVariadicName
(s, ii
) ->
201 ii
+> List.iter pr_elem
202 | CppIdentBuilder
((s,iis
), xs
) ->
203 let (iis
, iop
, icp
) = Common.tuple_of_list3 iis
in
206 xs
+> List.iter
(fun ((x
,iix
), iicomma
) ->
207 iicomma
+> List.iter pr_elem
;
208 iix
+> List.iter pr_elem
;
212 (* ---------------------- *)
213 and pp_statement
= fun st
->
214 match Ast_c.get_st_and_ii st
with
215 | Labeled
(Label
(name
, st
)), ii
->
216 let (i2
) = Common.tuple_of_list1 ii
in
217 pr_outdent
(); pp_name name
; pr_elem i2
; pr_nl
(); pp_statement st
218 | Labeled
(Case
(e
, st
)), [i1
;i2
] ->
220 pr_elem i1
; pp_expression e
; pr_elem i2
; pr_nl
(); pr_indent
();
222 | Labeled
(CaseRange
(e
, e2
, st
)), [i1
;i2
;i3
] ->
224 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_expression e2
; pr_elem i3
;
225 pr_nl
(); pr_indent
();
227 | Labeled
(Default st
), [i1
;i2
] ->
228 pr_unindent
(); pr_elem i1
; pr_elem i2
; pr_nl
(); pr_indent
();
230 | Compound statxs
, [i1
;i2
] ->
231 pr_elem i1
; start_block();
232 statxs
+> Common.print_between pr_nl pp_statement_seq
;
233 end_block(); pr_elem i2
;
235 | ExprStatement
(None
), [i
] -> pr_elem i
;
236 | ExprStatement
(None
), [] -> ()
237 | ExprStatement
(Some e
), [i
] -> pp_expression e
; pr_elem i
238 (* the last ExprStatement of a for does not have a trailing
239 ';' hence the [] for ii *)
240 | ExprStatement
(Some e
), [] -> pp_expression e
;
241 | Selection
(If
(e
, st1
, st2
)), i1
::i2
::i3
::is
->
242 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
243 indent_if_needed st1
(function _
-> pp_statement st1
);
244 (match (Ast_c.get_st_and_ii st2
, is
) with
245 | ((ExprStatement None
, []), []) -> ()
246 | ((ExprStatement None
, []), [iifakend
]) -> pr_elem iifakend
247 | _st2
, [i4
;iifakend
] -> pr_elem i4
;
248 indent_if_needed st2
(function _
-> pp_statement st2
);
250 | x
-> raise
(Impossible
96)
252 | Selection
(Switch
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
253 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
254 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
255 | Iteration
(While
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
256 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
257 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
258 | Iteration
(DoWhile
(st
, e
)), [i1
;i2
;i3
;i4
;i5
;iifakend
] ->
260 indent_if_needed st
(function _
-> pp_statement st
);
261 pr_elem i2
; pr_elem i3
; pp_expression e
;
262 pr_elem i4
; pr_elem i5
;
266 | Iteration
(For
(first
,(e2opt
,il2
),(e3opt
, il3
),st
)),
267 [i1
;i2
;i3
;iifakend
] ->
269 pr_elem i1
; pr_space
();
272 ForExp
(e1opt
,il1
) ->
273 pp_statement
(Ast_c.mk_st
(ExprStatement e1opt
) il1
)
274 | ForDecl decl
-> pp_decl decl
);
275 pp_statement
(Ast_c.mk_st
(ExprStatement e2opt
) il2
);
277 pp_statement
(Ast_c.mk_st
(ExprStatement e3opt
) il3
);
279 indent_if_needed st
(function _
-> pp_statement st
);
282 | Iteration
(MacroIteration
(s,es
,st
)), [i1
;i2
;i3
;iifakend
] ->
283 pr_elem i1
; pr_space
();
286 es
+> List.iter
(fun (e
, opt
) ->
287 assert (List.length opt
<= 1);
288 opt
+> List.iter pr_elem
;
293 indent_if_needed st
(function _
-> pp_statement st
);
296 | Jump
(Goto name
), ii
->
297 let (i1
, i3
) = Common.tuple_of_list2 ii
in
298 pr_elem i1
; pr_space
(); pp_name name
; pr_elem i3
;
299 | Jump
((Continue
|Break
|Return
)), [i1
;i2
] -> pr_elem i1
; pr_elem i2
;
300 | Jump
(ReturnExpr e
), [i1
;i2
] ->
301 pr_elem i1
; pr_space
(); pp_expression e
; pr_elem i2
302 | Jump
(GotoComputed e
), [i1
;i2
;i3
] ->
303 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
305 | Decl decl
, [] -> pp_decl decl
308 | [iasm
;iopar
;icpar
;iptvirg
] ->
309 pr_elem iasm
; pr_elem iopar
;
311 pr_elem icpar
; pr_elem iptvirg
312 | [iasm
;ivolatile
;iopar
;icpar
;iptvirg
] ->
313 pr_elem iasm
; pr_elem ivolatile
; pr_elem iopar
;
315 pr_elem icpar
; pr_elem iptvirg
316 | _
-> raise
(Impossible
97)
319 | NestedFunc def
, ii
->
323 ii
+> List.iter pr_elem
;
325 | (Labeled
(Case
(_
,_
))
326 | Labeled
(CaseRange
(_
,_
,_
)) | Labeled
(Default _
)
327 | Compound _
| ExprStatement _
328 | Selection
(If
(_
, _
, _
)) | Selection
(Switch
(_
, _
))
329 | Iteration
(While
(_
, _
)) | Iteration
(DoWhile
(_
, _
))
330 | Iteration
(For
(_
, (_
,_
), (_
, _
), _
))
331 | Iteration
(MacroIteration
(_
,_
,_
))
332 | Jump
((Continue
|Break
|Return
)) | Jump
(ReturnExpr _
)
333 | Jump
(GotoComputed _
)
335 ), _
-> raise
(Impossible
98)
337 and pp_statement_seq
= function
338 | StmtElem st
-> pp_statement st
339 | IfdefStmt ifdef
-> pp_ifdef ifdef
340 | CppDirectiveStmt cpp
-> pp_directive cpp
341 | IfdefStmt2
(ifdef
, xxs
) -> pp_ifdef_tree_sequence ifdef xxs
343 (* ifdef XXX elsif YYY elsif ZZZ endif *)
344 and pp_ifdef_tree_sequence ifdef xxs
=
348 pp_ifdef_tree_sequence_aux ifxs xxs
349 | _
-> raise
(Impossible
99)
351 (* XXX elsif YYY elsif ZZZ endif *)
352 and pp_ifdef_tree_sequence_aux ifdefs xxs
=
353 Common.zip ifdefs xxs
+> List.iter
(fun (ifdef
, xs
) ->
354 xs
+> List.iter pp_statement_seq
;
362 (* ---------------------- *)
363 and pp_asmbody
(string_list
, colon_list
) =
364 string_list
+> List.iter pr_elem
;
365 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
366 ii
+> List.iter pr_elem
;
367 xs
+> List.iter
(fun (x
,iicomma
) ->
368 assert ((List.length iicomma
) <= 1);
369 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
371 | ColonMisc
, ii
-> ii
+> List.iter pr_elem
;
372 | ColonExpr e
, [istring
;iopar
;icpar
] ->
377 (* the following case used to be just raise Impossible, but
378 the code __asm__ __volatile__ ("dcbz 0, %[input]"
379 ::[input]"r"(&coherence_data[i]));
380 in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *)
381 | (ColonExpr e
), ii
->
382 (match List.rev ii
with
383 icpar
::iopar
::istring
::rest
->
384 List.iter pr_elem
(List.rev rest
);
389 | _
-> raise
(Impossible
100)))
393 (* ---------------------- *)
398 pp_type_with_ident_rest
405 and (pp_type_with_ident
:
406 (string * info
) option -> (storage
* il
) option ->
407 fullType
-> attribute list
->
409 fun ident sto ft attrs
->
411 (match (ident
, Ast_c.unwrap_typeC ft
) with
412 (Some _
,_
) | (_
,Pointer _
) -> pr_space
()
414 pp_type_with_ident_rest ident ft attrs
417 and (pp_base_type
: fullType
-> (storage
* il
) option -> unit) =
418 fun (qu
, (ty
, iity
)) sto
->
421 | None
-> [] | Some
(s, iis
) -> (*assert (List.length iis = 1);*) iis
423 let print_sto_qu (sto
, (qu
, iiqu
)) =
424 let all_ii = get_sto sto
++ iiqu
in
426 +> List.sort
Ast_c.compare_pos
427 +> Common.print_between pr_space pr_elem
430 let print_sto_qu_ty (sto
, (qu
, iiqu
), iity
) =
431 let all_ii = get_sto sto
++ iiqu
++ iity
in
432 let all_ii2 = all_ii +> List.sort
Ast_c.compare_pos
in
436 (* TODO in fact for pointer, the qualifier is after the type
437 * cf -test strangeorder
440 all_ii2 +> Common.print_between pr_space pr_elem
442 else all_ii2 +> Common.print_between pr_space pr_elem
447 | (Pointer t
, [i
]) -> pp_base_type t sto
448 | (ParenType t
, _
) -> pp_base_type t sto
449 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_base_type t sto
450 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
451 pp_base_type returnt sto
;
454 | (StructUnion
(su
, sopt
, fields
),iis
) ->
455 print_sto_qu (sto
, qu
);
458 | Some
s , [i1
;i2
;i3
;i4
] ->
459 pr_elem i1
; pr_elem i2
; pr_elem i3
;
460 | None
, [i1
;i2
;i3
] ->
461 pr_elem i1
; pr_elem i2
;
462 | x
-> raise
(Impossible
101)
465 fields
+> List.iter pp_field
;
468 | Some
s , [i1
;i2
;i3
;i4
] -> pr_elem i4
469 | None
, [i1
;i2
;i3
] -> pr_elem i3
;
470 | x
-> raise
(Impossible
102)
475 | (Enum
(sopt
, enumt
), iis
) ->
476 print_sto_qu (sto
, qu
);
478 (match sopt
, iis
with
479 | (Some
s, ([i1
;i2
;i3
;i4
]|[i1
;i2
;i3
;i4
;_
])) ->
480 pr_elem i1
; pr_elem i2
; pr_elem i3
;
481 | (None
, ([i1
;i2
;i3
]|[i1
;i2
;i3
;_
])) ->
482 pr_elem i1
; pr_elem i2
483 | x
-> raise
(Impossible
103)
486 enumt
+> List.iter
(fun ((name
, eopt
), iicomma
) ->
487 assert (List.length iicomma
<= 1);
488 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
490 eopt
+> Common.do_option
(fun (ieq
, e
) ->
495 (match sopt
, iis
with
496 | (Some
s, [i1
;i2
;i3
;i4
]) -> pr_elem i4
497 | (Some
s, [i1
;i2
;i3
;i4
;i5
]) ->
498 pr_elem i5
; pr_elem i4
(* trailing comma *)
499 | (None
, [i1
;i2
;i3
]) -> pr_elem i3
500 | (None
, [i1
;i2
;i3
;i4
]) ->
501 pr_elem i4
; pr_elem i3
(* trailing comma *)
504 | x
-> raise
(Impossible
104)
508 | (BaseType _
, iis
) ->
509 print_sto_qu_ty (sto
, qu
, iis
);
511 | (StructUnionName
(s, structunion
), iis
) ->
512 assert (List.length iis
=|= 2);
513 print_sto_qu_ty (sto
, qu
, iis
);
515 | (EnumName
s, iis
) ->
516 assert (List.length iis
=|= 2);
517 print_sto_qu_ty (sto
, qu
, iis
);
519 | (TypeName
(name
,typ
), noii
) ->
521 let (_s
, iis
) = get_s_and_info_of_name name
in
522 print_sto_qu_ty (sto
, qu
, [iis
]);
524 if !Flag_parsing_c.pretty_print_typedef_value
526 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"{*");
527 typ
+> Common.do_option
(fun typ
->
530 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*}");
533 | (TypeOfExpr
(e
), iis
) ->
534 print_sto_qu (sto
, qu
);
536 | [itypeof
;iopar
;icpar
] ->
537 pr_elem itypeof
; pr_elem iopar
;
540 | _
-> raise
(Impossible
105)
543 | (TypeOfType
(t
), iis
) ->
544 print_sto_qu (sto
, qu
);
546 | [itypeof
;iopar
;icpar
] ->
547 pr_elem itypeof
; pr_elem iopar
;
550 | _
-> raise
(Impossible
106)
553 | (Pointer _
| (*ParenType _ |*) Array _
| FunctionType _
554 (* | StructUnion _ | Enum _ | BaseType _ *)
555 (* | StructUnionName _ | EnumName _ | TypeName _ *)
556 (* | TypeOfExpr _ | TypeOfType _ *)
557 ), _
-> raise
(Impossible
107)
559 and pp_field_list fields
= fields
+> Common.print_between pr_nl pp_field
560 and pp_field
= function
561 DeclarationField
(FieldDeclList
(onefield_multivars
,iiptvirg
))->
562 (match onefield_multivars
with
564 (* handling the first var. Special case, with the
565 first var, we print the whole type *)
568 (Simple
(nameopt
, typ
)), iivirg
->
569 (* first var cant have a preceding ',' *)
570 assert (List.length iivirg
=|= 0);
574 | Some name
-> Some
(get_s_and_info_of_name name
)
576 pp_type_with_ident
identinfo None typ
Ast_c.noattr
;
578 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
579 (* first var cant have a preceding ',' *)
580 assert (List.length iivirg
=|= 0);
585 let (s, is
) = get_s_and_info_of_name name
in
587 (Some
(s, is
)) None typ
Ast_c.noattr
;
592 ); (* match x, first onefield_multivars *)
595 xs
+> List.iter
(function
596 | (Simple
(nameopt
, typ
)), iivirg
->
597 iivirg
+> List.iter pr_elem
;
601 | Some name
-> Some
(get_s_and_info_of_name name
)
603 pp_type_with_ident_rest
identinfo typ
Ast_c.noattr
605 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
606 iivirg
+> List.iter pr_elem
;
609 let (s,is
) = get_s_and_info_of_name name
in
610 pp_type_with_ident_rest
611 (Some
(s, is
)) typ
Ast_c.noattr
;
615 (* was raise Impossible, but have no idea why because
616 nameless bit fields are accepted by the parser and
617 nothing seems to be done to give them names *)
620 )); (* iter other vars *)
622 | [] -> raise
(Impossible
108)
623 ); (* onefield_multivars *)
624 assert (List.length iiptvirg
=|= 1);
625 iiptvirg
+> List.iter pr_elem
;
628 | MacroDeclField
((s, es
), ii
) ->
629 let (iis
, lp
, rp
, iiend
, ifakestart
) =
630 Common.tuple_of_list5 ii
in
631 (* iis::lp::rp::iiend::ifakestart::iisto
632 iisto +> List.iter pr_elem; (* static and const *)
637 es
+> List.iter
(fun (e
, opt
) ->
638 assert (List.length opt
<= 1);
639 opt
+> List.iter pr_elem
;
648 | EmptyField iipttvirg_when_emptyfield
->
649 pr_elem iipttvirg_when_emptyfield
651 | CppDirectiveStruct cpp
-> pp_directive cpp
652 | IfdefStruct ifdef
-> pp_ifdef ifdef
654 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
656 and (pp_type_with_ident_rest
: (string * info
) option ->
657 fullType
-> attribute list
-> unit) =
659 fun ident
(((qu
, iiqu
), (ty
, iity
)) as fullt
) attrs
->
661 let print_ident ident
= Common.do_option
(fun (s, iis
) ->
662 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
668 (* the work is to do in base_type !! *)
669 | (NoType
, iis
) -> ()
670 | (BaseType _
, iis
) -> print_ident ident
671 | (Enum
(sopt
, enumt
), iis
) -> print_ident ident
672 | (StructUnion
(_
, sopt
, fields
),iis
) -> print_ident ident
673 | (StructUnionName
(s, structunion
), iis
) -> print_ident ident
674 | (EnumName
s, iis
) -> print_ident ident
675 | (TypeName
(_name
,_typ
), iis
) -> print_ident ident
676 | (TypeOfExpr
(e
), iis
) -> print_ident ident
677 | (TypeOfType
(e
), iis
) -> print_ident ident
681 | (Pointer t
, [i
]) ->
682 (* subtil: void ( *done)(int i) is a Pointer
683 (FunctionType (return=void, params=int i) *)
684 (*WRONG I THINK, use left & right function *)
685 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
687 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
688 pp_type_with_ident_rest ident t attrs
;
690 (* ugly special case ... todo? maybe sufficient in practice *)
691 | (ParenType ttop
, [i1
;i2
]) ->
692 (match Ast_c.get_ty_and_ii ttop
with
693 | (_q1
, (Pointer t2
, [ipointer
])) ->
694 (match Ast_c.get_ty_and_ii t2
with
695 | (q2
, (FunctionType t
, ii3
)) ->
697 pp_type_left
(q2
, mk_tybis
(FunctionType t
) ii3
);
702 pp_type_right
(q2
, mk_tybis
(FunctionType t
) ii3
);
704 pr2 "PB PARENTYPE ZARB, I forget about the ()";
705 pp_type_with_ident_rest ident ttop attrs
;
707 (* another ugly special case *)
708 | _q1
, (Array
(eopt
,t2
), [iarray1
;iarray2
]) ->
709 (match Ast_c.get_ty_and_ii t2
with
710 | (_q2
, (Pointer t3
, [ipointer
])) ->
711 (match Ast_c.get_ty_and_ii t3
with
712 | (q3
, (FunctionType t
, iifunc
)) ->
714 pp_type_left
(q3
, mk_tybis
(FunctionType t
) iifunc
);
719 do_option
pp_expression eopt
;
722 pp_type_right
(q3
, mk_tybis
(FunctionType t
) iifunc
)
724 pr2 "PB PARENTYPE ZARB, I forget about the ()";
725 pp_type_with_ident_rest ident ttop attrs
;
728 pr2 "PB PARENTYPE ZARB, I forget about the ()";
729 pp_type_with_ident_rest ident ttop attrs
;
733 pr2 "PB PARENTYPE ZARB, I forget about the ()";
734 pp_type_with_ident_rest ident ttop attrs
;
738 | (Array
(eopt
, t
), [i1
;i2
]) ->
741 iiqu
+> List.iter pr_elem
;
747 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
750 iiqu
+> List.iter pr_elem
;
756 | (FunctionType _
| Array _
| ParenType _
| Pointer _
), _
->
757 raise
(Impossible
109)
760 and (pp_type_left
: fullType
-> unit) =
761 fun ((qu
, iiqu
), (ty
, iity
)) ->
763 (NoType
,_
) -> failwith
"pp_type_left: unexpected NoType"
764 | (Pointer t
, [i
]) ->
766 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
769 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_type_left t
770 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) -> pp_type_left returnt
772 | (ParenType t
, _
) -> failwith
"parenType"
775 | (BaseType _
, iis
) -> ()
776 | (Enum
(sopt
, enumt
), iis
) -> ()
777 | (StructUnion
(_
, sopt
, fields
),iis
) -> ()
778 | (StructUnionName
(s, structunion
), iis
) -> ()
779 | (EnumName
s, iis
) -> ()
780 | (TypeName
(_name
,_typ
), iis
) -> ()
782 | TypeOfType _
, _
-> ()
783 | TypeOfExpr _
, _
-> ()
785 | (FunctionType _
| Array _
| Pointer _
), _
-> raise
(Impossible
110)
789 let {p_namei
= nameopt
;
790 p_register
= (b
,iib
);
791 p_type
=t
;} = param
in
793 iib
+> List.iter pr_elem
;
799 let (s,i1
) = get_s_and_info_of_name name
in
801 (Some
(s, i1
)) None t
Ast_c.noattr
806 and pp_type_right
(((qu
, iiqu
), (ty
, iity
)) : fullType
) =
808 (NoType
,_
) -> failwith
"pp_type_right: unexpected NoType"
809 | (Pointer t
, [i
]) -> pp_type_right t
811 | (Array
(eopt
, t
), [i1
;i2
]) ->
813 eopt
+> do_option
pp_expression;
817 | (ParenType t
, _
) -> failwith
"parenType"
818 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
822 ts
+> List.iter
(fun (param
,iicomma
) ->
823 assert ((List.length iicomma
) <= 1);
824 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
828 iib
+> List.iter pr_elem
;
832 | (BaseType _
, iis
) -> ()
833 | (Enum
(sopt
, enumt
), iis
) -> ()
834 | (StructUnion
(_
, sopt
, fields
),iis
)-> ()
835 | (StructUnionName
(s, structunion
), iis
) -> ()
836 | (EnumName
s, iis
) -> ()
837 | (TypeName
(name
,_typ
), iis
) -> ()
839 | TypeOfType _
, _
-> ()
840 | TypeOfExpr _
, _
-> ()
842 | (FunctionType _
| Array _
| Pointer _
), _
-> raise
(Impossible
111)
845 pp_type_with_ident None None t
Ast_c.noattr
847 (* ---------------------- *)
848 and pp_decl
= function
849 | DeclList
((({v_namei
= var
;
854 iivirg
::ifakestart
::iisto
) ->
858 (* old: iisto +> List.iter pr_elem; *)
861 (* handling the first var. Special case, we print the whole type *)
863 | Some
(name
, iniopt
) ->
864 let (s,iis
) = get_s_and_info_of_name name
in
866 (Some
(s, iis
)) (Some
(storage
, iisto
))
870 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
871 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
872 pr_elem lp
; pp_arg_list init
; pr_elem rp
873 | Ast_c.ConstrInit _
-> raise
(Impossible
112))
874 | None
-> pp_type returnType
877 (* for other vars, we just call pp_type_with_ident_rest. *)
878 xs
+> List.iter
(function
879 | ({v_namei
= Some
(name
, iniopt
);
881 v_storage
= storage2
;
885 let (s,iis
) = get_s_and_info_of_name name
in
886 assert (storage2
=*= storage
);
887 iivirg
+> List.iter pr_elem
;
888 pp_type_with_ident_rest
889 (Some
(s, iis
)) returnType attrs
;
892 | Ast_c.ValInit
(iini
,init
) -> pr_elem iini
; pp_init init
893 | Ast_c.ConstrInit
((init
,[lp
;rp
])) ->
894 pr_elem lp
; pp_arg_list init
; pr_elem rp
895 | Ast_c.ConstrInit _
-> raise
(Impossible
113));
898 | x
-> raise
(Impossible
114)
903 | MacroDecl
((s, es
, true), iis
::lp
::rp
::iiend
::ifakestart
::iisto
) ->
905 iisto
+> List.iter pr_elem
; (* static and const *)
908 es
+> List.iter
(fun (e
, opt
) ->
909 assert (List.length opt
<= 1);
910 opt
+> List.iter pr_elem
;
917 | MacroDecl
((s, es
, false), iis
::lp
::rp
::ifakestart
::iisto
) ->
919 iisto
+> List.iter pr_elem
; (* static and const *)
922 es
+> List.iter
(fun (e
, opt
) ->
923 assert (List.length opt
<= 1);
924 opt
+> List.iter pr_elem
;
931 ((s, es
, ini
), iis
::lp
::rp
::eq
::iiend
::ifakestart
::iisto
) ->
933 iisto
+> List.iter pr_elem
; (* static and const *)
936 es
+> List.iter
(fun (e
, opt
) ->
937 assert (List.length opt
<= 1);
938 opt
+> List.iter pr_elem
;
947 | (DeclList
(_
, _
) | (MacroDecl _
) | (MacroDeclInit _
)) ->
948 raise
(Impossible
115)
950 (* ---------------------- *)
951 and pp_init
(init
, iinit
) =
952 match init
, iinit
with
953 | InitExpr e
, [] -> pp_expression e
;
954 | InitList xs
, i1
::i2
::iicommaopt
->
955 pr_elem i1
; start_block();
956 xs
+> List.iter
(fun (x
, ii
) ->
957 assert (List.length ii
<= 1);
958 ii
+> List.iter
(function e
-> pr_elem e
; pr_nl
());
961 iicommaopt
+> List.iter pr_elem
;
965 | InitDesignators
(xs
, initialiser
), [i1
] -> (* : *)
966 xs
+> List.iter pp_designator
;
970 (* no use of '=' in the "Old" style *)
971 | InitFieldOld
(string, initialiser
), [i1
;i2
] -> (* label: in oldgcc *)
972 pr_elem i1
; pr_elem i2
; pp_init initialiser
973 | InitIndexOld
(expression
, initialiser
), [i1
;i2
] -> (* [1] in oldgcc *)
974 pr_elem i1
; pp_expression expression
; pr_elem i2
;
977 | (InitIndexOld _
| InitFieldOld _
| InitDesignators _
978 | InitList _
| InitExpr _
979 ), _
-> raise
(Impossible
116)
981 and pp_init_list ini
= pp_list pp_init ini
983 and pp_designator
= function
984 | DesignatorField
(s), [i1
; i2
] ->
985 pr_elem i1
; pr_elem i2
;
986 | DesignatorIndex
(expression
), [i1
;i2
] ->
987 pr_elem i1
; pp_expression expression
; pr_elem i2
;
989 | DesignatorRange
(e1
, e2
), [iocro
;iellipsis
;iccro
] ->
990 pr_elem iocro
; pp_expression e1
; pr_elem iellipsis
;
991 pp_expression e2
; pr_elem iccro
;
993 | (DesignatorField _
| DesignatorIndex _
| DesignatorRange _
994 ), _
-> raise
(Impossible
117)
997 (* ---------------------- *)
998 and pp_attributes pr_elem pr_space attrs
=
999 attrs
+> List.iter
(fun (attr
, ii
) ->
1000 ii
+> List.iter pr_elem
;
1003 (* ---------------------- *)
1005 let defbis, ii
= def
in
1007 | iifunc1
::iifunc2
::i1
::i2
::ifakestart
::isto
->
1009 f_type
= (returnt
, (paramst
, (b
, iib
)));
1017 pp_type_with_ident None
(Some
(sto
, isto
))
1018 returnt
Ast_c.noattr
;
1020 pp_attributes pr_elem pr_space attrs
;
1026 (* not anymore, cf tests/optional_name_parameter and
1027 macro_parameter_shortcut.c
1029 | [(((bool, None, t), ii_b_s), iicomma)] ->
1032 | qu, (BaseType Void, ii) -> true
1035 assert (null iicomma);
1036 assert (null ii_b_s);
1037 pp_type_with_ident None None t
1040 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
1041 iicomma +> List.iter pr_elem;
1043 (match b, s, ii_b_s with
1044 | false, Some s, [i1] ->
1045 pp_type_with_ident (Some (s, i1)) None t;
1046 | true, Some s, [i1;i2] ->
1048 pp_type_with_ident (Some (s, i2)) None t;
1050 (* in definition we have name for params, except when f(void) *)
1051 | _
, None
, _
-> raise Impossible
1052 | false, None
, [] ->
1054 | _
-> raise Impossible
1057 (* normally ii represent the ",..." but it is also abused
1058 with the f(void) case *)
1059 (* assert (List.length iib <= 2);*)
1060 iib
+> List.iter pr_elem
;
1063 pp_param_list paramst
;
1064 iib
+> List.iter pr_elem
;
1067 pr_elem iifunc2
; pr_space
();
1069 statxs
+> List.iter pp_statement_seq
;
1071 | _
-> raise
(Impossible
118)
1073 and pp_param_list paramst
= pp_list pp_param paramst
1075 (* ---------------------- *)
1077 and pp_ifdef ifdef
=
1079 | IfdefDirective
(ifdef
, ii
) ->
1080 List.iter pr_elem ii
1083 and pp_directive
= function
1084 | Include
{i_include
= (s, ii
);} ->
1085 let (i1
,i2
) = Common.tuple_of_list2 ii
in
1086 pr_elem i1
; pr_space
(); pr_elem i2
1087 | Define
((s,ii
), (defkind
, defval
)) ->
1088 let (idefine
,iident
,ieol
) = Common.tuple_of_list3 ii
in
1092 let define_val = function
1093 | DefineExpr e
-> pp_expression e
1094 | DefineStmt st
-> pp_statement st
1095 | DefineDoWhileZero
((st
,e
), ii
) ->
1097 | [ido
;iwhile
;iopar
;icpar
] ->
1100 pr_elem iwhile
; pr_elem iopar
;
1103 | _
-> raise
(Impossible
119)
1105 | DefineFunction def
-> pp_def def
1107 | DefineType ty
-> pp_type ty
1108 | DefineText
(s, ii
) -> List.iter pr_elem ii
1110 | DefineInit ini
-> pp_init ini
1112 ss
+> List.iter pp_statement
1113 | DefineTodo
-> pr2 "DefineTodo"
1116 | DefineVar
| Undef
-> ()
1117 | DefineFunc
(params
, ii
) ->
1118 let (i1
,i2
) = tuple_of_list2 ii
in
1120 params
+> List.iter
(fun ((s,iis
), iicomma
) ->
1121 assert (List.length iicomma
<= 1);
1122 iicomma
+> List.iter pr_elem
;
1123 iis
+> List.iter pr_elem
;
1130 | PragmaAndCo
(ii
) ->
1131 List.iter pr_elem ii
in
1136 let pp_toplevel = function
1137 | Declaration decl
-> pp_decl decl
1138 | Definition def
-> pp_def def
1140 | CppTop directive
-> pp_directive directive
1143 | MacroTop
(s, es
, [i1
;i2
;i3
;i4
]) ->
1146 es
+> List.iter
(fun (e
, opt
) ->
1147 assert (List.length opt
<= 1);
1148 opt
+> List.iter pr_elem
;
1155 | EmptyDef ii
-> ii
+> List.iter pr_elem
1156 | NotParsedCorrectly ii
->
1157 assert (List.length ii
>= 1);
1158 ii
+> List.iter pr_elem
1159 | FinalDef info
-> pr_elem
(Ast_c.rewrap_str
"" info
)
1161 | IfdefTop ifdefdir
-> pp_ifdef ifdefdir
1163 | (MacroTop _
) -> raise
(Impossible
120) in
1169 match F.unwrap n
with
1170 | F.FunHeader
({f_name
=idb
;
1171 f_type
= (rett
, (paramst
,(isvaargs
,iidotsb
)));
1174 f_attr
= attrs
},ii
) ->
1180 attrs +> List.iter (vk_attribute bigf);
1182 paramst +> List.iter (fun (param, iicomma) ->
1183 vk_param bigf param;
1191 (* vk_decl bigf decl *)
1194 | F.ExprStatement
(st
, (eopt
, ii
)) ->
1195 pp_statement
(Ast_c.mk_st
(ExprStatement eopt
) ii
)
1197 | F.IfHeader
(_
, (e
,ii
))
1198 | F.SwitchHeader
(_
, (e
,ii
))
1199 | F.WhileHeader
(_
, (e
,ii
))
1200 | F.DoWhileTail
(e
,ii
) ->
1208 | F.ForHeader
(_st
, ((first
, (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
1210 iif i1; iif i2; iif i3;
1212 e1opt +> do_option (vk_expr bigf);
1213 e2opt +> do_option (vk_expr bigf);
1214 e3opt +> do_option (vk_expr bigf);
1218 | F.MacroIterHeader
(_s
, ((s,es
), ii
)) ->
1221 vk_argument_list bigf es;
1226 | F.ReturnExpr
(_st
, (e
,ii
)) ->
1227 (* iif ii; vk_expr bigf e*)
1231 | F.Case
(_st
, (e
,ii
)) ->
1232 (* iif ii; vk_expr bigf e *)
1235 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
1236 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1241 | F.CaseNode i
-> ()
1244 (* vk_expr bigf e *)
1247 | F.DefineType ft
->
1248 (* vk_type bigf ft *)
1251 | F.DefineHeader
((s,ii
), (defkind
)) ->
1254 vk_define_kind bigf defkind;
1259 | F.DefineDoWhileZeroHeader
(((),ii
)) ->
1264 | F.Include
{i_include
= (s, ii
);} ->
1269 | F.MacroTop
(s, args
, ii
) ->
1271 vk_argument_list bigf args *)
1275 | F.Break
(st
,((),ii
)) ->
1278 | F.Continue
(st
,((),ii
)) ->
1281 | F.Default
(st
,((),ii
)) ->
1284 | F.Return
(st
,((),ii
)) ->
1287 | F.Goto
(st
, name
, ((),ii
)) ->
1290 | F.Label
(st
, name
, ((),ii
)) ->
1293 | F.EndStatement iopt
->
1294 (* do_option infof iopt *)
1296 | F.DoHeader
(st
, info
) ->
1302 | F.SeqEnd
(i
, info
) ->
1305 | F.SeqStart
(st
, i
, info
) ->
1309 | F.MacroStmt
(st
, ((),ii
)) ->
1312 | F.Asm
(st
, (asmbody
,ii
)) ->
1315 vk_asmbody bigf asmbody
1320 | F.IfdefHeader
(info
) ->
1322 | F.IfdefElse
(info
) ->
1324 | F.IfdefEndif
(info
) ->
1331 | (F.TopNode
|F.EndNode
|
1332 F.ErrorExit
|F.Exit
|F.Enter
|F.LoopFallThroughNode
|F.FallThroughNode
|
1333 F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1338 { expression
= pp_expression;
1339 arg_list
= pp_arg_list
;
1341 statement
= pp_statement
;
1344 field_list
= pp_field_list
;
1346 init_list
= pp_init_list
;
1348 paramlist
= pp_param_list
;
1350 type_with_ident
= pp_type_with_ident
;
1351 toplevel
= pp_toplevel;
1355 (*****************************************************************************)
1357 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1359 let s = Ast_c.str_of_info info
in
1360 if !Flag_parsing_c.pretty_print_comment_info
then begin
1361 let before = !(info
.comments_tag
).mbefore
in
1362 if not
(null
before) then begin
1364 before +> List.iter
(fun (comment_like
, pinfo
) ->
1365 let s = pinfo
.Common.str
in
1373 let pr_space _
= Format.print_space
()
1376 let pr_indent _
= ()
1377 let pr_outdent _
= ()
1378 let pr_unindent _
= ()
1383 ~
pr_elem ~
pr_space ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1385 let pp_expression_simple = ppc.expression
1386 let pp_decl_simple = ppc.decl
1387 let pp_field_simple = ppc.field
1388 let pp_statement_simple = ppc.statement
1389 let pp_type_simple = ppc.ty
1390 let pp_init_simple = ppc.init
1391 let pp_toplevel_simple = ppc.toplevel
1392 let pp_flow_simple = ppc.flow
1395 let pp_elem_sp ~
pr_elem ~
pr_space =
1398 ~
pr_nl ~
pr_outdent ~
pr_indent ~
pr_unindent
1400 let pp_expression_gen ~
pr_elem ~
pr_space =
1401 (pp_elem_sp pr_elem pr_space).expression
1403 let pp_arg_list_gen ~
pr_elem ~
pr_space =
1404 (pp_elem_sp pr_elem pr_space).arg_list
1406 let pp_arg_gen ~
pr_elem ~
pr_space =
1407 (pp_elem_sp pr_elem pr_space).arg
1409 let pp_statement_gen ~
pr_elem ~
pr_space =
1410 (pp_elem_sp pr_elem pr_space).statement
1412 let pp_decl_gen ~
pr_elem ~
pr_space =
1413 (pp_elem_sp pr_elem pr_space).decl
1415 let pp_field_gen ~
pr_elem ~
pr_space =
1416 (pp_elem_sp pr_elem pr_space).field
1418 let pp_field_list_gen ~
pr_elem ~
pr_space =
1419 (pp_elem_sp pr_elem pr_space).field_list
1421 let pp_init_gen ~
pr_elem ~
pr_space =
1422 (pp_elem_sp pr_elem pr_space).init
1424 let pp_init_list_gen ~
pr_elem ~
pr_space =
1425 (pp_elem_sp pr_elem pr_space).init_list
1427 let pp_param_gen ~
pr_elem ~
pr_space =
1428 (pp_elem_sp pr_elem pr_space).param
1430 let pp_param_list_gen ~
pr_elem ~
pr_space =
1431 (pp_elem_sp pr_elem pr_space).paramlist
1433 let pp_type_gen ~
pr_elem ~
pr_space =
1434 (pp_elem_sp pr_elem pr_space).ty
1436 let pp_type_with_ident_gen pr_elem pr_space =
1437 (pp_elem_sp pr_elem pr_space).type_with_ident
1439 let pp_program_gen ~
pr_elem ~
pr_space =
1440 (pp_elem_sp pr_elem pr_space).toplevel
1443 let string_of_expression e
=
1444 Common.format_to_string
(fun () ->
1445 pp_expression_simple e
1448 let string_of_toplevel top
=
1449 Common.format_to_string
(fun () ->
1450 pp_toplevel_simple top
1453 let (debug_info_of_node
:
1454 Ograph_extended.nodei
-> Control_flow_c.cflow
-> string) =
1456 let node = flow#nodes#assoc nodei
in
1457 let s = Common.format_to_string
(fun () ->
1460 let pos = Lib_parsing_c.min_pinfo_of_node
node in
1461 (spf
"%s(n%d)--> %s" (Common.string_of_parse_info_bis
pos) nodei
s)