HCoop / bpt / coccinelle.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Release of coccinelle 1.0.0-rc9
[bpt/coccinelle.git] / parsing_c / pretty_print_c.ml
1 (* Yoann Padioleau, Julia Lawall
2 *
3 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
4 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU
5 *
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.
9 *
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.
14 *)
15 open Common
16
17 open Ast_c
18
19 module F = Control_flow_c
20
21 (*****************************************************************************)
22 (* Wrappers *)
23 (*****************************************************************************)
24 let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_unparsing
25
26 (*****************************************************************************)
27 (* Types *)
28 (*****************************************************************************)
29
30 type type_with_ident =
31 (string * Ast_c.info) option ->
32 (Ast_c.storage * Ast_c.il) option ->
33 Ast_c.fullType ->
34 Ast_c.attribute list -> unit
35
36 type 'a printer = 'a -> unit
37
38 type pretty_printers = {
39 expression : Ast_c.expression printer;
40 arg_list : (Ast_c.argument Ast_c.wrap2 list) printer;
41 statement : Ast_c.statement printer;
42 decl : Ast_c.declaration printer;
43 field : Ast_c.field printer;
44 field_list : Ast_c.field list printer;
45 init : Ast_c.initialiser printer;
46 init_list : (Ast_c.initialiser wrap2 list) printer;
47 param : Ast_c.parameterType printer;
48 paramlist : (Ast_c.parameterType Ast_c.wrap2 list) printer;
49 ty : Ast_c.fullType printer;
50 type_with_ident : type_with_ident;
51 toplevel : Ast_c.toplevel printer;
52 flow : Control_flow_c.node printer
53 }
54
55
56
57 (*****************************************************************************)
58
59 (* This module is used by unparse_c, but because unparse_c have also
60 * the list of tokens, pretty_print_c could be useless in the future
61 * (except that the ast_c have some fake tokens not present in the list
62 * of tokens so it's still useful). But this module is also useful to
63 * unparse C when you don't have the ordered list of tokens separately,
64 * or tokens without position information, for instance when you want
65 * to pretty print some piece of C that was generated, or some
66 * abstract-lined piece of code, etc. *)
67
68 let mk_pretty_printers
69 ~pr_elem ~pr_space
70 ~pr_nl ~pr_indent ~pr_outdent ~pr_unindent
71 =
72 let start_block () = pr_nl(); pr_indent() in
73 let end_block () = pr_unindent(); pr_nl() in
74
75 let indent_if_needed st f =
76 match Ast_c.unwrap_st st with
77 Compound _ -> pr_space(); f()
78 | _ ->
79 (*no newline at the end - someone else will do that*)
80 start_block(); f(); pr_unindent() in
81
82
83 let pp_list printer l =
84 l +> List.iter (fun (e, opt) ->
85 assert (List.length opt <= 1); (* opt must be a comma? *)
86 opt +> List.iter (function x -> pr_elem x; pr_space());
87 printer e) in
88
89 let rec pp_expression = fun ((exp, typ), ii) ->
90 (match exp, ii with
91 | Ident (ident), [] -> pp_name ident
92 (* only a MultiString can have multiple ii *)
93 | Constant (MultiString _), is -> is +> List.iter pr_elem
94 | Constant (c), [i] -> pr_elem i
95 | FunCall (e, es), [i1;i2] ->
96 pp_expression e; pr_elem i1;
97 pp_arg_list es;
98 pr_elem i2;
99
100 | CondExpr (e1, e2, e3), [i1;i2] ->
101 pp_expression e1; pr_space(); pr_elem i1; pr_space();
102 do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2;
103 pr_space(); pp_expression e3
104 | Sequence (e1, e2), [i] ->
105 pp_expression e1; pr_elem i; pr_space(); pp_expression e2
106 | Assignment (e1, op, e2), [i] ->
107 pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
108
109 | Postfix (e, op), [i] -> pp_expression e; pr_elem i;
110 | Infix (e, op), [i] -> pr_elem i; pp_expression e;
111 | Unary (e, op), [i] -> pr_elem i; pp_expression e
112 | Binary (e1, op, e2), [i] ->
113 pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
114
115 | ArrayAccess (e1, e2), [i1;i2] ->
116 pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2
117 | RecordAccess (e, name), [i1] ->
118 pp_expression e; pr_elem i1; pp_name name;
119 | RecordPtAccess (e, name), [i1] ->
120 pp_expression e; pr_elem i1; pp_name name;
121
122 | SizeOfExpr (e), [i] ->
123 pr_elem i;
124 (match Ast_c.unwrap e with
125 ParenExpr (e), _ -> ()
126 | _ -> pr_space());
127 pp_expression e
128 | SizeOfType (t), [i1;i2;i3] ->
129 pr_elem i1; pr_elem i2; pp_type t; pr_elem i3
130 | Cast (t, e), [i1;i2] ->
131 pr_elem i1; pp_type t; pr_elem i2; pp_expression e
132
133 | StatementExpr (statxs, [ii1;ii2]), [i1;i2] ->
134 pr_elem i1;
135 pr_elem ii1;
136 statxs +> List.iter pp_statement_seq;
137 pr_elem ii2;
138 pr_elem i2;
139 | Constructor (t, init), [lp;rp] ->
140 pr_elem lp;
141 pp_type t;
142 pr_elem rp;
143 pp_init init
144
145 | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2;
146
147 | New (t), [i1] -> pr_elem i1; pp_argument t
148 | Delete(t), [i1] -> pr_elem i1; pp_expression t
149
150 | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_)
151 | Sequence (_,_)
152 | Assignment (_,_,_)
153 | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_)
154 | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_)
155 | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_)
156 | StatementExpr (_) | Constructor _
157 | ParenExpr (_) | New (_) | Delete (_)),_ -> raise Impossible
158 );
159
160 if !Flag_parsing_c.pretty_print_type_info
161 then begin
162 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*");
163 !typ +>
164 (fun (ty,_test) -> ty +>
165 Common.do_option
166 (fun (x,l) -> pp_type x;
167 let s = match l with
168 Ast_c.LocalVar _ -> ", local"
169 | _ -> "" in
170 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s)));
171 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/");
172 end
173
174 and pp_arg_list es = pp_list pp_argument es
175
176 and pp_argument argument =
177 let rec pp_action (ActMisc ii) = ii +> List.iter pr_elem in
178 match argument with
179 | Left e -> pp_expression e
180 | Right weird ->
181 (match weird with
182 | ArgType param -> pp_param param
183 | ArgAction action -> pp_action action)
184
185 (* ---------------------- *)
186 and pp_name = function
187 | RegularName (s, ii) ->
188 let (i1) = Common.tuple_of_list1 ii in
189 pr_elem i1
190 | CppConcatenatedName xs ->
191 xs +> List.iter (fun ((x,ii1), ii2) ->
192 ii2 +> List.iter pr_elem;
193 ii1 +> List.iter pr_elem;
194 )
195 | CppVariadicName (s, ii) ->
196 ii +> List.iter pr_elem
197 | CppIdentBuilder ((s,iis), xs) ->
198 let (iis, iop, icp) = Common.tuple_of_list3 iis in
199 pr_elem iis;
200 pr_elem iop;
201 xs +> List.iter (fun ((x,iix), iicomma) ->
202 iicomma +> List.iter pr_elem;
203 iix +> List.iter pr_elem;
204 );
205 pr_elem icp
206
207 (* ---------------------- *)
208 and pp_statement = fun st ->
209 match Ast_c.get_st_and_ii st with
210 | Labeled (Label (name, st)), ii ->
211 let (i2) = Common.tuple_of_list1 ii in
212 pr_outdent(); pp_name name; pr_elem i2; pr_nl(); pp_statement st
213 | Labeled (Case (e, st)), [i1;i2] ->
214 pr_unindent();
215 pr_elem i1; pp_expression e; pr_elem i2; pr_nl(); pr_indent();
216 pp_statement st
217 | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] ->
218 pr_unindent();
219 pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3;
220 pr_nl(); pr_indent();
221 pp_statement st
222 | Labeled (Default st), [i1;i2] ->
223 pr_unindent(); pr_elem i1; pr_elem i2; pr_nl(); pr_indent();
224 pp_statement st
225 | Compound statxs, [i1;i2] ->
226 pr_elem i1; start_block();
227 statxs +> Common.print_between pr_nl pp_statement_seq;
228 end_block(); pr_elem i2;
229
230 | ExprStatement (None), [i] -> pr_elem i;
231 | ExprStatement (None), [] -> ()
232 | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i
233 (* the last ExprStatement of a for does not have a trailing
234 ';' hence the [] for ii *)
235 | ExprStatement (Some e), [] -> pp_expression e;
236 | Selection (If (e, st1, st2)), i1::i2::i3::is ->
237 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
238 indent_if_needed st1 (function _ -> pp_statement st1);
239 (match (Ast_c.get_st_and_ii st2, is) with
240 | ((ExprStatement None, []), []) -> ()
241 | ((ExprStatement None, []), [iifakend]) -> pr_elem iifakend
242 | _st2, [i4;iifakend] -> pr_elem i4;
243 indent_if_needed st2 (function _ -> pp_statement st2);
244 pr_elem iifakend
245 | x -> raise Impossible
246 )
247 | Selection (Switch (e, st)), [i1;i2;i3;iifakend] ->
248 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
249 indent_if_needed st (function _-> pp_statement st); pr_elem iifakend
250 | Iteration (While (e, st)), [i1;i2;i3;iifakend] ->
251 pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3;
252 indent_if_needed st (function _-> pp_statement st); pr_elem iifakend
253 | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] ->
254 pr_elem i1;
255 indent_if_needed st (function _ -> pp_statement st);
256 pr_elem i2; pr_elem i3; pp_expression e;
257 pr_elem i4; pr_elem i5;
258 pr_elem iifakend
259
260
261 | Iteration (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)),
262 [i1;i2;i3;iifakend] ->
263
264 pr_elem i1; pr_space();
265 pr_elem i2;
266 pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1);
267 pp_statement (Ast_c.mk_st (ExprStatement e2opt) il2);
268 assert (null il3);
269 pp_statement (Ast_c.mk_st (ExprStatement e3opt) il3);
270 pr_elem i3;
271 indent_if_needed st (function _ -> pp_statement st);
272 pr_elem iifakend
273
274 | Iteration (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] ->
275 pr_elem i1; pr_space();
276 pr_elem i2;
277
278 es +> List.iter (fun (e, opt) ->
279 assert (List.length opt <= 1);
280 opt +> List.iter pr_elem;
281 pp_argument e;
282 );
283
284 pr_elem i3;
285 indent_if_needed st (function _ -> pp_statement st);
286 pr_elem iifakend
287
288 | Jump (Goto name), ii ->
289 let (i1, i3) = Common.tuple_of_list2 ii in
290 pr_elem i1; pr_space(); pp_name name; pr_elem i3;
291 | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2;
292 | Jump (ReturnExpr e), [i1;i2] ->
293 pr_elem i1; pr_space(); pp_expression e; pr_elem i2
294 | Jump (GotoComputed e), [i1;i2;i3] ->
295 pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3
296
297 | Decl decl, [] -> pp_decl decl
298 | Asm asmbody, ii ->
299 (match ii with
300 | [iasm;iopar;icpar;iptvirg] ->
301 pr_elem iasm; pr_elem iopar;
302 pp_asmbody asmbody;
303 pr_elem icpar; pr_elem iptvirg
304 | [iasm;ivolatile;iopar;icpar;iptvirg] ->
305 pr_elem iasm; pr_elem ivolatile; pr_elem iopar;
306 pp_asmbody asmbody;
307 pr_elem icpar; pr_elem iptvirg
308 | _ -> raise Impossible
309 )
310
311 | NestedFunc def, ii ->
312 assert (null ii);
313 pp_def def
314 | MacroStmt, ii ->
315 ii +> List.iter pr_elem ;
316
317 | (Labeled (Case (_,_))
318 | Labeled (CaseRange (_,_,_)) | Labeled (Default _)
319 | Compound _ | ExprStatement _
320 | Selection (If (_, _, _)) | Selection (Switch (_, _))
321 | Iteration (While (_, _)) | Iteration (DoWhile (_, _))
322 | Iteration (For ((_,_), (_,_), (_, _), _))
323 | Iteration (MacroIteration (_,_,_))
324 | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _)
325 | Jump (GotoComputed _)
326 | Decl _
327 ), _ -> raise Impossible
328
329 and pp_statement_seq = function
330 | StmtElem st -> pp_statement st
331 | IfdefStmt ifdef -> pp_ifdef ifdef
332 | CppDirectiveStmt cpp -> pp_directive cpp
333 | IfdefStmt2 (ifdef, xxs) -> pp_ifdef_tree_sequence ifdef xxs
334
335 (* ifdef XXX elsif YYY elsif ZZZ endif *)
336 and pp_ifdef_tree_sequence ifdef xxs =
337 match ifdef with
338 | if1::ifxs ->
339 pp_ifdef if1;
340 pp_ifdef_tree_sequence_aux ifxs xxs
341 | _ -> raise Impossible
342
343 (* XXX elsif YYY elsif ZZZ endif *)
344 and pp_ifdef_tree_sequence_aux ifdefs xxs =
345 Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) ->
346 xs +> List.iter pp_statement_seq;
347 pp_ifdef ifdef
348 )
349
350
351
352
353
354 (* ---------------------- *)
355 and pp_asmbody (string_list, colon_list) =
356 string_list +> List.iter pr_elem ;
357 colon_list +> List.iter (fun (Colon xs, ii) ->
358 ii +> List.iter pr_elem;
359 xs +> List.iter (fun (x,iicomma) ->
360 assert ((List.length iicomma) <= 1);
361 iicomma +> List.iter (function x -> pr_elem x; pr_space());
362 (match x with
363 | ColonMisc, ii -> ii +> List.iter pr_elem;
364 | ColonExpr e, [istring;iopar;icpar] ->
365 pr_elem istring;
366 pr_elem iopar;
367 pp_expression e;
368 pr_elem icpar
369 (* the following case used to be just raise Impossible, but
370 the code __asm__ __volatile__ ("dcbz 0, %[input]"
371 ::[input]"r"(&coherence_data[i]));
372 in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *)
373 | (ColonExpr e), ii ->
374 (match List.rev ii with
375 icpar::iopar::istring::rest ->
376 List.iter pr_elem (List.rev rest);
377 pr_elem istring;
378 pr_elem iopar;
379 pp_expression e;
380 pr_elem icpar
381 | _ -> raise Impossible))
382 ))
383
384
385 (* ---------------------- *)
386
387 (*
388 pp_type_with_ident
389 pp_base_type
390 pp_type_with_ident_rest
391 pp_type_left
392 pp_type_right
393 pp_type
394
395 pp_decl
396 *)
397 and (pp_type_with_ident:
398 (string * info) option -> (storage * il) option ->
399 fullType -> attribute list ->
400 unit) =
401 fun ident sto ft attrs ->
402 pp_base_type ft sto;
403 (match (ident, Ast_c.unwrap_typeC ft) with
404 (Some _,_) | (_,Pointer _) -> pr_space()
405 | _ -> ());
406 pp_type_with_ident_rest ident ft attrs
407
408
409 and (pp_base_type: fullType -> (storage * il) option -> unit) =
410 fun (qu, (ty, iity)) sto ->
411 let get_sto sto =
412 match sto with
413 | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis
414 in
415 let print_sto_qu (sto, (qu, iiqu)) =
416 let all_ii = get_sto sto ++ iiqu in
417 all_ii
418 +> List.sort Ast_c.compare_pos
419 +> Common.print_between pr_space pr_elem
420
421 in
422 let print_sto_qu_ty (sto, (qu, iiqu), iity) =
423 let all_ii = get_sto sto ++ iiqu ++ iity in
424 let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in
425
426 if all_ii <> all_ii2
427 then begin
428 (* TODO in fact for pointer, the qualifier is after the type
429 * cf -test strangeorder
430 *)
431 pr2 "STRANGEORDER";
432 all_ii2 +> Common.print_between pr_space pr_elem
433 end
434 else all_ii2 +> Common.print_between pr_space pr_elem
435 in
436
437 match ty, iity with
438 | (NoType,_) -> ()
439 | (Pointer t, [i]) -> pp_base_type t sto
440 | (ParenType t, _) -> pp_base_type t sto
441 | (Array (eopt, t), [i1;i2]) -> pp_base_type t sto
442 | (FunctionType (returnt, paramst), [i1;i2]) ->
443 pp_base_type returnt sto;
444
445
446 | (StructUnion (su, sopt, fields),iis) ->
447 print_sto_qu (sto, qu);
448
449 (match sopt,iis with
450 | Some s , [i1;i2;i3;i4] ->
451 pr_elem i1; pr_elem i2; pr_elem i3;
452 | None, [i1;i2;i3] ->
453 pr_elem i1; pr_elem i2;
454 | x -> raise Impossible
455 );
456
457 fields +> List.iter pp_field;
458
459 (match sopt,iis with
460 | Some s , [i1;i2;i3;i4] -> pr_elem i4
461 | None, [i1;i2;i3] -> pr_elem i3;
462 | x -> raise Impossible
463 );
464
465
466
467 | (Enum (sopt, enumt), iis) ->
468 print_sto_qu (sto, qu);
469
470 (match sopt, iis with
471 | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) ->
472 pr_elem i1; pr_elem i2; pr_elem i3;
473 | (None, ([i1;i2;i3]|[i1;i2;i3;_])) ->
474 pr_elem i1; pr_elem i2
475 | x -> raise Impossible
476 );
477
478 enumt +> List.iter (fun ((name, eopt), iicomma) ->
479 assert (List.length iicomma <= 1);
480 iicomma +> List.iter (function x -> pr_elem x; pr_space());
481 pp_name name;
482 eopt +> Common.do_option (fun (ieq, e) ->
483 pr_elem ieq;
484 pp_expression e;
485 ));
486
487 (match sopt, iis with
488 | (Some s, [i1;i2;i3;i4]) -> pr_elem i4
489 | (Some s, [i1;i2;i3;i4;i5]) ->
490 pr_elem i5; pr_elem i4 (* trailing comma *)
491 | (None, [i1;i2;i3]) -> pr_elem i3
492 | (None, [i1;i2;i3;i4]) ->
493 pr_elem i4; pr_elem i3 (* trailing comma *)
494
495
496 | x -> raise Impossible
497 );
498
499
500 | (BaseType _, iis) ->
501 print_sto_qu_ty (sto, qu, iis);
502
503 | (StructUnionName (s, structunion), iis) ->
504 assert (List.length iis =|= 2);
505 print_sto_qu_ty (sto, qu, iis);
506
507 | (EnumName s, iis) ->
508 assert (List.length iis =|= 2);
509 print_sto_qu_ty (sto, qu, iis);
510
511 | (TypeName (name,typ), noii) ->
512 assert (null noii);
513 let (_s, iis) = get_s_and_info_of_name name in
514 print_sto_qu_ty (sto, qu, [iis]);
515
516 if !Flag_parsing_c.pretty_print_typedef_value
517 then begin
518 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "{*");
519 typ +> Common.do_option (fun typ ->
520 pp_type typ;
521 );
522 pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*}");
523 end;
524
525 | (TypeOfExpr (e), iis) ->
526 print_sto_qu (sto, qu);
527 (match iis with
528 | [itypeof;iopar;icpar] ->
529 pr_elem itypeof; pr_elem iopar;
530 pp_expression e;
531 pr_elem icpar;
532 | _ -> raise Impossible
533 )
534
535 | (TypeOfType (t), iis) ->
536 print_sto_qu (sto, qu);
537 (match iis with
538 | [itypeof;iopar;icpar] ->
539 pr_elem itypeof; pr_elem iopar;
540 pp_type t;
541 pr_elem icpar;
542 | _ -> raise Impossible
543 )
544
545 | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _
546 (* | StructUnion _ | Enum _ | BaseType _ *)
547 (* | StructUnionName _ | EnumName _ | TypeName _ *)
548 (* | TypeOfExpr _ | TypeOfType _ *)
549 ), _ -> raise Impossible
550
551 and pp_field_list fields = fields +> Common.print_between pr_nl pp_field
552 and pp_field = function
553 DeclarationField(FieldDeclList(onefield_multivars,iiptvirg))->
554 (match onefield_multivars with
555 x::xs ->
556 (* handling the first var. Special case, with the
557 first var, we print the whole type *)
558
559 (match x with
560 (Simple (nameopt, typ)), iivirg ->
561 (* first var cant have a preceding ',' *)
562 assert (List.length iivirg =|= 0);
563 let identinfo =
564 match nameopt with
565 | None -> None
566 | Some name -> Some (get_s_and_info_of_name name)
567 in
568 pp_type_with_ident identinfo None typ Ast_c.noattr;
569
570 | (BitField (nameopt, typ, iidot, expr)), iivirg ->
571 (* first var cant have a preceding ',' *)
572 assert (List.length iivirg =|= 0);
573 (match nameopt with
574 | None ->
575 pp_type typ;
576 | Some name ->
577 let (s, is) = get_s_and_info_of_name name in
578 pp_type_with_ident
579 (Some (s, is)) None typ Ast_c.noattr;
580 );
581 pr_elem iidot;
582 pp_expression expr
583
584 ); (* match x, first onefield_multivars *)
585
586 (* for other vars *)
587 xs +> List.iter (function
588 | (Simple (nameopt, typ)), iivirg ->
589 iivirg +> List.iter pr_elem;
590 let identinfo =
591 match nameopt with
592 | None -> None
593 | Some name -> Some (get_s_and_info_of_name name)
594 in
595 pp_type_with_ident_rest identinfo typ Ast_c.noattr
596
597 | (BitField (nameopt, typ, iidot, expr)), iivirg ->
598 iivirg +> List.iter pr_elem;
599 (match nameopt with
600 | Some name ->
601 let (s,is) = get_s_and_info_of_name name in
602 pp_type_with_ident_rest
603 (Some (s, is)) typ Ast_c.noattr;
604 pr_elem iidot;
605 pp_expression expr
606 | None ->
607 (* was raise Impossible, but have no idea why because
608 nameless bit fields are accepted by the parser and
609 nothing seems to be done to give them names *)
610 pr_elem iidot;
611 pp_expression expr
612 )); (* iter other vars *)
613
614 | [] -> raise Impossible
615 ); (* onefield_multivars *)
616 assert (List.length iiptvirg =|= 1);
617 iiptvirg +> List.iter pr_elem;
618
619
620 | MacroDeclField ((s, es), ii) ->
621 let (iis, lp, rp, iiend, ifakestart) =
622 Common.tuple_of_list5 ii in
623 (* iis::lp::rp::iiend::ifakestart::iisto
624 iisto +> List.iter pr_elem; (* static and const *)
625 *)
626 pr_elem ifakestart;
627 pr_elem iis;
628 pr_elem lp;
629 es +> List.iter (fun (e, opt) ->
630 assert (List.length opt <= 1);
631 opt +> List.iter pr_elem;
632 pp_argument e;
633 );
634
635 pr_elem rp;
636 pr_elem iiend;
637
638
639
640 | EmptyField iipttvirg_when_emptyfield ->
641 pr_elem iipttvirg_when_emptyfield
642
643 | CppDirectiveStruct cpp -> pp_directive cpp
644 | IfdefStruct ifdef -> pp_ifdef ifdef
645
646 (* used because of DeclList, in int i,*j[23]; we dont print anymore the
647 int before *j *)
648 and (pp_type_with_ident_rest: (string * info) option ->
649 fullType -> attribute list -> unit) =
650
651 fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs ->
652
653 let print_ident ident = Common.do_option (fun (s, iis) ->
654 (* XXX attrs +> pp_attributes pr_elem pr_space; *)
655 pr_elem iis
656 ) ident
657 in
658
659 match ty, iity with
660 (* the work is to do in base_type !! *)
661 | (NoType _, iis) -> ()
662 | (BaseType _, iis) -> print_ident ident
663 | (Enum (sopt, enumt), iis) -> print_ident ident
664 | (StructUnion (_, sopt, fields),iis) -> print_ident ident
665 | (StructUnionName (s, structunion), iis) -> print_ident ident
666 | (EnumName s, iis) -> print_ident ident
667 | (TypeName (_name,_typ), iis) -> print_ident ident
668 | (TypeOfExpr (e), iis) -> print_ident ident
669 | (TypeOfType (e), iis) -> print_ident ident
670
671
672
673 | (Pointer t, [i]) ->
674 (* subtil: void ( *done)(int i) is a Pointer
675 (FunctionType (return=void, params=int i) *)
676 (*WRONG I THINK, use left & right function *)
677 (* bug: pp_type_with_ident_rest None t; print_ident ident *)
678 pr_elem i;
679 iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
680 pp_type_with_ident_rest ident t attrs;
681
682 (* ugly special case ... todo? maybe sufficient in practice *)
683 | (ParenType ttop, [i1;i2]) ->
684 (match Ast_c.get_ty_and_ii ttop with
685 | (_q1, (Pointer t2, [ipointer])) ->
686 (match Ast_c.get_ty_and_ii t2 with
687 | (q2, (FunctionType t, ii3)) ->
688
689 pp_type_left (q2, mk_tybis (FunctionType t) ii3);
690 pr_elem i1;
691 pr_elem ipointer;
692 print_ident ident;
693 pr_elem i2;
694 pp_type_right (q2, mk_tybis (FunctionType t) ii3);
695 | _ ->
696 pr2 "PB PARENTYPE ZARB, I forget about the ()";
697 pp_type_with_ident_rest ident ttop attrs;
698 )
699 (* another ugly special case *)
700 | _q1, (Array (eopt,t2 ), [iarray1;iarray2]) ->
701 (match Ast_c.get_ty_and_ii t2 with
702 | (_q2, (Pointer t3, [ipointer])) ->
703 (match Ast_c.get_ty_and_ii t3 with
704 | (q3, (FunctionType t, iifunc)) ->
705
706 pp_type_left (q3, mk_tybis (FunctionType t) iifunc);
707 pr_elem i1;
708 pr_elem ipointer;
709 print_ident ident;
710 pr_elem iarray1;
711 do_option pp_expression eopt;
712 pr_elem iarray2;
713 pr_elem i2;
714 pp_type_right (q3, mk_tybis (FunctionType t) iifunc)
715 | _ ->
716 pr2 "PB PARENTYPE ZARB, I forget about the ()";
717 pp_type_with_ident_rest ident ttop attrs;
718 )
719 | _ ->
720 pr2 "PB PARENTYPE ZARB, I forget about the ()";
721 pp_type_with_ident_rest ident ttop attrs;
722 )
723 | _t ->
724
725 pr2 "PB PARENTYPE ZARB, I forget about the ()";
726 pp_type_with_ident_rest ident ttop attrs;
727 )
728
729
730 | (Array (eopt, t), [i1;i2]) ->
731 pp_type_left fullt;
732
733 iiqu +> List.iter pr_elem;
734 print_ident ident;
735
736 pp_type_right fullt;
737
738
739 | (FunctionType (returnt, paramst), [i1;i2]) ->
740 pp_type_left fullt;
741
742 iiqu +> List.iter pr_elem;
743 print_ident ident;
744
745 pp_type_right fullt;
746
747
748 | (FunctionType _ | Array _ | ParenType _ | Pointer _), _ ->
749 raise Impossible
750
751
752 and (pp_type_left: fullType -> unit) =
753 fun ((qu, iiqu), (ty, iity)) ->
754 match ty, iity with
755 (NoType,_) -> failwith "pp_type_left: unexpected NoType"
756 | (Pointer t, [i]) ->
757 pr_elem i;
758 iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
759 pp_type_left t
760
761 | (Array (eopt, t), [i1;i2]) -> pp_type_left t
762 | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt
763
764 | (ParenType t, _) -> failwith "parenType"
765
766
767 | (BaseType _, iis) -> ()
768 | (Enum (sopt, enumt), iis) -> ()
769 | (StructUnion (_, sopt, fields),iis) -> ()
770 | (StructUnionName (s, structunion), iis) -> ()
771 | (EnumName s, iis) -> ()
772 | (TypeName (_name,_typ), iis) -> ()
773
774 | TypeOfType _, _ -> ()
775 | TypeOfExpr _, _ -> ()
776
777 | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible
778
779
780 and pp_param param =
781 let {p_namei = nameopt;
782 p_register = (b,iib);
783 p_type=t;} = param in
784
785 iib +> List.iter pr_elem;
786
787 match nameopt with
788 | None ->
789 pp_type t
790 | Some name ->
791 let (s,i1) = get_s_and_info_of_name name in
792 pp_type_with_ident
793 (Some (s, i1)) None t Ast_c.noattr
794
795
796
797
798 and pp_type_right (((qu, iiqu), (ty, iity)) : fullType) =
799 match ty, iity with
800 (NoType,_) -> failwith "pp_type_right: unexpected NoType"
801 | (Pointer t, [i]) -> pp_type_right t
802
803 | (Array (eopt, t), [i1;i2]) ->
804 pr_elem i1;
805 eopt +> do_option pp_expression;
806 pr_elem i2;
807 pp_type_right t
808
809 | (ParenType t, _) -> failwith "parenType"
810 | (FunctionType (returnt, paramst), [i1;i2]) ->
811 pr_elem i1;
812 (match paramst with
813 | (ts, (b, iib)) ->
814 ts +> List.iter (fun (param,iicomma) ->
815 assert ((List.length iicomma) <= 1);
816 iicomma +> List.iter (function x -> pr_elem x; pr_space());
817
818 pp_param param;
819 );
820 iib +> List.iter pr_elem;
821 );
822 pr_elem i2
823
824 | (BaseType _, iis) -> ()
825 | (Enum (sopt, enumt), iis) -> ()
826 | (StructUnion (_, sopt, fields),iis)-> ()
827 | (StructUnionName (s, structunion), iis) -> ()
828 | (EnumName s, iis) -> ()
829 | (TypeName (name,_typ), iis) -> ()
830
831 | TypeOfType _, _ -> ()
832 | TypeOfExpr _, _ -> ()
833
834 | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible
835
836 and pp_type t =
837 pp_type_with_ident None None t Ast_c.noattr
838
839 (* ---------------------- *)
840 and pp_decl = function
841 | DeclList ((({v_namei = var;
842 v_type = returnType;
843 v_storage = storage;
844 v_attr = attrs;
845 },[])::xs),
846 iivirg::ifakestart::iisto) ->
847
848 pr_elem ifakestart;
849
850 (* old: iisto +> List.iter pr_elem; *)
851
852
853 (* handling the first var. Special case, we print the whole type *)
854 (match var with
855 | Some (name, iniopt) ->
856 let (s,iis) = get_s_and_info_of_name name in
857 pp_type_with_ident
858 (Some (s, iis)) (Some (storage, iisto))
859 returnType attrs;
860 (match iniopt with
861 Ast_c.NoInit -> ()
862 | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init
863 | Ast_c.ConstrInit((init,[lp;rp])) ->
864 pr_elem lp; pp_arg_list init; pr_elem rp
865 | Ast_c.ConstrInit _ -> raise Impossible)
866 | None -> pp_type returnType
867 );
868
869 (* for other vars, we just call pp_type_with_ident_rest. *)
870 xs +> List.iter (function
871 | ({v_namei = Some (name, iniopt);
872 v_type = returnType;
873 v_storage = storage2;
874 v_attr = attrs;
875 }, iivirg) ->
876
877 let (s,iis) = get_s_and_info_of_name name in
878 assert (storage2 =*= storage);
879 iivirg +> List.iter pr_elem;
880 pp_type_with_ident_rest
881 (Some (s, iis)) returnType attrs;
882 (match iniopt with
883 Ast_c.NoInit -> ()
884 | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init
885 | Ast_c.ConstrInit((init,[lp;rp])) ->
886 pr_elem lp; pp_arg_list init; pr_elem rp
887 | Ast_c.ConstrInit _ -> raise Impossible);
888
889
890 | x -> raise Impossible
891 );
892
893 pr_elem iivirg;
894
895 | MacroDecl ((s, es, true), iis::lp::rp::iiend::ifakestart::iisto) ->
896 pr_elem ifakestart;
897 iisto +> List.iter pr_elem; (* static and const *)
898 pr_elem iis;
899 pr_elem lp;
900 es +> List.iter (fun (e, opt) ->
901 assert (List.length opt <= 1);
902 opt +> List.iter pr_elem;
903 pp_argument e;
904 );
905
906 pr_elem rp;
907 pr_elem iiend;
908
909 | MacroDecl ((s, es, false), iis::lp::rp::ifakestart::iisto) ->
910 pr_elem ifakestart;
911 iisto +> List.iter pr_elem; (* static and const *)
912 pr_elem iis;
913 pr_elem lp;
914 es +> List.iter (fun (e, opt) ->
915 assert (List.length opt <= 1);
916 opt +> List.iter pr_elem;
917 pp_argument e;
918 );
919
920 pr_elem rp;
921
922 | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible
923
924
925 (* ---------------------- *)
926 and pp_init (init, iinit) =
927 match init, iinit with
928 | InitExpr e, [] -> pp_expression e;
929 | InitList xs, i1::i2::iicommaopt ->
930 pr_elem i1; start_block();
931 xs +> List.iter (fun (x, ii) ->
932 assert (List.length ii <= 1);
933 ii +> List.iter (function e -> pr_elem e; pr_nl());
934 pp_init x
935 );
936 iicommaopt +> List.iter pr_elem;
937 end_block();
938 pr_elem i2;
939
940 | InitDesignators (xs, initialiser), [i1] -> (* : *)
941 xs +> List.iter pp_designator;
942 pr_elem i1;
943 pp_init initialiser
944
945 (* no use of '=' in the "Old" style *)
946 | InitFieldOld (string, initialiser), [i1;i2] -> (* label: in oldgcc *)
947 pr_elem i1; pr_elem i2; pp_init initialiser
948 | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *)
949 pr_elem i1; pp_expression expression; pr_elem i2;
950 pp_init initialiser
951
952 | (InitIndexOld _ | InitFieldOld _ | InitDesignators _
953 | InitList _ | InitExpr _
954 ), _ -> raise Impossible
955
956 and pp_init_list ini = pp_list pp_init ini
957
958 and pp_designator = function
959 | DesignatorField (s), [i1; i2] ->
960 pr_elem i1; pr_elem i2;
961 | DesignatorIndex (expression), [i1;i2] ->
962 pr_elem i1; pp_expression expression; pr_elem i2;
963
964 | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] ->
965 pr_elem iocro; pp_expression e1; pr_elem iellipsis;
966 pp_expression e2; pr_elem iccro;
967
968 | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _
969 ), _ -> raise Impossible
970
971
972 (* ---------------------- *)
973 and pp_attributes pr_elem pr_space attrs =
974 attrs +> List.iter (fun (attr, ii) ->
975 ii +> List.iter pr_elem;
976 );
977
978 (* ---------------------- *)
979 and pp_def def =
980 let defbis, ii = def in
981 match ii with
982 | iifunc1::iifunc2::i1::i2::ifakestart::isto ->
983 let {f_name = name;
984 f_type = (returnt, (paramst, (b, iib)));
985 f_storage = sto;
986 f_body = statxs;
987 f_attr = attrs;
988 } = defbis
989 in
990 pr_elem ifakestart;
991
992 pp_type_with_ident None (Some (sto, isto))
993 returnt Ast_c.noattr;
994
995 pp_attributes pr_elem pr_space attrs;
996 pr_space();
997 pp_name name;
998
999 pr_elem iifunc1;
1000
1001 (* not anymore, cf tests/optional_name_parameter and
1002 macro_parameter_shortcut.c
1003 (match paramst with
1004 | [(((bool, None, t), ii_b_s), iicomma)] ->
1005 assert
1006 (match t with
1007 | qu, (BaseType Void, ii) -> true
1008 | _ -> true
1009 );
1010 assert (null iicomma);
1011 assert (null ii_b_s);
1012 pp_type_with_ident None None t
1013
1014 | paramst ->
1015 paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
1016 iicomma +> List.iter pr_elem;
1017
1018 (match b, s, ii_b_s with
1019 | false, Some s, [i1] ->
1020 pp_type_with_ident (Some (s, i1)) None t;
1021 | true, Some s, [i1;i2] ->
1022 pr_elem i1;
1023 pp_type_with_ident (Some (s, i2)) None t;
1024
1025 (* in definition we have name for params, except when f(void) *)
1026 | _, None, _ -> raise Impossible
1027 | false, None, [] ->
1028
1029 | _ -> raise Impossible
1030 )));
1031
1032 (* normally ii represent the ",..." but it is also abused
1033 with the f(void) case *)
1034 (* assert (List.length iib <= 2);*)
1035 iib +> List.iter pr_elem;
1036
1037 *)
1038 pp_param_list paramst;
1039 iib +> List.iter pr_elem;
1040
1041
1042 pr_elem iifunc2; pr_space();
1043 pr_elem i1;
1044 statxs +> List.iter pp_statement_seq;
1045 pr_elem i2;
1046 | _ -> raise Impossible
1047
1048 and pp_param_list paramst = pp_list pp_param paramst
1049
1050 (* ---------------------- *)
1051
1052 and pp_ifdef ifdef =
1053 match ifdef with
1054 | IfdefDirective (ifdef, ii) ->
1055 List.iter pr_elem ii
1056
1057
1058 and pp_directive = function
1059 | Include {i_include = (s, ii);} ->
1060 let (i1,i2) = Common.tuple_of_list2 ii in
1061 pr_elem i1; pr_space(); pr_elem i2
1062 | Define ((s,ii), (defkind, defval)) ->
1063 let (idefine,iident,ieol) = Common.tuple_of_list3 ii in
1064 pr_elem idefine;
1065 pr_elem iident;
1066
1067 let define_val = function
1068 | DefineExpr e -> pp_expression e
1069 | DefineStmt st -> pp_statement st
1070 | DefineDoWhileZero ((st,e), ii) ->
1071 (match ii with
1072 | [ido;iwhile;iopar;icpar] ->
1073 pr_elem ido;
1074 pp_statement st;
1075 pr_elem iwhile; pr_elem iopar;
1076 pp_expression e;
1077 pr_elem icpar
1078 | _ -> raise Impossible
1079 )
1080 | DefineFunction def -> pp_def def
1081
1082 | DefineType ty -> pp_type ty
1083 | DefineText (s, ii) -> List.iter pr_elem ii
1084 | DefineEmpty -> ()
1085 | DefineInit ini -> pp_init ini
1086
1087 | DefineTodo -> pr2 "DefineTodo"
1088 in
1089 (match defkind with
1090 | DefineVar | Undef -> ()
1091 | DefineFunc (params, ii) ->
1092 let (i1,i2) = tuple_of_list2 ii in
1093 pr_elem i1;
1094 params +> List.iter (fun ((s,iis), iicomma) ->
1095 assert (List.length iicomma <= 1);
1096 iicomma +> List.iter pr_elem;
1097 iis +> List.iter pr_elem;
1098 );
1099 pr_elem i2;
1100 );
1101 define_val defval;
1102 pr_elem ieol
1103
1104 | PragmaAndCo (ii) ->
1105 List.iter pr_elem ii in
1106
1107
1108
1109
1110 let pp_toplevel = function
1111 | Declaration decl -> pp_decl decl
1112 | Definition def -> pp_def def
1113
1114 | CppTop directive -> pp_directive directive
1115
1116
1117 | MacroTop (s, es, [i1;i2;i3;i4]) ->
1118 pr_elem i1;
1119 pr_elem i2;
1120 es +> List.iter (fun (e, opt) ->
1121 assert (List.length opt <= 1);
1122 opt +> List.iter pr_elem;
1123 pp_argument e;
1124 );
1125 pr_elem i3;
1126 pr_elem i4;
1127
1128
1129 | EmptyDef ii -> ii +> List.iter pr_elem
1130 | NotParsedCorrectly ii ->
1131 assert (List.length ii >= 1);
1132 ii +> List.iter pr_elem
1133 | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info)
1134
1135 | IfdefTop ifdefdir -> pp_ifdef ifdefdir
1136
1137 | (MacroTop _) -> raise Impossible in
1138
1139
1140
1141
1142 let pp_flow n =
1143 match F.unwrap n with
1144 | F.FunHeader ({f_name =idb;
1145 f_type = (rett, (paramst,(isvaargs,iidotsb)));
1146 f_storage = stob;
1147 f_body = body;
1148 f_attr = attrs},ii) ->
1149
1150 assert(null body);
1151 (*
1152 iif ii;
1153 iif iidotsb;
1154 attrs +> List.iter (vk_attribute bigf);
1155 vk_type bigf rett;
1156 paramst +> List.iter (fun (param, iicomma) ->
1157 vk_param bigf param;
1158 iif iicomma;
1159 );
1160 *)
1161 pr2 "Def";
1162
1163
1164 | F.Decl decl ->
1165 (* vk_decl bigf decl *)
1166 pr2 "Decl"
1167
1168 | F.ExprStatement (st, (eopt, ii)) ->
1169 pp_statement (Ast_c.mk_st (ExprStatement eopt) ii)
1170
1171 | F.IfHeader (_, (e,ii))
1172 | F.SwitchHeader (_, (e,ii))
1173 | F.WhileHeader (_, (e,ii))
1174 | F.DoWhileTail (e,ii) ->
1175 (*
1176 iif ii;
1177 vk_expr bigf e
1178 *)
1179 pr2 "XXX";
1180
1181
1182 | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
1183 (*
1184 iif i1; iif i2; iif i3;
1185 iif ii;
1186 e1opt +> do_option (vk_expr bigf);
1187 e2opt +> do_option (vk_expr bigf);
1188 e3opt +> do_option (vk_expr bigf);
1189 *)
1190 pr2 "XXX"
1191
1192 | F.MacroIterHeader (_s, ((s,es), ii)) ->
1193 (*
1194 iif ii;
1195 vk_argument_list bigf es;
1196 *)
1197 pr2 "XXX"
1198
1199
1200 | F.ReturnExpr (_st, (e,ii)) ->
1201 (* iif ii; vk_expr bigf e*)
1202 pr2 "XXX"
1203
1204
1205 | F.Case (_st, (e,ii)) ->
1206 (* iif ii; vk_expr bigf e *)
1207 pr2 "XXX"
1208
1209 | F.CaseRange (_st, ((e1, e2),ii)) ->
1210 (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
1211 pr2 "XXX"
1212
1213
1214
1215 | F.CaseNode i -> ()
1216
1217 | F.DefineExpr e ->
1218 (* vk_expr bigf e *)
1219 pr2 "XXX"
1220
1221 | F.DefineType ft ->
1222 (* vk_type bigf ft *)
1223 pr2 "XXX"
1224
1225 | F.DefineHeader ((s,ii), (defkind)) ->
1226 (*
1227 iif ii;
1228 vk_define_kind bigf defkind;
1229 *)
1230 pr2 "XXX"
1231
1232
1233 | F.DefineDoWhileZeroHeader (((),ii)) ->
1234 (* iif ii *)
1235 pr2 "XXX"
1236
1237
1238 | F.Include {i_include = (s, ii);} ->
1239 (* iif ii; *)
1240 pr2 "XXX"
1241
1242
1243 | F.MacroTop (s, args, ii) ->
1244 (* iif ii;
1245 vk_argument_list bigf args *)
1246 pr2 "XXX"
1247
1248
1249 | F.Break (st,((),ii)) ->
1250 (* iif ii *)
1251 pr2 "XXX"
1252 | F.Continue (st,((),ii)) ->
1253 (* iif ii *)
1254 pr2 "XXX"
1255 | F.Default (st,((),ii)) ->
1256 (* iif ii *)
1257 pr2 "XXX"
1258 | F.Return (st,((),ii)) ->
1259 (* iif ii *)
1260 pr2 "XXX"
1261 | F.Goto (st, name, ((),ii)) ->
1262 (* iif ii *)
1263 pr2 "XXX"
1264 | F.Label (st, name, ((),ii)) ->
1265 (* iif ii *)
1266 pr2 "XXX"
1267 | F.EndStatement iopt ->
1268 (* do_option infof iopt *)
1269 pr2 "XXX"
1270 | F.DoHeader (st, info) ->
1271 (* infof info *)
1272 pr2 "XXX"
1273 | F.Else info ->
1274 (* infof info *)
1275 pr2 "XXX"
1276 | F.SeqEnd (i, info) ->
1277 (* infof info *)
1278 pr2 "XXX"
1279 | F.SeqStart (st, i, info) ->
1280 (* infof info *)
1281 pr2 "XXX"
1282
1283 | F.MacroStmt (st, ((),ii)) ->
1284 (* iif ii *)
1285 pr2 "XXX"
1286 | F.Asm (st, (asmbody,ii)) ->
1287 (*
1288 iif ii;
1289 vk_asmbody bigf asmbody
1290 *)
1291 pr2 "XXX"
1292
1293
1294 | F.IfdefHeader (info) ->
1295 pp_ifdef info
1296 | F.IfdefElse (info) ->
1297 pp_ifdef info
1298 | F.IfdefEndif (info) ->
1299 pp_ifdef info
1300
1301 | F.DefineTodo ->
1302 pr2 "XXX"
1303
1304
1305 | (F.TopNode|F.EndNode|
1306 F.ErrorExit|F.Exit|F.Enter|F.LoopFallThroughNode|F.FallThroughNode|
1307 F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
1308 F.Fake) ->
1309 pr2 "YYY" in
1310
1311
1312 { expression = pp_expression;
1313 arg_list = pp_arg_list;
1314 statement = pp_statement;
1315 decl = pp_decl;
1316 field = pp_field;
1317 field_list = pp_field_list;
1318 init = pp_init;
1319 init_list = pp_init_list;
1320 param = pp_param;
1321 paramlist = pp_param_list;
1322 ty = pp_type;
1323 type_with_ident = pp_type_with_ident;
1324 toplevel = pp_toplevel;
1325 flow = pp_flow;
1326 }
1327
1328 (*****************************************************************************)
1329
1330 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
1331 let pr_elem info =
1332 let s = Ast_c.str_of_info info in
1333 if !Flag_parsing_c.pretty_print_comment_info then begin
1334 let before = !(info.comments_tag).mbefore in
1335 if not (null before) then begin
1336 pp "-->";
1337 before +> List.iter (fun (comment_like, pinfo) ->
1338 let s = pinfo.Common.str in
1339 pp s
1340 );
1341 pp "<--";
1342 end;
1343 end;
1344 pp s
1345
1346 let pr_space _ = Format.print_space()
1347
1348 let pr_nl _ = ()
1349 let pr_indent _ = ()
1350 let pr_outdent _ = ()
1351 let pr_unindent _ = ()
1352
1353
1354 let ppc =
1355 mk_pretty_printers
1356 ~pr_elem ~pr_space ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent
1357
1358 let pp_expression_simple = ppc.expression
1359 let pp_decl_simple = ppc.decl
1360 let pp_field_simple = ppc.field
1361 let pp_statement_simple = ppc.statement
1362 let pp_type_simple = ppc.ty
1363 let pp_init_simple = ppc.init
1364 let pp_toplevel_simple = ppc.toplevel
1365 let pp_flow_simple = ppc.flow
1366
1367
1368 let pp_elem_sp ~pr_elem ~pr_space =
1369 mk_pretty_printers
1370 ~pr_elem ~pr_space
1371 ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent
1372
1373 let pp_expression_gen ~pr_elem ~pr_space =
1374 (pp_elem_sp pr_elem pr_space).expression
1375
1376 let pp_arg_list_gen ~pr_elem ~pr_space =
1377 (pp_elem_sp pr_elem pr_space).arg_list
1378
1379 let pp_statement_gen ~pr_elem ~pr_space =
1380 (pp_elem_sp pr_elem pr_space).statement
1381
1382 let pp_decl_gen ~pr_elem ~pr_space =
1383 (pp_elem_sp pr_elem pr_space).decl
1384
1385 let pp_field_gen ~pr_elem ~pr_space =
1386 (pp_elem_sp pr_elem pr_space).field
1387
1388 let pp_field_list_gen ~pr_elem ~pr_space =
1389 (pp_elem_sp pr_elem pr_space).field_list
1390
1391 let pp_init_gen ~pr_elem ~pr_space =
1392 (pp_elem_sp pr_elem pr_space).init
1393
1394 let pp_init_list_gen ~pr_elem ~pr_space =
1395 (pp_elem_sp pr_elem pr_space).init_list
1396
1397 let pp_param_gen ~pr_elem ~pr_space =
1398 (pp_elem_sp pr_elem pr_space).param
1399
1400 let pp_param_list_gen ~pr_elem ~pr_space =
1401 (pp_elem_sp pr_elem pr_space).paramlist
1402
1403 let pp_type_gen ~pr_elem ~pr_space =
1404 (pp_elem_sp pr_elem pr_space).ty
1405
1406 let pp_type_with_ident_gen pr_elem pr_space =
1407 (pp_elem_sp pr_elem pr_space).type_with_ident
1408
1409 let pp_program_gen ~pr_elem ~pr_space =
1410 (pp_elem_sp pr_elem pr_space).toplevel
1411
1412
1413 let string_of_expression e =
1414 Common.format_to_string (fun () ->
1415 pp_expression_simple e
1416 )
1417
1418 let string_of_toplevel top =
1419 Common.format_to_string (fun () ->
1420 pp_toplevel_simple top
1421 )
1422
1423 let (debug_info_of_node:
1424 Ograph_extended.nodei -> Control_flow_c.cflow -> string) =
1425 fun nodei flow ->
1426 let node = flow#nodes#assoc nodei in
1427 let s = Common.format_to_string (fun () ->
1428 pp_flow_simple node
1429 ) in
1430 let pos = Lib_parsing_c.min_pinfo_of_node node in
1431 (spf "%s(n%d)--> %s" (Common.string_of_parse_info_bis pos) nodei s)
1432
Unnamed repository; edit this file 'description' to name the repository.