1 (* Copyright (C) 2006, 2007, 2008 Yoann Padioleau
3 * This program is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU General Public License (GPL)
5 * version 2 as published by the Free Software Foundation.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * file license.txt for more details.
16 type pr_elem_func
= Ast_c.info
-> unit
17 type pr_space_func
= unit -> unit
19 module F
= Control_flow_c
21 (*****************************************************************************)
23 (* This module is used by unparse_c, but because unparse_c have also
24 * the list of tokens, pretty_print_c could be useless in the futur
25 * (except that the ast_c have some fake tokens not present in the list
26 * of tokens so it's still useful). But this module is also useful to
27 * unparse C when you don't have the ordered list of tokens separately,
28 * or tokens without position information, for instance when you want
29 * to pretty print some piece of C that was generated, or some
30 * abstract-lined piece of code, etc. *)
32 let rec pp_expression_gen pr_elem pr_space
=
33 (* subtil: dont try to shorten the def of pp_statement by omitting e,
34 otherwise get infinite funcall and huge memory consumption *)
35 let _pp_statement e
= pp_statement_gen pr_elem pr_space e
in
37 let rec pp_expression = fun ((exp
, typ
), ii
) ->
39 | Ident
(c
), [i
] -> pr_elem i
40 (* only a MultiString can have multiple ii *)
41 | Constant
(MultiString
), is
-> is
+> List.iter pr_elem
42 | Constant
(c
), [i
] -> pr_elem i
43 | FunCall
(e
, es
), [i1
;i2
] ->
44 pp_expression e
; pr_elem i1
;
45 es
+> List.iter
(fun (e
, opt
) ->
46 assert (List.length opt
<= 1); (* opt must be a comma? *)
47 opt
+> List.iter
(function x
-> pr_elem x
; pr_space
());
48 pp_argument_gen pr_elem pr_space e
;
52 | CondExpr
(e1
, e2
, e3
), [i1
;i2
] ->
53 pp_expression e1
; pr_space
(); pr_elem i1
; pr_space
();
54 do_option
(function x
-> pp_expression x
; pr_space
()) e2
; pr_elem i2
;
56 | Sequence
(e1
, e2
), [i
] ->
57 pp_expression e1
; pr_elem i
; pr_space
(); pp_expression e2
58 | Assignment
(e1
, op
, e2
), [i
] ->
59 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
61 | Postfix
(e
, op
), [i
] -> pp_expression e
; pr_elem i
;
62 | Infix
(e
, op
), [i
] -> pr_elem i
; pp_expression e
;
63 | Unary
(e
, op
), [i
] -> pr_elem i
; pp_expression e
64 | Binary
(e1
, op
, e2
), [i
] ->
65 pp_expression e1
; pr_space
(); pr_elem i
; pr_space
(); pp_expression e2
67 | ArrayAccess
(e1
, e2
), [i1
;i2
] ->
68 pp_expression e1
; pr_elem i1
; pp_expression e2
; pr_elem i2
69 | RecordAccess
(e
, s
), [i1
;i2
] ->
70 pp_expression e
; pr_elem i1
; pr_elem i2
71 | RecordPtAccess
(e
, s
), [i1
;i2
] ->
72 pp_expression e
; pr_elem i1
; pr_elem i2
74 | SizeOfExpr
(e
), [i
] -> pr_elem i
; pp_expression e
75 | SizeOfType
(t
), [i1
;i2
;i3
] ->
76 pr_elem i1
; pr_elem i2
; pp_type_gen pr_elem pr_space t
;
78 | Cast
(t
, e
), [i1
;i2
] ->
79 pr_elem i1
; pp_type_gen pr_elem pr_space t
; pr_elem i2
;
82 | StatementExpr
(statxs
, [ii1
;ii2
]), [i1
;i2
] ->
85 statxs
+> List.iter
(pp_statement_seq_gen pr_elem pr_space
);
88 | Constructor
(t
, xs
), lp
::rp
::i1
::i2
::iicommaopt
->
90 pp_type_gen pr_elem pr_space t
;
93 xs
+> List.iter
(fun (x
, ii
) ->
94 assert (List.length ii
<= 1);
95 ii
+> List.iter
(function x
-> pr_elem x
; pr_space
());
96 pp_init_gen pr_elem pr_space x
98 iicommaopt
+> List.iter pr_elem
;
103 | ParenExpr
(e
), [i1
;i2
] -> pr_elem i1
; pp_expression e
; pr_elem i2
;
105 | (Ident
(_
) | Constant _
| FunCall
(_
,_
) | CondExpr
(_
,_
,_
)
108 | Postfix
(_
,_
) | Infix
(_
,_
) | Unary
(_
,_
) | Binary
(_
,_
,_
)
109 | ArrayAccess
(_
,_
) | RecordAccess
(_
,_
) | RecordPtAccess
(_
,_
)
110 | SizeOfExpr
(_
) | SizeOfType
(_
) | Cast
(_
,_
)
111 | StatementExpr
(_
) | Constructor _
113 ),_
-> raise Impossible
116 if !Flag_parsing_c.pretty_print_type_info
118 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"/*");
120 (fun (ty
,_test
) -> ty
+>
122 (fun (x
,l
) -> pp_type_gen pr_elem pr_space x
;
124 Ast_c.LocalVar _
-> ", local"
126 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
s)));
127 pr_elem
(Ast_c.fakeInfo
() +> Ast_c.rewrap_str
"*/");
134 and pp_argument_gen pr_elem pr_space argument
=
135 let rec pp_action = function
136 | (ActMisc ii
) -> ii
+> List.iter pr_elem
139 | Left e
-> pp_expression_gen pr_elem pr_space e
142 | ArgType param
-> pp_param_gen pr_elem pr_space param
143 | ArgAction action
-> pp_action action
150 (* ---------------------- *)
151 and pp_statement_gen pr_elem pr_space
=
152 let pp_expression e
= pp_expression_gen pr_elem pr_space e
in
153 let rec pp_statement = function
154 | Labeled
(Label
(s, st
)), [i1
;i2
] ->
155 pr_elem i1
; pr_elem i2
; pp_statement st
156 | Labeled
(Case
(e
, st
)), [i1
;i2
] ->
157 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_statement st
158 | Labeled
(CaseRange
(e
, e2
, st
)), [i1
;i2
;i3
] ->
159 pr_elem i1
; pp_expression e
; pr_elem i2
; pp_expression e2
; pr_elem i3
;
161 | Labeled
(Default st
), [i1
;i2
] -> pr_elem i1
; pr_elem i2
; pp_statement st
162 | Compound statxs
, [i1
;i2
] ->
164 statxs
+> List.iter
(pp_statement_seq_gen pr_elem pr_space
);
167 | ExprStatement
(None
), [i
] -> pr_elem i
;
168 | ExprStatement
(None
), [] -> ()
169 | ExprStatement
(Some e
), [i
] -> pp_expression e
; pr_elem i
170 (* the last ExprStatement of a for does not have a trailing
171 ';' hence the [] for ii *)
172 | ExprStatement
(Some e
), [] -> pp_expression e
;
173 | Selection
(If
(e
, st1
, st2
)), i1
::i2
::i3
::is
->
174 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
; pp_statement st1
;
175 (match (st2
, is
) with
176 | ((ExprStatement None
, []), []) -> ()
177 | ((ExprStatement None
, []), [iifakend
]) -> pr_elem iifakend
178 | st2
, [i4
;iifakend
] -> pr_elem i4
; pp_statement st2
; pr_elem iifakend
179 | x
-> raise Impossible
181 | Selection
(Switch
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
182 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
; pp_statement st
;
184 | Iteration
(While
(e
, st
)), [i1
;i2
;i3
;iifakend
] ->
185 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
; pp_statement st
;
187 | Iteration
(DoWhile
(st
, e
)), [i1
;i2
;i3
;i4
;i5
;iifakend
] ->
188 pr_elem i1
; pp_statement st
; pr_elem i2
; pr_elem i3
; pp_expression e
;
189 pr_elem i4
; pr_elem i5
;
193 | Iteration
(For
((e1opt
,il1
),(e2opt
,il2
),(e3opt
, il3
),st
)),
194 [i1
;i2
;i3
;iifakend
] ->
198 pp_statement (ExprStatement e1opt
, il1
);
199 pp_statement (ExprStatement e2opt
, il2
);
201 pp_statement (ExprStatement e3opt
, il3
);
206 | Iteration
(MacroIteration
(s,es
,st
)), [i1
;i2
;i3
;iifakend
] ->
210 es
+> List.iter
(fun (e
, opt
) ->
211 assert (List.length opt
<= 1);
212 opt
+> List.iter pr_elem
;
213 pp_argument_gen pr_elem pr_space e
;
220 | Jump
(Goto
s), [i1
;i2
;i3
] ->
221 pr_elem i1
; pr_space
(); pr_elem i2
; pr_elem i3
;
222 | Jump
((Continue
|Break
|Return
)), [i1
;i2
] -> pr_elem i1
; pr_elem i2
;
223 | Jump
(ReturnExpr e
), [i1
;i2
] ->
224 pr_elem i1
; pr_space
(); pp_expression e
; pr_elem i2
225 | Jump
(GotoComputed e
), [i1
;i2
;i3
] ->
226 pr_elem i1
; pr_elem i2
; pp_expression e
; pr_elem i3
228 | Decl decl
, [] -> pp_decl_gen pr_elem pr_space decl
231 | [iasm
;iopar
;icpar
;iptvirg
] ->
232 pr_elem iasm
; pr_elem iopar
;
233 pp_asmbody_gen pr_elem pr_space asmbody
;
234 pr_elem icpar
; pr_elem iptvirg
235 | [iasm
;ivolatile
;iopar
;icpar
;iptvirg
] ->
236 pr_elem iasm
; pr_elem ivolatile
; pr_elem iopar
;
237 pp_asmbody_gen pr_elem pr_space asmbody
;
238 pr_elem icpar
; pr_elem iptvirg
239 | _
-> raise Impossible
242 | NestedFunc def
, ii
->
244 pp_def_gen pr_elem pr_space def
246 ii
+> List.iter pr_elem
;
248 | ( Labeled
(Label
(_
,_
)) | Labeled
(Case
(_
,_
))
249 | Labeled
(CaseRange
(_
,_
,_
)) | Labeled
(Default _
)
250 | Compound _
| ExprStatement _
251 | Selection
(If
(_
, _
, _
)) | Selection
(Switch
(_
, _
))
252 | Iteration
(While
(_
, _
)) | Iteration
(DoWhile
(_
, _
))
253 | Iteration
(For
((_
,_
), (_
,_
), (_
, _
), _
))
254 | Iteration
(MacroIteration
(_
,_
,_
))
255 | Jump
(Goto _
) | Jump
((Continue
|Break
|Return
)) | Jump
(ReturnExpr _
)
256 | Jump
(GotoComputed _
)
258 ), _
-> raise Impossible
263 and pp_statement_seq_gen pr_elem pr_space stseq
=
266 pp_statement_gen pr_elem pr_space st
267 | IfdefStmt ifdef
-> pp_ifdef_gen pr_elem pr_space ifdef
268 | CppDirectiveStmt cpp
-> pp_directive_gen pr_elem pr_space cpp
269 | IfdefStmt2
(ifdef
, xxs
) ->
270 pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs
272 (* ifdef XXX elsif YYY elsif ZZZ endif *)
273 and pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs
=
276 pp_ifdef_gen pr_elem pr_space if1
;
277 pp_ifdef_tree_sequence_aux pr_elem pr_space ifxs xxs
278 | _
-> raise Impossible
280 (* XXX elsif YYY elsif ZZZ endif *)
281 and pp_ifdef_tree_sequence_aux pr_elem pr_space ifdefs xxs
=
282 Common.zip ifdefs xxs
+> List.iter
(fun (ifdef
, xs
) ->
283 xs
+> List.iter
(pp_statement_seq_gen pr_elem pr_space
);
284 pp_ifdef_gen pr_elem pr_space ifdef
;
291 (* ---------------------- *)
292 and pp_asmbody_gen pr_elem pr_space
(string_list
, colon_list
) =
293 string_list
+> List.iter pr_elem
;
294 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
295 ii
+> List.iter pr_elem
;
296 xs
+> List.iter
(fun (x
,iicomma
) ->
297 assert ((List.length iicomma
) <= 1);
298 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
300 | ColonMisc
, ii
-> ii
+> List.iter pr_elem
;
301 | ColonExpr e
, [istring
;iopar
;icpar
] ->
304 pp_expression_gen pr_elem pr_space e
;
306 | (ColonExpr _
), _
-> raise Impossible
311 (* ---------------------- *)
314 pp_type_with_ident_gen
316 pp_type_with_ident_rest_gen
323 and (pp_type_with_ident_gen
:
324 pr_elem_func
-> pr_space_func
->
325 (string * info
) option -> (storage
* il
) option ->
326 fullType
-> attribute list
->
328 fun pr_elem pr_space
->
329 fun ident sto
((qu
, iiqu
), (ty
, iity
)) attrs
->
330 pp_base_type_gen pr_elem pr_space
((qu
, iiqu
), (ty
, iity
)) sto
;
331 pp_type_with_ident_rest_gen pr_elem pr_space ident
332 ((qu
, iiqu
), (ty
, iity
)) attrs
335 and (pp_base_type_gen
:
336 pr_elem_func
-> pr_space_func
-> fullType
->
337 (storage
* il
) option -> unit) =
338 fun pr_elem pr_space
->
339 let pp_expression e
= pp_expression_gen pr_elem pr_space e
in
341 let rec pp_base_type =
342 fun (qu
, (ty
, iity
)) sto
->
345 | None
-> [] | Some
(s, iis
) -> (*assert (List.length iis = 1);*) iis
347 let print_sto_qu (sto
, (qu
, iiqu
)) =
348 let all_ii = get_sto sto
++ iiqu
in
350 +> List.sort
Ast_c.compare_pos
351 +> List.iter pr_elem
;
354 let print_sto_qu_ty (sto
, (qu
, iiqu
), iity
) =
355 let all_ii = get_sto sto
++ iiqu
++ iity
in
356 let all_ii2 = all_ii +> List.sort
Ast_c.compare_pos
in
360 (* TODO in fact for pointer, the qualifier is after the type
361 * cf -test strangeorder
364 all_ii2 +> List.iter pr_elem
366 else all_ii2 +> List.iter pr_elem
370 | (Pointer t
, [i
]) -> pp_base_type t sto
371 | (ParenType t
, _
) -> pp_base_type t sto
372 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_base_type t sto
373 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
374 pp_base_type returnt sto
377 | (StructUnion
(su
, sopt
, fields
),iis
) ->
378 print_sto_qu (sto
, qu
);
381 | Some
s , [i1
;i2
;i3
;i4
] ->
382 pr_elem i1
; pr_elem i2
; pr_elem i3
;
383 | None
, [i1
;i2
;i3
] ->
384 pr_elem i1
; pr_elem i2
;
385 | x
-> raise Impossible
389 (fun (xfield
, iipttvirg_when_emptyfield
) ->
392 | DeclarationField
(FieldDeclList
(onefield_multivars
, iiptvirg
)) ->
393 (match onefield_multivars
with
395 (* handling the first var. Special case, with the
396 first var, we print the whole type *)
399 | (Simple
(sopt
, typ
), iis
), iivirg
->
400 (* first var cant have a preceding ',' *)
401 assert (List.length iivirg
= 0);
403 (match sopt
, iis
with
405 | (Some
s, [iis
]) -> Some
(s, iis
)
406 | x
-> raise Impossible
)
408 pp_type_with_ident_gen pr_elem pr_space
409 identinfo None typ
Ast_c.noattr
;
411 | (BitField
(sopt
, typ
, expr
), ii
), iivirg
->
412 (* first var cant have a preceding ',' *)
413 assert (List.length iivirg
= 0);
416 pp_type_gen pr_elem pr_space typ
;
419 | (Some
s, [is
;idot
]) ->
420 pp_type_with_ident_gen
422 (Some
(s, is
)) None typ
Ast_c.noattr
;
425 | x
-> raise Impossible
427 ); (* match x, first onefield_multivars *)
430 xs
+> List.iter
(function
431 | (Simple
(sopt
, typ
), iis
), iivirg
->
432 iivirg
+> List.iter pr_elem
;
434 (match sopt
, iis
with
436 | (Some
s, [iis
]) -> Some
(s, iis
)
437 | x
-> raise Impossible
)
439 pp_type_with_ident_rest_gen pr_elem pr_space
440 identinfo typ
Ast_c.noattr
;
442 | (BitField
(sopt
, typ
, expr
), ii
), iivirg
->
443 iivirg
+> List.iter pr_elem
;
445 | (Some
s, [is
;idot
]) ->
446 pp_type_with_ident_rest_gen
448 (Some
(s, is
)) typ
Ast_c.noattr
;
451 | x
-> raise Impossible
454 ); (* iter other vars *)
456 | [] -> raise Impossible
457 ); (* onefield_multivars *)
458 assert (List.length iiptvirg
= 1);
459 iiptvirg
+> List.iter pr_elem
;
462 | MacroStructDeclTodo
-> pr2
"MacroTodo"
466 iipttvirg_when_emptyfield
+> List.iter pr_elem
468 | CppDirectiveStruct cpp
-> pp_directive_gen pr_elem pr_space cpp
469 | IfdefStruct ifdef
-> pp_ifdef_gen pr_elem pr_space ifdef
473 | Some
s , [i1
;i2
;i3
;i4
] -> pr_elem i4
474 | None
, [i1
;i2
;i3
] -> pr_elem i3
;
475 | x
-> raise Impossible
480 | (Enum
(sopt
, enumt
), iis
) ->
481 print_sto_qu (sto
, qu
);
483 (match sopt
, iis
with
484 | (Some
s, ([i1
;i2
;i3
;i4
]|[i1
;i2
;i3
;i4
;_
])) ->
485 pr_elem i1
; pr_elem i2
; pr_elem i3
;
486 | (None
, ([i1
;i2
;i3
]|[i1
;i2
;i3
;_
])) ->
487 pr_elem i1
; pr_elem i2
488 | x
-> raise Impossible
491 enumt
+> List.iter
(fun (((s, eopt
),ii_s_eq
), iicomma
) ->
492 assert (List.length iicomma
<= 1);
493 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
494 (match eopt
, ii_s_eq
with
495 | None
, [is
] -> pr_elem is
;
496 | Some e
, [is
;ieq
] -> pr_elem is
; pr_elem ieq
; pp_expression e
497 | _
-> raise Impossible
502 (match sopt
, iis
with
503 | (Some
s, [i1
;i2
;i3
;i4
]) -> pr_elem i4
504 | (Some
s, [i1
;i2
;i3
;i4
;i5
]) ->
505 pr_elem i5
; pr_elem i4
(* trailing comma *)
506 | (None
, [i1
;i2
;i3
]) -> pr_elem i3
507 | (None
, [i1
;i2
;i3
;i4
]) ->
508 pr_elem i4
; pr_elem i3
(* trailing comma *)
511 | x
-> raise Impossible
515 | (BaseType _
, iis
) ->
516 print_sto_qu_ty (sto
, qu
, iis
);
518 | (StructUnionName
(s, structunion
), iis
) ->
519 assert (List.length iis
= 2);
520 print_sto_qu_ty (sto
, qu
, iis
);
522 | (EnumName
s, iis
) ->
523 assert (List.length iis
= 2);
524 print_sto_qu_ty (sto
, qu
, iis
);
526 | (TypeName
(s,_typ
), iis
) ->
527 assert (List.length iis
= 1);
528 print_sto_qu_ty (sto
, qu
, iis
);
530 | (TypeOfExpr
(e
), iis
) ->
531 print_sto_qu (sto
, qu
);
533 | [itypeof
;iopar
;icpar
] ->
534 pr_elem itypeof
; pr_elem iopar
;
535 pp_expression_gen pr_elem pr_space e
;
537 | _
-> raise Impossible
540 | (TypeOfType
(t
), iis
) ->
541 print_sto_qu (sto
, qu
);
543 | [itypeof
;iopar
;icpar
] ->
544 pr_elem itypeof
; pr_elem iopar
;
545 pp_type_gen pr_elem pr_space t
;
547 | _
-> raise Impossible
550 | (Pointer _
| (*ParenType _ |*) Array _
| FunctionType _
551 (* | StructUnion _ | Enum _ | BaseType _ *)
552 (* | StructUnionName _ | EnumName _ | TypeName _ *)
553 (* | TypeOfExpr _ | TypeOfType _ *)
554 ), _
-> raise Impossible
562 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
564 and (pp_type_with_ident_rest_gen
:
565 pr_elem_func
-> pr_space_func
->
566 (string * info
) option ->
567 fullType
-> attribute list
->
569 fun pr_elem pr_space
->
571 fun ident
(((qu
, iiqu
), (ty
, iity
)) as fullt
) attrs
->
572 let print_ident ident
= Common.do_option
(fun (s, iis
) ->
573 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
579 (* the work is to do in base_type !! *)
580 | (BaseType _
, iis
) -> print_ident ident
581 | (Enum
(sopt
, enumt
), iis
) -> print_ident ident
582 | (StructUnion
(_
, sopt
, fields
),iis
) -> print_ident ident
583 | (StructUnionName
(s, structunion
), iis
) -> print_ident ident
584 | (EnumName
s, iis
) -> print_ident ident
585 | (TypeName
(s,_typ
), iis
) -> print_ident ident
586 | (TypeOfExpr
(e
), iis
) -> print_ident ident
587 | (TypeOfType
(e
), iis
) -> print_ident ident
591 | (Pointer t
, [i
]) ->
592 (* subtil: void ( *done)(int i) is a Pointer
593 (FunctionType (return=void, params=int i) *)
594 (*WRONG I THINK, use left & right function *)
595 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
597 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
598 pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs
;
600 (* ugly special case ... todo? maybe sufficient in practice *)
601 | (ParenType
(q1
, (Pointer
(q2
, (FunctionType t
, ii3
)) ,
602 [ipointer
]) ), [i1
;i2
]) ->
603 pp_type_left_gen pr_elem pr_space
(q2
, (FunctionType t
, ii3
));
608 pp_type_right_gen pr_elem pr_space
(q2
, (FunctionType t
, ii3
));
610 (* another ugly special case *)
614 (q3
, (FunctionType t
, iifunc
)),
616 [iarray1
;iarray2
])), [i1
;i2
]) ->
617 pp_type_left_gen pr_elem pr_space
(q3
, (FunctionType t
, iifunc
));
622 do_option
(pp_expression_gen pr_elem pr_space
) eopt
;
625 pp_type_right_gen pr_elem pr_space
(q3
, (FunctionType t
, iifunc
))
629 | (ParenType t
, [i1
;i2
]) ->
630 pr2
"PB PARENTYPE ZARB, I forget about the ()";
631 pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs
;
634 | (Array
(eopt
, t
), [i1
;i2
]) ->
635 pp_type_left_gen pr_elem pr_space fullt
;
637 iiqu
+> List.iter pr_elem
;
640 pp_type_right_gen pr_elem pr_space fullt
;
643 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
644 pp_type_left_gen pr_elem pr_space fullt
;
646 iiqu
+> List.iter pr_elem
;
649 pp_type_right_gen pr_elem pr_space fullt
;
652 | (FunctionType _
| Array _
| ParenType _
| Pointer _
653 ), _
-> raise Impossible
656 and (pp_type_left_gen
: pr_elem_func
-> pr_space_func
-> fullType
-> unit) =
657 fun pr_elem pr_space
->
658 let rec pp_type_left = fun ((qu
, iiqu
), (ty
, iity
)) ->
660 | (Pointer t
, [i
]) ->
662 iiqu
+> List.iter pr_elem
; (* le const est forcement apres le '*' *)
665 | (Array
(eopt
, t
), [i1
;i2
]) -> pp_type_left t
666 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) -> pp_type_left returnt
668 | (ParenType t
, _
) -> failwith
"parenType"
671 | (BaseType _
, iis
) -> ()
672 | (Enum
(sopt
, enumt
), iis
) -> ()
673 | (StructUnion
(_
, sopt
, fields
),iis
) -> ()
674 | (StructUnionName
(s, structunion
), iis
) -> ()
675 | (EnumName
s, iis
) -> ()
676 | (TypeName
(s,_typ
), iis
) -> ()
678 | TypeOfType _
, _
-> ()
679 | TypeOfExpr _
, _
-> ()
681 | (FunctionType _
| Array _
| Pointer _
682 ), _
-> raise Impossible
687 and pp_param_gen pr_elem pr_space
= fun ((b
, sopt
, t
), ii_b_s
) ->
688 match b
, sopt
, ii_b_s
with
690 pp_type_gen pr_elem pr_space t
691 | true, None
, [i1
] ->
693 pp_type_gen pr_elem pr_space t
695 | false, Some
s, [i1
] ->
696 pp_type_with_ident_gen pr_elem pr_space
697 (Some
(s, i1
)) None t
Ast_c.noattr
;
698 | true, Some
s, [i1
;i2
] ->
700 pp_type_with_ident_gen pr_elem pr_space
701 (Some
(s, i2
)) None t
Ast_c.noattr
;
702 | _
-> raise Impossible
705 and (pp_type_right_gen
: pr_elem_func
-> pr_space_func
-> fullType
-> unit) =
706 fun pr_elem pr_space
->
707 let rec pp_type_right = fun ((qu
, iiqu
), (ty
, iity
)) ->
709 | (Pointer t
, [i
]) -> pp_type_right t
711 | (Array
(eopt
, t
), [i1
;i2
]) ->
713 eopt
+> do_option
(fun e
-> pp_expression_gen pr_elem pr_space e
);
717 | (ParenType t
, _
) -> failwith
"parenType"
718 | (FunctionType
(returnt
, paramst
), [i1
;i2
]) ->
722 ts
+> List.iter
(fun (param
,iicomma
) ->
723 assert ((List.length iicomma
) <= 1);
724 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
726 pp_param_gen pr_elem pr_space param
;
728 iib
+> List.iter pr_elem
;
735 | (BaseType _
, iis
) -> ()
736 | (Enum
(sopt
, enumt
), iis
) -> ()
737 | (StructUnion
(_
, sopt
, fields
),iis
)-> ()
738 | (StructUnionName
(s, structunion
), iis
) -> ()
739 | (EnumName
s, iis
) -> ()
740 | (TypeName
(s,_typ
), iis
) -> ()
742 | TypeOfType _
, _
-> ()
743 | TypeOfExpr _
, _
-> ()
745 | (FunctionType _
| Array _
| Pointer _
746 ), _
-> raise Impossible
751 and pp_type_gen pr_elem pr_space t
=
752 pp_type_with_ident_gen pr_elem pr_space
753 None None t
Ast_c.noattr
755 (* ---------------------- *)
756 and pp_decl_gen pr_elem pr_space
= function
757 | DeclList
((({v_namei
= var
; v_type
= returnType
;
758 v_storage
= storage
; v_attr
= attrs
;
760 iivirg
::ifakestart
::iisto
) ->
764 (* old: iisto +> List.iter pr_elem; *)
767 (* handling the first var. Special case, we print the whole type *)
769 | Some
((s, ini
), iis
::iini
) ->
770 pp_type_with_ident_gen pr_elem pr_space
771 (Some
(s, iis
)) (Some
(storage
, iisto
))
773 ini
+> do_option
(fun init
->
774 List.iter pr_elem iini
; pp_init_gen pr_elem pr_space init
);
775 | None
-> pp_type_gen pr_elem pr_space returnType
776 | _
-> raise Impossible
779 (* for other vars, we just call pp_type_with_ident_rest. *)
780 xs
+> List.iter
(function
781 | ({v_namei
= Some
((s, ini
), iis
::iini
);
783 v_storage
= storage2
;
787 assert (storage2
= storage
);
788 iivirg
+> List.iter pr_elem
;
789 pp_type_with_ident_rest_gen pr_elem pr_space
790 (Some
(s, iis
)) returnType attrs
;
791 ini
+> do_option
(fun (init
) ->
792 List.iter pr_elem iini
; pp_init_gen pr_elem pr_space init
);
795 | x
-> raise Impossible
800 | MacroDecl
((s, es
), iis
::lp
::rp
::iiend
::ifakestart
::iisto
) ->
802 iisto
+> List.iter pr_elem
; (* static and const *)
805 es
+> List.iter
(fun (e
, opt
) ->
806 assert (List.length opt
<= 1);
807 opt
+> List.iter pr_elem
;
808 pp_argument_gen pr_elem pr_space e
;
814 | (DeclList
(_
, _
) | (MacroDecl _
)) -> raise Impossible
817 (* ---------------------- *)
818 and pp_init_gen
= fun pr_elem pr_space
->
819 let pp_expression e
= pp_expression_gen pr_elem pr_space e
in
820 let rec pp_init = fun (init
, iinit
) ->
821 match init
, iinit
with
822 | InitExpr e
, [] -> pp_expression e
;
823 | InitList xs
, i1
::i2
::iicommaopt
->
825 xs
+> List.iter
(fun (x
, ii
) ->
826 assert (List.length ii
<= 1);
827 ii
+> List.iter pr_elem
;
830 iicommaopt
+> List.iter pr_elem
;
833 | InitDesignators
(xs
, initialiser
), [i1
] -> (* : *)
834 xs
+> List.iter
(pp_designator pr_elem pr_space
);
838 (* no use of '=' in the "Old" style *)
839 | InitFieldOld
(string, initialiser
), [i1
;i2
] -> (* label: in oldgcc *)
840 pr_elem i1
; pr_elem i2
; pp_init initialiser
841 | InitIndexOld
(expression
, initialiser
), [i1
;i2
] -> (* [1] in oldgcc *)
842 pr_elem i1
; pp_expression expression
; pr_elem i2
;
845 | (InitIndexOld _
| InitFieldOld _
| InitDesignators _
846 | InitList _
| InitExpr _
847 ), _
-> raise Impossible
853 and pp_designator pr_elem pr_space design
=
854 let pp_expression e
= pp_expression_gen pr_elem pr_space e
in
856 | DesignatorField
(s), [i1
; i2
] ->
857 pr_elem i1
; pr_elem i2
;
858 | DesignatorIndex
(expression
), [i1
;i2
] ->
859 pr_elem i1
; pp_expression expression
; pr_elem i2
;
861 | DesignatorRange
(e1
, e2
), [iocro
;iellipsis
;iccro
] ->
862 pr_elem iocro
; pp_expression e1
; pr_elem iellipsis
;
863 pp_expression e2
; pr_elem iccro
;
865 | (DesignatorField _
| DesignatorIndex _
| DesignatorRange _
866 ), _
-> raise Impossible
869 (* ---------------------- *)
870 and pp_attributes pr_elem pr_space attrs
=
871 attrs
+> List.iter
(fun (attr
, ii
) ->
872 ii
+> List.iter pr_elem
;
875 (* ---------------------- *)
876 and pp_def_gen pr_elem pr_space def
=
877 let defbis, ii
= def
in
879 | is
::iifunc1
::iifunc2
::i1
::i2
::ifakestart
::isto
->
882 f_type
= (returnt
, (paramst
, (b
, iib
)));
891 pp_type_with_ident_gen pr_elem pr_space None
(Some
(sto
, isto
))
892 returnt
Ast_c.noattr
;
894 pp_attributes pr_elem pr_space attrs
;
900 (* not anymore, cf tests/optional_name_parameter and
901 macro_parameter_shortcut.c
903 | [(((bool, None, t), ii_b_s), iicomma)] ->
906 | qu, (BaseType Void, ii) -> true
909 assert (null iicomma);
910 assert (null ii_b_s);
911 pp_type_with_ident_gen pr_elem pr_space None None t
914 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
915 iicomma +> List.iter pr_elem;
917 (match b, s, ii_b_s with
918 | false, Some s, [i1] ->
919 pp_type_with_ident_gen
920 pr_elem pr_space (Some (s, i1)) None t;
921 | true, Some s, [i1;i2] ->
923 pp_type_with_ident_gen
924 pr_elem pr_space (Some (s, i2)) None t;
926 (* in definition we have name for params, except when f(void) *)
927 | _
, None
, _
-> raise Impossible
930 | _
-> raise Impossible
935 (* normally ii represent the ",..." but it is also abused
936 with the f(void) case *)
937 (* assert (List.length iib <= 2);*)
938 iib
+> List.iter pr_elem
;
941 paramst
+> List.iter
(fun (param
,iicomma
) ->
942 assert ((List.length iicomma
) <= 1);
943 iicomma
+> List.iter
(function x
-> pr_elem x
; pr_space
());
945 pp_param_gen pr_elem pr_space param
;
947 iib
+> List.iter pr_elem
;
952 statxs
+> List.iter
(pp_statement_seq_gen pr_elem pr_space
);
954 | _
-> raise Impossible
958 (* ---------------------- *)
960 and pp_ifdef_gen pr_elem pr_space ifdef
=
962 | IfdefDirective
(ifdef
, ii
) ->
966 and pp_directive_gen pr_elem pr_space directive
=
968 | Include
{i_include
= (s, ii
);} ->
969 let (i1
,i2
) = Common.tuple_of_list2 ii
in
970 pr_elem i1
; pr_elem i2
971 | Define
((s,ii
), (defkind
, defval
)) ->
972 let (idefine
,iident
,ieol
) = Common.tuple_of_list3 ii
in
976 let define_val = function
977 | DefineExpr e
-> pp_expression_gen pr_elem pr_space e
978 | DefineStmt st
-> pp_statement_gen pr_elem pr_space st
979 | DefineDoWhileZero
((st
,e
), ii
) ->
981 | [ido
;iwhile
;iopar
;icpar
] ->
983 pp_statement_gen pr_elem pr_space st
;
984 pr_elem iwhile
; pr_elem iopar
;
985 pp_expression_gen pr_elem pr_space e
;
987 | _
-> raise Impossible
989 | DefineFunction def
-> pp_def_gen pr_elem pr_space def
991 | DefineType ty
-> pp_type_gen pr_elem pr_space ty
992 | DefineText
(s, ii
) -> List.iter pr_elem ii
995 pp_init_gen pr_elem pr_space ini
997 | DefineTodo
-> pr2
"DefineTodo"
1001 | DefineFunc
(params
, ii
) ->
1002 let (i1
,i2
) = tuple_of_list2 ii
in
1004 params
+> List.iter
(fun ((s,iis
), iicomma
) ->
1005 assert (List.length iicomma
<= 1);
1006 iicomma
+> List.iter pr_elem
;
1007 iis
+> List.iter pr_elem
;
1015 List.iter pr_elem ii
1016 | PragmaAndCo
(ii
) ->
1017 List.iter pr_elem ii
1022 let pp_program_gen pr_elem pr_space progelem
=
1024 | Declaration decl
-> pp_decl_gen pr_elem pr_space decl
1025 | Definition def
-> pp_def_gen pr_elem pr_space def
1027 | CppTop directive
-> pp_directive_gen pr_elem pr_space directive
1030 | MacroTop
(s, es
, [i1
;i2
;i3
;i4
]) ->
1033 es
+> List.iter
(fun (e
, opt
) ->
1034 assert (List.length opt
<= 1);
1035 opt
+> List.iter pr_elem
;
1036 pp_argument_gen pr_elem pr_space e
;
1042 | EmptyDef ii
-> ii
+> List.iter pr_elem
1043 | NotParsedCorrectly ii
->
1044 assert (List.length ii
>= 1);
1045 ii
+> List.iter pr_elem
1046 | FinalDef info
-> pr_elem
(Ast_c.rewrap_str
"" info
)
1048 | IfdefTop ifdefdir
->
1049 pp_ifdef_gen pr_elem pr_space ifdefdir
1057 let pp_flow_gen pr_elem pr_space n
=
1058 match F.unwrap n
with
1059 | F.FunHeader
({f_name
=idb
;
1060 f_type
= (rett
, (paramst
,(isvaargs
,iidotsb
)));
1063 f_attr
= attrs
},ii
) ->
1069 attrs +> List.iter (vk_attribute bigf);
1071 paramst +> List.iter (fun (param, iicomma) ->
1072 vk_param bigf param;
1080 (* vk_decl bigf decl *)
1083 | F.ExprStatement
(st
, (eopt
, ii
)) ->
1084 pp_statement_gen pr_elem pr_space
(ExprStatement eopt
, ii
)
1086 | F.IfHeader
(_
, (e
,ii
))
1087 | F.SwitchHeader
(_
, (e
,ii
))
1088 | F.WhileHeader
(_
, (e
,ii
))
1089 | F.DoWhileTail
(e
,ii
) ->
1097 | F.ForHeader
(_st
, (((e1opt
,i1
), (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
1099 iif i1; iif i2; iif i3;
1101 e1opt +> do_option (vk_expr bigf);
1102 e2opt +> do_option (vk_expr bigf);
1103 e3opt +> do_option (vk_expr bigf);
1107 | F.MacroIterHeader
(_s
, ((s,es
), ii
)) ->
1110 vk_argument_list bigf es;
1115 | F.ReturnExpr
(_st
, (e
,ii
)) ->
1116 (* iif ii; vk_expr bigf e*)
1120 | F.Case
(_st
, (e
,ii
)) ->
1121 (* iif ii; vk_expr bigf e *)
1124 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
1125 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1130 | F.CaseNode i
-> ()
1133 (* vk_expr bigf e *)
1136 | F.DefineType ft
->
1137 (* vk_type bigf ft *)
1140 | F.DefineHeader
((s,ii
), (defkind
)) ->
1143 vk_define_kind bigf defkind;
1148 | F.DefineDoWhileZeroHeader
(((),ii
)) ->
1153 | F.Include
{i_include
= (s, ii
);} ->
1158 | F.MacroTop
(s, args
, ii
) ->
1160 vk_argument_list bigf args *)
1164 | F.Break
(st
,((),ii
)) ->
1167 | F.Continue
(st
,((),ii
)) ->
1170 | F.Default
(st
,((),ii
)) ->
1173 | F.Return
(st
,((),ii
)) ->
1176 | F.Goto
(st
, (s,ii
)) ->
1179 | F.Label
(st
, (s,ii
)) ->
1182 | F.EndStatement iopt
->
1183 (* do_option infof iopt *)
1185 | F.DoHeader
(st
, info
) ->
1191 | F.SeqEnd
(i
, info
) ->
1194 | F.SeqStart
(st
, i
, info
) ->
1198 | F.MacroStmt
(st
, ((),ii
)) ->
1201 | F.Asm
(st
, (asmbody
,ii
)) ->
1204 vk_asmbody bigf asmbody
1209 | F.IfdefHeader
(info
) ->
1210 pp_ifdef_gen pr_elem pr_space info
1211 | F.IfdefElse
(info
) ->
1212 pp_ifdef_gen pr_elem pr_space info
1213 | F.IfdefEndif
(info
) ->
1214 pp_ifdef_gen pr_elem pr_space info
1218 F.TopNode
|F.EndNode
|
1219 F.ErrorExit
|F.Exit
|F.Enter
|
1220 F.FallThroughNode
|F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1232 (*****************************************************************************)
1234 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1236 let s = Ast_c.str_of_info info
in
1239 let pr_space _
= Format.print_space
()
1241 let pp_expression_simple = pp_expression_gen pr_elem pr_space
1242 let pp_statement_simple = pp_statement_gen
pr_elem pr_space
1243 let pp_type_simple = pp_type_gen
pr_elem pr_space
1244 let pp_toplevel_simple = pp_program_gen pr_elem pr_space
1245 let pp_flow_simple = pp_flow_gen pr_elem pr_space