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


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