HCoop / bpt / coccinelle.git / blob
? search:


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