1 (* Yoann Padioleau, Julia Lawall
3 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License (GPL)
7 * version 2 as published by the Free Software Foundation.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * file license.txt for more details.
19 (*****************************************************************************)
21 (*****************************************************************************)
22 let pr2, pr2_once
= Common.mk_pr2_wrappers
Flag_parsing_c.verbose_unparsing
24 (*****************************************************************************)
26 type pr_elem_func
= Ast_c.info
-> unit
27 type pr_space_func
= unit -> unit
28 type pr_nl_func
= unit -> unit
29 type pr_indent_func
= unit -> unit
30 type pr_outdent_func
= unit -> unit
31 type pr_unindent_func
= unit -> unit
33 type expression_printer
= Ast_c.expression
-> unit
34 type arg_list_printer
= Ast_c.argument
Ast_c.wrap2 list
-> unit
35 type statement_printer
= Ast_c.statement
-> unit
36 type declaration_printer
= Ast_c.declaration
-> unit
37 type initialiser_printer
= Ast_c.initialiser
-> unit
38 type param_printer
= Ast_c.parameterType
-> unit
39 type type_printer
= Ast_c.fullType
-> unit
40 type type_with_ident_printer
=
41 (string * Ast_c.info
) option ->
42 (Ast_c.storage
* Ast_c.il
) option -> Ast_c.fullType
->
43 Ast_c.attribute list
-> unit
44 type toplevel_printer
= Ast_c.toplevel
-> unit
45 type flow_printer
= Control_flow_c.node
-> unit
48 type pretty_printers
=
49 {expression
: expression_printer
;
50 arg_list
: arg_list_printer
;
51 statement
: statement_printer
;
52 decl
: declaration_printer
;
53 init
: initialiser_printer
;
54 param
: param_printer
;
56 type_with_ident
: type_with_ident_printer
;
57 toplevel
: toplevel_printer
;
60 module F
= Control_flow_c
62 (*****************************************************************************)
64 (* This module is used by unparse_c, but because unparse_c have also
65 * the list of tokens, pretty_print_c could be useless in the future
66 * (except that the ast_c have some fake tokens not present in the list
67 * of tokens so it's still useful). But this module is also useful to
68 * unparse C when you don't have the ordered list of tokens separately,
69 * or tokens without position information, for instance when you want
70 * to pretty print some piece of C that was generated, or some
71 * abstract-lined piece of code, etc. *)
73 let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent
=
74 let start_block () = pr_nl
(); pr_indent
() in
75 let end_block () = pr_unindent
(); pr_nl
() in
77 let indent_if_needed st f
=
78 match Ast_c.unwrap_st st
with
79 Compound _
-> pr_space
(); f
()
81 (*no newline at the end - someone else will do that*)
82 start_block(); f
(); pr_unindent
() in
84 let rec pp_expression = fun ((exp
, typ
), ii
) ->
86 | Ident
(ident
), [] -> pp_name ident
87 (* only a MultiString can have multiple ii *)
88 | Constant
(MultiString _
), is
-> is
+> List.iter pr_elem
89 | Constant
(c
), [i
] -> pr_elem i
90 | FunCall
(e
, es
), [i1
;i2
] ->
91 pp_expression e
; pr_elem i1
;
95 | CondExpr
(e1
, e2
, e3
), [i1
;i2
] ->
96 pp_expression e1
; pr_space
(); pr_elem i1
; pr_space
();
97 do_option
(function x
-> pp_expression x
; pr_space
()) e2
; pr_elem i2
;
99 | Sequence
(e1
, e2
), [i
] ->
100 pp_expression e1
; pr_elem i
; pr_space
(); pp_expression e2
101 | Assignment
(e1
, op
, e2
), [i
] ->
102 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
104 | Postfix
(e
, op
), [i
] -> pp_expression e
; pr_elem i
;
105 | Infix
(e
, op
), [i
] -> pr_elem i
; pp_expression e
;
106 | Unary
(e
, op
), [i
] -> pr_elem i
; pp_expression e
107 | Binary
(e1
, op
, e2
), [i
] ->
108 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
110 | ArrayAccess
(e1
, e2
), [i1
;i2
] ->
111 pp_expression e1
; pr_elem i1
; pp_expression e2
; pr_elem i2
112 | RecordAccess
(e
, name
), [i1
] ->
113 pp_expression e
; pr_elem i1
; pp_name name
;
114 | RecordPtAccess
(e
, name
), [i1
] ->
115 pp_expression e
; pr_elem i1
; pp_name name
;
117 | SizeOfExpr
(e
), [i
] -> pr_elem i
; pp_expression e
118 | SizeOfType
(t
), [i1
;i2
;i3
] ->
119 pr_elem i1
; pr_elem i2
; pp_type t
; pr_elem i3
120 | Cast
(t
, e
), [i1
;i2
] ->
121 pr_elem i1
; pp_type t
; pr_elem i2
; pp_expression e
123 | StatementExpr
(statxs
, [ii1
;ii2
]), [i1
;i2
] ->
126 statxs
+> List.iter pp_statement_seq
;
129 | Constructor
(t
, xs
), lp
::rp
::i1
::i2
::iicommaopt
->
134 xs
+> List.iter
(fun (x
, ii
) ->
135 assert (List.length ii
<= 1);
136 ii
+> List.iter
(function x
-> pr_elem x
; pr_space
());
139 iicommaopt
+> List.iter pr_elem
;
142 | ParenExpr
(e
), [i1
;i2
] -> pr_elem i1
; pp_expression e
; pr_elem i2
;
144 | (Ident
(_
) | Constant _
| FunCall
(_
,_
) | CondExpr
(_
,_
,_
)
147 | Postfix
(_
,_
) | Infix
(_
,_
) | Unary
(_
,_
) | Binary
(_
,_
,_
)
148 | ArrayAccess
(_
,_
) | RecordAccess
(_
,_
) | RecordPtAccess
(_
,_
)
149 | SizeOfExpr
(_
) | SizeOfType
(_
) | Cast
(_
,_
)
150 | StatementExpr
(_
) | Constructor _
151 | ParenExpr
(_
)),_
-> raise Impossible
154 if !Flag_parsing_c.pretty_print_type_info
156 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"/*");
158 (fun (ty
,_test
) -> ty
+>
160 (fun (x
,l
) -> pp_type x
;
162 Ast_c.LocalVar _
-> ", local"
164 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
s)));
165 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*/");
169 es
+> List.iter
(fun (e
, opt
) ->
170 assert (List.length opt
<= 1); (* opt must be a comma? *)
171 opt
+> List.iter
(function x
-> pr_elem x
; pr_space
());
174 and pp_argument argument
=
175 let rec pp_action (ActMisc ii
) = ii
+> List.iter pr_elem
in
177 | Left e
-> pp_expression e
180 | ArgType param
-> pp_param param
181 | ArgAction action
-> pp_action action
)
183 (* ---------------------- *)
184 and pp_name
= function
185 | RegularName
(s, ii
) ->
186 let (i1
) = Common.tuple_of_list1 ii
in
188 | CppConcatenatedName xs
->
189 xs
+> List.iter
(fun ((x
,ii1
), ii2
) ->
190 ii2
+> List.iter pr_elem
;
191 ii1
+> List.iter pr_elem
;
193 | CppVariadicName
(s, ii
) ->
194 ii
+> List.iter pr_elem
195 | CppIdentBuilder
((s,iis
), xs
) ->
196 let (iis
, iop
, icp
) = Common.tuple_of_list3 iis
in
199 xs
+> List.iter
(fun ((x
,iix
), iicomma
) ->
200 iicomma
+> List.iter pr_elem
;
201 iix
+> List.iter pr_elem
;
205 (* ---------------------- *)
206 and pp_statement
= fun st
->
207 match Ast_c.get_st_and_ii st
with
208 | Labeled
(Label
(name
, st
)), ii
->
209 let (i2
) = Common.tuple_of_list1 ii
in
210 pr_outdent
(); pp_name name
; pr_elem i2
; pr_nl
(); pp_statement st
211 | Labeled
(Case
(e
, st
)), [i1
;i2
] ->
213 pr_elem i1
; pp_expression e
; pr_elem i2
; pr_nl
(); pr_indent
();
215 | Labeled
(CaseRange
(e
, e2
, st
)), [i1
;i2
;i3
] ->
217 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_expression e2
; pr_elem i3
;
218 pr_nl
(); pr_indent
();
220 | Labeled
(Default st
), [i1
;i2
] ->
221 pr_unindent
(); pr_elem i1
; pr_elem i2
; pr_nl
(); pr_indent
();
223 | Compound statxs
, [i1
;i2
] ->
224 pr_elem i1
; start_block();
225 statxs
+> Common.print_between pr_nl pp_statement_seq
;
226 end_block(); pr_elem i2
;
228 | ExprStatement
(None
), [i
] -> pr_elem i
;
229 | ExprStatement
(None
), [] -> ()
230 | ExprStatement
(Some e
), [i
] -> pp_expression e
; pr_elem i
231 (* the last ExprStatement of a for does not have a trailing
232 ';' hence the [] for ii *)
233 | ExprStatement
(Some e
), [] -> pp_expression e
;
234 | Selection
(If
(e
, st1
, st2
)), i1
::i2
::i3
::is
->
235 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
236 indent_if_needed st1
(function _
-> pp_statement st1
);
237 (match (Ast_c.get_st_and_ii st2
, is
) with
238 | ((ExprStatement None
, []), []) -> ()
239 | ((ExprStatement None
, []), [iifakend
]) -> pr_elem iifakend
240 | _st2
, [i4
;iifakend
] -> pr_elem i4
;
241 indent_if_needed st2
(function _
-> pp_statement st2
);
243 | x
-> raise Impossible
245 | Selection
(Switch
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
246 pr_elem i1
; pr_space
(); pr_elem i2
; pp_expression e
; pr_elem i3
;
247 indent_if_needed st
(function _
-> pp_statement st
); pr_elem iifakend
248 | Iteration
(While
(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
(DoWhile
(st
, e
)), [i1
;i2
;i3
;i4
;i5
;iifakend
] ->
253 indent_if_needed st
(function _
-> pp_statement st
);
254 pr_elem i2
; pr_elem i3
; pp_expression e
;
255 pr_elem i4
; pr_elem i5
;
259 | Iteration
(For
((e1opt
,il1
),(e2opt
,il2
),(e3opt
, il3
),st
)),
260 [i1
;i2
;i3
;iifakend
] ->
262 pr_elem i1
; pr_space
();
264 pp_statement
(Ast_c.mk_st
(ExprStatement e1opt
) il1
);
265 pp_statement
(Ast_c.mk_st
(ExprStatement e2opt
) il2
);
267 pp_statement
(Ast_c.mk_st
(ExprStatement e3opt
) il3
);
269 indent_if_needed st
(function _
-> pp_statement st
);
272 | Iteration
(MacroIteration
(s,es
,st
)), [i1
;i2
;i3
;iifakend
] ->
273 pr_elem i1
; pr_space
();
276 es
+> List.iter
(fun (e
, opt
) ->
277 assert (List.length opt
<= 1);
278 opt
+> List.iter pr_elem
;
283 indent_if_needed st
(function _
-> pp_statement st
);
286 | Jump
(Goto name
), ii
->
287 let (i1
, i3
) = Common.tuple_of_list2 ii
in
288 pr_elem i1
; pr_space
(); pp_name name
; pr_elem i3
;
289 | Jump
((Continue
|Break
|Return
)), [i1
;i2
] -> pr_elem i1
; pr_elem i2
;
290 | Jump
(ReturnExpr e
), [i1
;i2
] ->
291 pr_elem i1
; pr_space
(); pp_expression e
; pr_elem i2
292 | Jump
(GotoComputed e
), [i1
;i2
;i3
] ->
293 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
295 | Decl decl
, [] -> pp_decl decl
298 | [iasm
;iopar
;icpar
;iptvirg
] ->
299 pr_elem iasm
; pr_elem iopar
;
301 pr_elem icpar
; pr_elem iptvirg
302 | [iasm
;ivolatile
;iopar
;icpar
;iptvirg
] ->
303 pr_elem iasm
; pr_elem ivolatile
; pr_elem iopar
;
305 pr_elem icpar
; pr_elem iptvirg
306 | _
-> raise Impossible
309 | NestedFunc def
, ii
->
313 ii
+> List.iter pr_elem
;
315 | (Labeled
(Case
(_
,_
))
316 | Labeled
(CaseRange
(_
,_
,_
)) | Labeled
(Default _
)
317 | Compound _
| ExprStatement _
318 | Selection
(If
(_
, _
, _
)) | Selection
(Switch
(_
, _
))
319 | Iteration
(While
(_
, _
)) | Iteration
(DoWhile
(_
, _
))
320 | Iteration
(For
((_
,_
), (_
,_
), (_
, _
), _
))
321 | Iteration
(MacroIteration
(_
,_
,_
))
322 | Jump
((Continue
|Break
|Return
)) | Jump
(ReturnExpr _
)
323 | Jump
(GotoComputed _
)
325 ), _
-> raise Impossible
327 and pp_statement_seq
= function
328 | StmtElem st
-> pp_statement st
329 | IfdefStmt ifdef
-> pp_ifdef ifdef
330 | CppDirectiveStmt cpp
-> pp_directive cpp
331 | IfdefStmt2
(ifdef
, xxs
) -> pp_ifdef_tree_sequence ifdef xxs
333 (* ifdef XXX elsif YYY elsif ZZZ endif *)
334 and pp_ifdef_tree_sequence ifdef xxs
=
338 pp_ifdef_tree_sequence_aux ifxs xxs
339 | _
-> raise Impossible
341 (* XXX elsif YYY elsif ZZZ endif *)
342 and pp_ifdef_tree_sequence_aux ifdefs xxs
=
343 Common.zip ifdefs xxs
+> List.iter
(fun (ifdef
, xs
) ->
344 xs
+> List.iter pp_statement_seq
;
352 (* ---------------------- *)
353 and pp_asmbody
(string_list
, colon_list
) =
354 string_list
+> List.iter pr_elem
;
355 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
356 ii
+> List.iter pr_elem
;
357 xs
+> List.iter
(fun (x
,iicomma
) ->
358 assert ((List.length iicomma
) <= 1);
359 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
361 | ColonMisc
, ii
-> ii
+> List.iter pr_elem
;
362 | ColonExpr e
, [istring
;iopar
;icpar
] ->
367 | (ColonExpr _
), _
-> raise Impossible
)
371 (* ---------------------- *)
376 pp_type_with_ident_rest
383 and (pp_type_with_ident
:
384 (string * info
) option -> (storage
* il
) option ->
385 fullType
-> attribute list
->
387 fun ident sto ft attrs
->
389 (match (ident
, Ast_c.unwrap_typeC ft
) with
390 (Some _
,_
) | (_
,Pointer _
) -> pr_space
()
392 pp_type_with_ident_rest ident ft attrs
395 and (pp_base_type
: fullType
-> (storage
* il
) option -> unit) =
396 fun (qu
, (ty
, iity
)) sto
->
399 | None
-> [] | Some
(s, iis
) -> (*assert (List.length iis = 1);*) iis
401 let print_sto_qu (sto
, (qu
, iiqu
)) =
402 let all_ii = get_sto sto
++ iiqu
in
404 +> List.sort
Ast_c.compare_pos
405 +> Common.print_between pr_space pr_elem
408 let print_sto_qu_ty (sto
, (qu
, iiqu
), iity
) =
409 let all_ii = get_sto sto
++ iiqu
++ iity
in
410 let all_ii2 = all_ii +> List.sort
Ast_c.compare_pos
in
414 (* TODO in fact for pointer, the qualifier is after the type
415 * cf -test strangeorder
418 all_ii2 +> Common.print_between pr_space pr_elem
420 else all_ii2 +> Common.print_between pr_space pr_elem
424 | (Pointer t
, [i
]) -> pp_base_type t sto
425 | (ParenType t
, _
) -> pp_base_type t sto
426 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_base_type t sto
427 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
428 pp_base_type returnt sto
431 | (StructUnion
(su
, sopt
, fields
),iis
) ->
432 print_sto_qu (sto
, qu
);
435 | Some
s , [i1
;i2
;i3
;i4
] ->
436 pr_elem i1
; pr_elem i2
; pr_elem i3
;
437 | None
, [i1
;i2
;i3
] ->
438 pr_elem i1
; pr_elem i2
;
439 | x
-> raise Impossible
446 | DeclarationField
(FieldDeclList
(onefield_multivars
,iiptvirg
))->
447 (match onefield_multivars
with
449 (* handling the first var. Special case, with the
450 first var, we print the whole type *)
453 | (Simple
(nameopt
, typ
)), iivirg
->
454 (* first var cant have a preceding ',' *)
455 assert (List.length iivirg
=|= 0);
459 | Some name
-> Some
(get_s_and_info_of_name name
)
461 pp_type_with_ident
identinfo None typ
Ast_c.noattr
;
463 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
464 (* first var cant have a preceding ',' *)
465 assert (List.length iivirg
=|= 0);
470 let (s, is
) = get_s_and_info_of_name name
in
472 (Some
(s, is
)) None typ
Ast_c.noattr
;
477 ); (* match x, first onefield_multivars *)
480 xs
+> List.iter
(function
481 | (Simple
(nameopt
, typ
)), iivirg
->
482 iivirg
+> List.iter pr_elem
;
486 | Some name
-> Some
(get_s_and_info_of_name name
)
488 pp_type_with_ident_rest
identinfo typ
Ast_c.noattr
490 | (BitField
(nameopt
, typ
, iidot
, expr
)), iivirg
->
491 iivirg
+> List.iter pr_elem
;
494 let (s,is
) = get_s_and_info_of_name name
in
495 pp_type_with_ident_rest
496 (Some
(s, is
)) typ
Ast_c.noattr
;
499 | x
-> raise Impossible
500 )); (* iter other vars *)
502 | [] -> raise Impossible
503 ); (* onefield_multivars *)
504 assert (List.length iiptvirg
=|= 1);
505 iiptvirg
+> List.iter pr_elem
;
508 | MacroDeclField
((s, es
), ii
) ->
509 let (iis
, lp
, rp
, iiend
, ifakestart
) =
510 Common.tuple_of_list5 ii
in
511 (* iis::lp::rp::iiend::ifakestart::iisto
512 iisto +> List.iter pr_elem; (* static and const *)
517 es
+> List.iter
(fun (e
, opt
) ->
518 assert (List.length opt
<= 1);
519 opt
+> List.iter pr_elem
;
528 | EmptyField iipttvirg_when_emptyfield
->
529 pr_elem iipttvirg_when_emptyfield
531 | CppDirectiveStruct cpp
-> pp_directive cpp
532 | IfdefStruct ifdef
-> pp_ifdef ifdef
536 | Some
s , [i1
;i2
;i3
;i4
] -> pr_elem i4
537 | None
, [i1
;i2
;i3
] -> pr_elem i3
;
538 | x
-> raise Impossible
543 | (Enum
(sopt
, enumt
), iis
) ->
544 print_sto_qu (sto
, qu
);
546 (match sopt
, iis
with
547 | (Some
s, ([i1
;i2
;i3
;i4
]|[i1
;i2
;i3
;i4
;_
])) ->
548 pr_elem i1
; pr_elem i2
; pr_elem i3
;
549 | (None
, ([i1
;i2
;i3
]|[i1
;i2
;i3
;_
])) ->
550 pr_elem i1
; pr_elem i2
551 | x
-> raise Impossible
554 enumt
+> List.iter
(fun ((name
, eopt
), iicomma
) ->
555 assert (List.length iicomma
<= 1);
556 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
558 eopt
+> Common.do_option
(fun (ieq
, e
) ->
563 (match sopt
, iis
with
564 | (Some
s, [i1
;i2
;i3
;i4
]) -> pr_elem i4
565 | (Some
s, [i1
;i2
;i3
;i4
;i5
]) ->
566 pr_elem i5
; pr_elem i4
(* trailing comma *)
567 | (None
, [i1
;i2
;i3
]) -> pr_elem i3
568 | (None
, [i1
;i2
;i3
;i4
]) ->
569 pr_elem i4
; pr_elem i3
(* trailing comma *)
572 | x
-> raise Impossible
576 | (BaseType _
, iis
) ->
577 print_sto_qu_ty (sto
, qu
, iis
);
579 | (StructUnionName
(s, structunion
), iis
) ->
580 assert (List.length iis
=|= 2);
581 print_sto_qu_ty (sto
, qu
, iis
);
583 | (EnumName
s, iis
) ->
584 assert (List.length iis
=|= 2);
585 print_sto_qu_ty (sto
, qu
, iis
);
587 | (TypeName
(name
,typ
), noii
) ->
589 let (_s
, iis
) = get_s_and_info_of_name name
in
590 print_sto_qu_ty (sto
, qu
, [iis
]);
592 if !Flag_parsing_c.pretty_print_typedef_value
594 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"{*");
595 typ
+> Common.do_option
(fun typ
->
598 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*}");
601 | (TypeOfExpr
(e
), iis
) ->
602 print_sto_qu (sto
, qu
);
604 | [itypeof
;iopar
;icpar
] ->
605 pr_elem itypeof
; pr_elem iopar
;
608 | _
-> raise Impossible
611 | (TypeOfType
(t
), iis
) ->
612 print_sto_qu (sto
, qu
);
614 | [itypeof
;iopar
;icpar
] ->
615 pr_elem itypeof
; pr_elem iopar
;
618 | _
-> raise Impossible
621 | (Pointer _
| (*ParenType _ |*) Array _
| FunctionType _
622 (* | StructUnion _ | Enum _ | BaseType _ *)
623 (* | StructUnionName _ | EnumName _ | TypeName _ *)
624 (* | TypeOfExpr _ | TypeOfType _ *)
625 ), _
-> raise Impossible
629 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
631 and (pp_type_with_ident_rest
: (string * info
) option ->
632 fullType
-> attribute list
-> unit) =
634 fun ident
(((qu
, iiqu
), (ty
, iity
)) as fullt
) attrs
->
636 let print_ident ident
= Common.do_option
(fun (s, iis
) ->
637 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
643 (* the work is to do in base_type !! *)
644 | (BaseType _
, iis
) -> print_ident ident
645 | (Enum
(sopt
, enumt
), iis
) -> print_ident ident
646 | (StructUnion
(_
, sopt
, fields
),iis
) -> print_ident ident
647 | (StructUnionName
(s, structunion
), iis
) -> print_ident ident
648 | (EnumName
s, iis
) -> print_ident ident
649 | (TypeName
(_name
,_typ
), iis
) -> print_ident ident
650 | (TypeOfExpr
(e
), iis
) -> print_ident ident
651 | (TypeOfType
(e
), iis
) -> print_ident ident
655 | (Pointer t
, [i
]) ->
656 (* subtil: void ( *done)(int i) is a Pointer
657 (FunctionType (return=void, params=int i) *)
658 (*WRONG I THINK, use left & right function *)
659 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
661 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
662 pp_type_with_ident_rest ident t attrs
;
664 (* ugly special case ... todo? maybe sufficient in practice *)
665 | (ParenType ttop
, [i1
;i2
]) ->
666 (match Ast_c.get_ty_and_ii ttop
with
667 | (_q1
, (Pointer t2
, [ipointer
])) ->
668 (match Ast_c.get_ty_and_ii t2
with
669 | (q2
, (FunctionType t
, ii3
)) ->
671 pp_type_left
(q2
, mk_tybis
(FunctionType t
) ii3
);
676 pp_type_right
(q2
, mk_tybis
(FunctionType t
) ii3
);
678 pr2 "PB PARENTYPE ZARB, I forget about the ()";
679 pp_type_with_ident_rest ident ttop attrs
;
681 (* another ugly special case *)
682 | _q1
, (Array
(eopt
,t2
), [iarray1
;iarray2
]) ->
683 (match Ast_c.get_ty_and_ii t2
with
684 | (_q2
, (Pointer t3
, [ipointer
])) ->
685 (match Ast_c.get_ty_and_ii t3
with
686 | (q3
, (FunctionType t
, iifunc
)) ->
688 pp_type_left
(q3
, mk_tybis
(FunctionType t
) iifunc
);
693 do_option
pp_expression eopt
;
696 pp_type_right
(q3
, mk_tybis
(FunctionType t
) iifunc
)
698 pr2 "PB PARENTYPE ZARB, I forget about the ()";
699 pp_type_with_ident_rest ident ttop attrs
;
702 pr2 "PB PARENTYPE ZARB, I forget about the ()";
703 pp_type_with_ident_rest ident ttop attrs
;
707 pr2 "PB PARENTYPE ZARB, I forget about the ()";
708 pp_type_with_ident_rest ident ttop attrs
;
712 | (Array
(eopt
, t
), [i1
;i2
]) ->
715 iiqu
+> List.iter pr_elem
;
721 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
724 iiqu
+> List.iter pr_elem
;
730 | (FunctionType _
| Array _
| ParenType _
| Pointer _
), _
->
734 and (pp_type_left
: fullType
-> unit) =
735 fun ((qu
, iiqu
), (ty
, iity
)) ->
737 | (Pointer t
, [i
]) ->
739 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
742 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_type_left t
743 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) -> pp_type_left returnt
745 | (ParenType t
, _
) -> failwith
"parenType"
748 | (BaseType _
, iis
) -> ()
749 | (Enum
(sopt
, enumt
), iis
) -> ()
750 | (StructUnion
(_
, sopt
, fields
),iis
) -> ()
751 | (StructUnionName
(s, structunion
), iis
) -> ()
752 | (EnumName
s, iis
) -> ()
753 | (TypeName
(_name
,_typ
), iis
) -> ()
755 | TypeOfType _
, _
-> ()
756 | TypeOfExpr _
, _
-> ()
758 | (FunctionType _
| Array _
| Pointer _
), _
-> raise Impossible
762 let {p_namei
= nameopt
;
763 p_register
= (b
,iib
);
764 p_type
=t
;} = param
in
766 iib
+> List.iter pr_elem
;
772 let (s,i1
) = get_s_and_info_of_name name
in
774 (Some
(s, i1
)) None t
Ast_c.noattr
779 and pp_type_right
(((qu
, iiqu
), (ty
, iity
)) : fullType
) =
781 | (Pointer t
, [i
]) -> pp_type_right t
783 | (Array
(eopt
, t
), [i1
;i2
]) ->
785 eopt
+> do_option
pp_expression;
789 | (ParenType t
, _
) -> failwith
"parenType"
790 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
794 ts
+> List.iter
(fun (param
,iicomma
) ->
795 assert ((List.length iicomma
) <= 1);
796 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
800 iib
+> List.iter pr_elem
;
804 | (BaseType _
, iis
) -> ()
805 | (Enum
(sopt
, enumt
), iis
) -> ()
806 | (StructUnion
(_
, sopt
, fields
),iis
)-> ()
807 | (StructUnionName
(s, structunion
), iis
) -> ()
808 | (EnumName
s, iis
) -> ()
809 | (TypeName
(name
,_typ
), iis
) -> ()
811 | TypeOfType _
, _
-> ()
812 | TypeOfExpr _
, _
-> ()
814 | (FunctionType _
| Array _
| Pointer _
), _
-> raise Impossible
817 pp_type_with_ident None None t
Ast_c.noattr
819 (* ---------------------- *)
820 and pp_decl
= function
821 | DeclList
((({v_namei
= var
;
826 iivirg
::ifakestart
::iisto
) ->
830 (* old: iisto +> List.iter pr_elem; *)
833 (* handling the first var. Special case, we print the whole type *)
835 | Some
(name
, iniopt
) ->
836 let (s,iis
) = get_s_and_info_of_name name
in
838 (Some
(s, iis
)) (Some
(storage
, iisto
))
840 iniopt
+> do_option
(fun (iini
, init
) ->
843 | None
-> pp_type returnType
846 (* for other vars, we just call pp_type_with_ident_rest. *)
847 xs
+> List.iter
(function
848 | ({v_namei
= Some
(name
, iniopt
);
850 v_storage
= storage2
;
854 let (s,iis
) = get_s_and_info_of_name name
in
855 assert (storage2
=*= storage
);
856 iivirg
+> List.iter pr_elem
;
857 pp_type_with_ident_rest
858 (Some
(s, iis
)) returnType attrs
;
859 iniopt
+> do_option
(fun (iini
, init
) ->
860 pr_elem iini
; pp_init init
864 | x
-> raise Impossible
869 | MacroDecl
((s, es
), iis
::lp
::rp
::iiend
::ifakestart
::iisto
) ->
871 iisto
+> List.iter pr_elem
; (* static and const *)
874 es
+> List.iter
(fun (e
, opt
) ->
875 assert (List.length opt
<= 1);
876 opt
+> List.iter pr_elem
;
883 | (DeclList
(_
, _
) | (MacroDecl _
)) -> raise Impossible
886 (* ---------------------- *)
887 and pp_init
(init
, iinit
) =
888 match init
, iinit
with
889 | InitExpr e
, [] -> pp_expression e
;
890 | InitList xs
, i1
::i2
::iicommaopt
->
891 pr_elem i1
; start_block();
892 xs
+> List.iter
(fun (x
, ii
) ->
893 assert (List.length ii
<= 1);
894 ii
+> List.iter
(function e
-> pr_elem e
; pr_nl
());
897 iicommaopt
+> List.iter pr_elem
;
901 | InitDesignators
(xs
, initialiser
), [i1
] -> (* : *)
902 xs
+> List.iter pp_designator
;
906 (* no use of '=' in the "Old" style *)
907 | InitFieldOld
(string, initialiser
), [i1
;i2
] -> (* label: in oldgcc *)
908 pr_elem i1
; pr_elem i2
; pp_init initialiser
909 | InitIndexOld
(expression
, initialiser
), [i1
;i2
] -> (* [1] in oldgcc *)
910 pr_elem i1
; pp_expression expression
; pr_elem i2
;
913 | (InitIndexOld _
| InitFieldOld _
| InitDesignators _
914 | InitList _
| InitExpr _
915 ), _
-> raise Impossible
919 and pp_designator
= function
920 | DesignatorField
(s), [i1
; i2
] ->
921 pr_elem i1
; pr_elem i2
;
922 | DesignatorIndex
(expression
), [i1
;i2
] ->
923 pr_elem i1
; pp_expression expression
; pr_elem i2
;
925 | DesignatorRange
(e1
, e2
), [iocro
;iellipsis
;iccro
] ->
926 pr_elem iocro
; pp_expression e1
; pr_elem iellipsis
;
927 pp_expression e2
; pr_elem iccro
;
929 | (DesignatorField _
| DesignatorIndex _
| DesignatorRange _
930 ), _
-> raise Impossible
933 (* ---------------------- *)
934 and pp_attributes pr_elem pr_space attrs
=
935 attrs
+> List.iter
(fun (attr
, ii
) ->
936 ii
+> List.iter pr_elem
;
939 (* ---------------------- *)
941 let defbis, ii
= def
in
943 | iifunc1
::iifunc2
::i1
::i2
::ifakestart
::isto
->
945 f_type
= (returnt
, (paramst
, (b
, iib
)));
953 pp_type_with_ident None
(Some
(sto
, isto
))
954 returnt
Ast_c.noattr
;
956 pp_attributes pr_elem pr_space attrs
;
961 (* not anymore, cf tests/optional_name_parameter and
962 macro_parameter_shortcut.c
964 | [(((bool, None, t), ii_b_s), iicomma)] ->
967 | qu, (BaseType Void, ii) -> true
970 assert (null iicomma);
971 assert (null ii_b_s);
972 pp_type_with_ident None None t
975 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
976 iicomma +> List.iter pr_elem;
978 (match b, s, ii_b_s with
979 | false, Some s, [i1] ->
980 pp_type_with_ident (Some (s, i1)) None t;
981 | true, Some s, [i1;i2] ->
983 pp_type_with_ident (Some (s, i2)) None t;
985 (* in definition we have name for params, except when f(void) *)
986 | _
, None
, _
-> raise Impossible
989 | _
-> raise Impossible
992 (* normally ii represent the ",..." but it is also abused
993 with the f(void) case *)
994 (* assert (List.length iib <= 2);*)
995 iib
+> List.iter pr_elem
;
998 paramst
+> List.iter
(fun (param
,iicomma
) ->
999 assert ((List.length iicomma
) <= 1);
1000 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
1004 iib
+> List.iter pr_elem
;
1009 statxs
+> List.iter pp_statement_seq
;
1011 | _
-> raise Impossible
1015 (* ---------------------- *)
1017 and pp_ifdef ifdef
=
1019 | IfdefDirective
(ifdef
, ii
) ->
1020 List.iter pr_elem ii
1023 and pp_directive
= function
1024 | Include
{i_include
= (s, ii
);} ->
1025 let (i1
,i2
) = Common.tuple_of_list2 ii
in
1026 pr_elem i1
; pr_elem i2
1027 | Define
((s,ii
), (defkind
, defval
)) ->
1028 let (idefine
,iident
,ieol
) = Common.tuple_of_list3 ii
in
1032 let define_val = function
1033 | DefineExpr e
-> pp_expression e
1034 | DefineStmt st
-> pp_statement st
1035 | DefineDoWhileZero
((st
,e
), ii
) ->
1037 | [ido
;iwhile
;iopar
;icpar
] ->
1040 pr_elem iwhile
; pr_elem iopar
;
1043 | _
-> raise Impossible
1045 | DefineFunction def
-> pp_def def
1047 | DefineType ty
-> pp_type ty
1048 | DefineText
(s, ii
) -> List.iter pr_elem ii
1050 | DefineInit ini
-> pp_init ini
1052 | DefineTodo
-> pr2 "DefineTodo"
1056 | DefineFunc
(params
, ii
) ->
1057 let (i1
,i2
) = tuple_of_list2 ii
in
1059 params
+> List.iter
(fun ((s,iis
), iicomma
) ->
1060 assert (List.length iicomma
<= 1);
1061 iicomma
+> List.iter pr_elem
;
1062 iis
+> List.iter pr_elem
;
1070 List.iter pr_elem ii
1071 | PragmaAndCo
(ii
) ->
1072 List.iter pr_elem ii
in
1077 let pp_toplevel = function
1078 | Declaration decl
-> pp_decl decl
1079 | Definition def
-> pp_def def
1081 | CppTop directive
-> pp_directive directive
1084 | MacroTop
(s, es
, [i1
;i2
;i3
;i4
]) ->
1087 es
+> List.iter
(fun (e
, opt
) ->
1088 assert (List.length opt
<= 1);
1089 opt
+> List.iter pr_elem
;
1096 | EmptyDef ii
-> ii
+> List.iter pr_elem
1097 | NotParsedCorrectly ii
->
1098 assert (List.length ii
>= 1);
1099 ii
+> List.iter pr_elem
1100 | FinalDef info
-> pr_elem
(Ast_c.rewrap_str
"" info
)
1102 | IfdefTop ifdefdir
-> pp_ifdef ifdefdir
1104 | (MacroTop _
) -> raise Impossible
in
1110 match F.unwrap n
with
1111 | F.FunHeader
({f_name
=idb
;
1112 f_type
= (rett
, (paramst
,(isvaargs
,iidotsb
)));
1115 f_attr
= attrs
},ii
) ->
1121 attrs +> List.iter (vk_attribute bigf);
1123 paramst +> List.iter (fun (param, iicomma) ->
1124 vk_param bigf param;
1132 (* vk_decl bigf decl *)
1135 | F.ExprStatement
(st
, (eopt
, ii
)) ->
1136 pp_statement
(Ast_c.mk_st
(ExprStatement eopt
) ii
)
1138 | F.IfHeader
(_
, (e
,ii
))
1139 | F.SwitchHeader
(_
, (e
,ii
))
1140 | F.WhileHeader
(_
, (e
,ii
))
1141 | F.DoWhileTail
(e
,ii
) ->
1149 | F.ForHeader
(_st
, (((e1opt
,i1
), (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
1151 iif i1; iif i2; iif i3;
1153 e1opt +> do_option (vk_expr bigf);
1154 e2opt +> do_option (vk_expr bigf);
1155 e3opt +> do_option (vk_expr bigf);
1159 | F.MacroIterHeader
(_s
, ((s,es
), ii
)) ->
1162 vk_argument_list bigf es;
1167 | F.ReturnExpr
(_st
, (e
,ii
)) ->
1168 (* iif ii; vk_expr bigf e*)
1172 | F.Case
(_st
, (e
,ii
)) ->
1173 (* iif ii; vk_expr bigf e *)
1176 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
1177 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1182 | F.CaseNode i
-> ()
1185 (* vk_expr bigf e *)
1188 | F.DefineType ft
->
1189 (* vk_type bigf ft *)
1192 | F.DefineHeader
((s,ii
), (defkind
)) ->
1195 vk_define_kind bigf defkind;
1200 | F.DefineDoWhileZeroHeader
(((),ii
)) ->
1205 | F.Include
{i_include
= (s, ii
);} ->
1210 | F.MacroTop
(s, args
, ii
) ->
1212 vk_argument_list bigf args *)
1216 | F.Break
(st
,((),ii
)) ->
1219 | F.Continue
(st
,((),ii
)) ->
1222 | F.Default
(st
,((),ii
)) ->
1225 | F.Return
(st
,((),ii
)) ->
1228 | F.Goto
(st
, name
, ((),ii
)) ->
1231 | F.Label
(st
, name
, ((),ii
)) ->
1234 | F.EndStatement iopt
->
1235 (* do_option infof iopt *)
1237 | F.DoHeader
(st
, info
) ->
1243 | F.SeqEnd
(i
, info
) ->
1246 | F.SeqStart
(st
, i
, info
) ->
1250 | F.MacroStmt
(st
, ((),ii
)) ->
1253 | F.Asm
(st
, (asmbody
,ii
)) ->
1256 vk_asmbody bigf asmbody
1261 | F.IfdefHeader
(info
) ->
1263 | F.IfdefElse
(info
) ->
1265 | F.IfdefEndif
(info
) ->
1272 | (F.TopNode
|F.EndNode
|
1273 F.ErrorExit
|F.Exit
|F.Enter
|
1274 F.FallThroughNode
|F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1279 {expression
= pp_expression;
1280 arg_list
= pp_arg_list
;
1281 statement
= pp_statement
;
1286 type_with_ident
= pp_type_with_ident
;
1287 toplevel
= pp_toplevel;
1290 (*****************************************************************************)
1292 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1294 let s = Ast_c.str_of_info info
in
1295 if !Flag_parsing_c.pretty_print_comment_info
then begin
1296 let before = !(info
.comments_tag
).mbefore
in
1297 if not
(null
before) then begin
1299 before +> List.iter
(fun (comment_like
, pinfo
) ->
1300 let s = pinfo
.Common.str
in
1308 let pr_space _
= Format.print_space
()
1311 let pr_indent _
= ()
1312 let pr_outdent _
= ()
1313 let pr_unindent _
= ()
1316 pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent
1318 let pp_expression_simple = ppc.expression
1319 let pp_statement_simple = ppc.statement
1320 let pp_type_simple = ppc.ty
1321 let pp_init_simple = ppc.init
1322 let pp_toplevel_simple = ppc.toplevel
1323 let pp_flow_simple = ppc.flow
1325 let pp_elem_sp pr_elem pr_space =
1326 pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent
1328 let pp_expression_gen pr_elem pr_space =
1329 (pp_elem_sp pr_elem pr_space).expression
1331 let pp_arg_list_gen pr_elem pr_space =
1332 (pp_elem_sp pr_elem pr_space).arg_list
1334 let pp_statement_gen pr_elem pr_space =
1335 (pp_elem_sp pr_elem pr_space).statement
1337 let pp_decl_gen pr_elem pr_space =
1338 (pp_elem_sp pr_elem pr_space).decl
1340 let pp_init_gen pr_elem pr_space =
1341 (pp_elem_sp pr_elem pr_space).init
1343 let pp_param_gen pr_elem pr_space =
1344 (pp_elem_sp pr_elem pr_space).param
1346 let pp_type_gen pr_elem pr_space =
1347 (pp_elem_sp pr_elem pr_space).ty
1349 let pp_type_with_ident_gen pr_elem pr_space =
1350 (pp_elem_sp pr_elem pr_space).type_with_ident
1352 let pp_program_gen pr_elem pr_space =
1353 (pp_elem_sp pr_elem pr_space).toplevel
1357 let string_of_expression e
=
1358 Common.format_to_string
(fun () ->
1359 pp_expression_simple e
1362 let string_of_toplevel top
=
1363 Common.format_to_string
(fun () ->
1364 pp_toplevel_simple top
1367 let (debug_info_of_node
:
1368 Ograph_extended.nodei
-> Control_flow_c.cflow
-> string) =
1370 let node = flow#nodes#assoc nodei
in
1371 let s = Common.format_to_string
(fun () ->
1374 let pos = Lib_parsing_c.min_pinfo_of_node
node in
1375 (spf
"%s(n%d)--> %s" (Common.string_of_parse_info_bis
pos) nodei
s)