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