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