parsing_c/pretty_print_c.ml

   1 (* Copyright (C) 2002-2008 Yoann Padioleau
   2  *
   3  * This program is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU General Public License (GPL)
   5  * version 2 as published by the Free Software Foundation.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * file license.txt for more details.
  11  *)
  12 open Common
  13
  14 open Ast_c
  15
  16 type pr_elem_func = Ast_c.info -> unit
  17 type pr_space_func = unit -> unit
  18
  19 (*****************************************************************************)
  20
  21 (* This module is used by unparse_c, but because unparse_c have also
  22  * the list of tokens, pretty_print_c could be useless in the futur
  23  * (except that the ast_c have some fake tokens not present in the list
  24  * of tokens so it's still useful). But this module is also useful to
  25  * unparse C when you don't have the ordered list of tokens separately,
  26  * or tokens without position information, for instance when you want
  27  * to pretty print some piece of C that was generated, or some
  28  * abstract-lined piece of code, etc. *)
  29
  30 let rec pp_expression_gen pr_elem pr_space =
  31   (* subtil: dont try to shorten the def of pp_statement by omitting e,
  32      otherwise get infinite funcall and huge memory consumption *)
  33   let pp_statement e = pp_statement_gen pr_elem pr_space e in
  34   let rec pp_expression = fun ((exp, typ), ii) ->
  35     (match exp, ii with
  36     | Ident (c),         [i]     -> pr_elem i
  37     (* only a MultiString can have multiple ii *)
  38     | Constant (MultiString), is     -> is +> List.iter pr_elem
  39     | Constant (c),         [i]     -> pr_elem i
  40     | FunCall  (e, es),     [i1;i2] ->
  41         pp_expression e; pr_elem i1;
  42         es +> List.iter (fun (e, opt) ->
  43           assert (List.length opt <= 1); (* opt must be a comma? *)
  44           opt +> List.iter (function x -> pr_elem x; pr_space());
  45           pp_argument_gen pr_elem pr_space e;
  46         );
  47         pr_elem i2;
  48
  49     | CondExpr (e1, e2, e3),    [i1;i2]    ->
  50         pp_expression e1; pr_space(); pr_elem i1; pr_space();
  51         do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2;
  52         pp_expression e3
  53     | Sequence (e1, e2),          [i]  ->
  54         pp_expression e1; pr_elem i; pr_space(); pp_expression e2
  55     | Assignment (e1, op, e2),    [i]  ->
  56         pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
  57
  58     | Postfix  (e, op),    [i] -> pp_expression e; pr_elem i;
  59     | Infix    (e, op),    [i] -> pr_elem i; pp_expression e;
  60     | Unary    (e, op),    [i] -> pr_elem i; pp_expression e
  61     | Binary   (e1, op, e2),    [i] ->
  62         pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2
  63
  64     | ArrayAccess    (e1, e2),   [i1;i2] ->
  65         pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2
  66     | RecordAccess   (e, s),     [i1;i2] ->
  67         pp_expression e; pr_elem i1; pr_elem i2
  68     | RecordPtAccess (e, s),     [i1;i2] ->
  69         pp_expression e; pr_elem i1; pr_elem i2
  70
  71     | SizeOfExpr  (e),     [i] -> pr_elem i; pp_expression e
  72     | SizeOfType  (t),     [i1;i2;i3] ->
  73         pr_elem i1; pr_elem i2; pp_type_gen pr_elem pr_space t;
  74         pr_elem i3
  75     | Cast    (t, e),      [i1;i2] ->
  76         pr_elem i1; pp_type_gen pr_elem pr_space t; pr_elem i2;
  77         pp_expression e
  78
  79     | StatementExpr (statxs, [ii1;ii2]),  [i1;i2] ->
  80         pr_elem i1;
  81         pr_elem ii1;
  82         statxs +> List.iter pp_statement;
  83         pr_elem ii2;
  84         pr_elem i2;
  85     | Constructor (t, xs), lp::rp::i1::i2::iicommaopt ->
  86         pr_elem lp;
  87         pp_type_gen pr_elem pr_space t;
  88         pr_elem rp;
  89         pr_elem i1;
  90         xs +> List.iter (fun (x, ii) ->
  91           assert (List.length ii <= 1);
  92           ii +> List.iter (function x -> pr_elem x; pr_space());
  93           pp_init_gen pr_elem pr_space x
  94         );
  95         iicommaopt +> List.iter pr_elem;
  96         pr_elem i2;
  97
  98
  99
 100     | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2;
 101
 102     | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_)
 103         | Sequence (_,_)
 104         | Assignment (_,_,_)
 105         | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_)
 106         | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_)
 107         | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_)
 108         | StatementExpr (_) | Constructor _
 109         | ParenExpr (_)
 110       ),_ -> raise Impossible
 111     );
 112     if !Flag_parsing_c.pretty_print_type_info
 113     then begin
 114       pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*");
 115       !typ +>
 116       (fun (ty,_test) -> ty +>
 117       Common.do_option
 118         (fun (x,l) -> pp_type_gen pr_elem pr_space x;
 119           let s = match l with
 120             Ast_c.LocalVar _ -> ", local"
 121           | _ -> "" in
 122           pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s)));
 123       pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/");
 124     end
 125
 126   in
 127   pp_expression
 128
 129
 130 and pp_argument_gen pr_elem pr_space argument =
 131   let rec pp_action = function
 132     | (ActMisc ii) -> ii +> List.iter pr_elem
 133   in
 134   match argument with
 135   | Left e -> pp_expression_gen pr_elem pr_space e
 136   | Right wierd ->
 137       (match wierd with
 138       | ArgType param -> pp_param_gen pr_elem pr_space param
 139       | ArgAction action -> pp_action action
 140       )
 141
 142
 143
 144
 145
 146 (* ---------------------- *)
 147 and pp_statement_gen pr_elem pr_space =
 148   let pp_expression e = pp_expression_gen pr_elem pr_space e in
 149   let rec pp_statement = function
 150     | Labeled (Label (s, st)), [i1;i2] ->
 151         pr_elem i1; pr_elem i2; pp_statement st
 152     | Labeled (Case  (e, st)), [i1;i2] ->
 153         pr_elem i1; pp_expression e; pr_elem i2; pp_statement st
 154     | Labeled (CaseRange  (e, e2, st)), [i1;i2;i3] ->
 155         pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3;
 156         pp_statement st
 157     | Labeled (Default st), [i1;i2] -> pr_elem i1; pr_elem i2; pp_statement st
 158     | Compound statxs, [i1;i2] ->
 159         pr_elem i1; statxs +> List.iter pp_statement; pr_elem i2;
 160
 161     | ExprStatement (None), [i] -> pr_elem i;
 162     | ExprStatement (None), [] -> ()
 163     | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i
 164         (* the last ExprStatement of a for does not have a trailing
 165            ';' hence the [] for ii *)
 166     | ExprStatement (Some e), [] -> pp_expression e;
 167     | Selection  (If (e, st1, st2)), i1::i2::i3::is ->
 168         pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st1;
 169         (match (st2, is) with
 170         | ((ExprStatement None, []), [])  -> ()
 171         | ((ExprStatement None, []), [iifakend])  -> pr_elem iifakend
 172         | st2, [i4;iifakend] -> pr_elem i4; pp_statement st2; pr_elem iifakend
 173         | x -> raise Impossible
 174         )
 175     | Selection  (Switch (e, st)), [i1;i2;i3;iifakend] ->
 176         pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st;
 177         pr_elem iifakend
 178     | Iteration  (While (e, st)), [i1;i2;i3;iifakend] ->
 179         pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st;
 180         pr_elem iifakend
 181     | Iteration  (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] ->
 182         pr_elem i1; pp_statement st; pr_elem i2; pr_elem i3; pp_expression e;
 183         pr_elem i4; pr_elem i5;
 184         pr_elem iifakend
 185
 186
 187     | Iteration  (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)),
 188         [i1;i2;i3;iifakend] ->
 189
 190         pr_elem i1;
 191         pr_elem i2;
 192         pp_statement (ExprStatement e1opt, il1);
 193         pp_statement (ExprStatement e2opt, il2);
 194         assert (null il3);
 195         pp_statement (ExprStatement e3opt, il3);
 196         pr_elem i3;
 197         pp_statement st;
 198         pr_elem iifakend
 199
 200     | Iteration  (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] ->
 201         pr_elem i1;
 202         pr_elem i2;
 203
 204         es +> List.iter (fun (e, opt) ->
 205           assert (List.length opt <= 1);
 206           opt +> List.iter pr_elem;
 207           pp_argument_gen pr_elem pr_space e;
 208         );
 209
 210         pr_elem i3;
 211         pp_statement st;
 212         pr_elem iifakend
 213
 214     | Jump (Goto s), [i1;i2;i3]               ->
 215         pr_elem i1; pr_space(); pr_elem i2; pr_elem i3;
 216     | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2;
 217     | Jump (ReturnExpr e), [i1;i2] ->
 218         pr_elem i1; pr_space(); pp_expression e; pr_elem i2
 219     | Jump (GotoComputed e), [i1;i2;i3] ->
 220         pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3
 221
 222     | Decl decl, [] -> pp_decl_gen pr_elem pr_space decl
 223     | Asm asmbody, ii ->
 224         (match ii with
 225         | [iasm;iopar;icpar;iptvirg] ->
 226             pr_elem iasm; pr_elem iopar;
 227             pp_asmbody_gen pr_elem pr_space asmbody;
 228             pr_elem icpar; pr_elem iptvirg
 229         | [iasm;ivolatile;iopar;icpar;iptvirg] ->
 230             pr_elem iasm; pr_elem ivolatile; pr_elem iopar;
 231             pp_asmbody_gen pr_elem pr_space asmbody;
 232             pr_elem icpar; pr_elem iptvirg
 233         | _ -> raise Impossible
 234         )
 235
 236     | NestedFunc def, ii ->
 237         assert (null ii);
 238         pp_def_gen pr_elem pr_space def
 239     | MacroStmt, ii ->
 240         ii +> List.iter pr_elem ;
 241
 242     | Selection  (Ifdef (st1s, st2s)), i1::i2::is ->
 243         pr_elem i1;
 244         st1s +> List.iter pp_statement;
 245         (match (st2s, is) with
 246         | [], [iifakend] -> pr_elem i2; pr_elem iifakend
 247         | x::xs, [i3;iifakend] ->
 248             pr_elem i2;
 249             st2s +> List.iter pp_statement;
 250             pr_elem i3;
 251             pr_elem iifakend
 252
 253         | _ -> raise Impossible
 254         )
 255     | ( Labeled (Label (_,_)) | Labeled (Case  (_,_))
 256         | Labeled (CaseRange  (_,_,_)) | Labeled (Default _)
 257         | Compound _ | ExprStatement _
 258         | Selection  (If (_, _, _)) | Selection  (Switch (_, _))
 259         | Iteration  (While (_, _)) | Iteration  (DoWhile (_, _))
 260         | Iteration  (For ((_,_), (_,_), (_, _), _))
 261         | Iteration  (MacroIteration (_,_,_))
 262         | Jump (Goto _) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _)
 263         | Jump (GotoComputed _)
 264         | Decl _ | Selection (Ifdef (_,_))
 265       ), _ -> raise Impossible
 266
 267   in
 268   pp_statement
 269
 270
 271 and pp_asmbody_gen pr_elem pr_space (string_list, colon_list) =
 272   string_list +> List.iter pr_elem ;
 273   colon_list +> List.iter (fun (Colon xs, ii) ->
 274     ii +> List.iter pr_elem;
 275     xs +> List.iter (fun (x,iicomma) ->
 276       assert ((List.length iicomma) <= 1);
 277       iicomma +> List.iter (function x -> pr_elem x; pr_space());
 278       (match x with
 279       | ColonMisc, ii -> ii +> List.iter pr_elem;
 280       | ColonExpr e, [istring;iopar;icpar] ->
 281           pr_elem istring;
 282           pr_elem iopar;
 283           pp_expression_gen pr_elem pr_space e;
 284           pr_elem icpar
 285       | _ -> raise Impossible
 286       )
 287     ))
 288
 289
 290 (* ---------------------- *)
 291 and (pp_type_with_ident_gen:
 292         pr_elem_func -> pr_space_func ->
 293       (string * info) option -> (storage * il) option -> fullType -> unit) =
 294   fun pr_elem pr_space ->
 295     fun ident sto ((qu, iiqu), (ty, iity)) ->
 296       pp_base_type_gen pr_elem pr_space ((qu, iiqu), (ty, iity))  sto;
 297       pp_type_with_ident_rest_gen pr_elem pr_space ident
 298         ((qu, iiqu), (ty, iity))
 299
 300
 301 and (pp_base_type_gen:
 302        pr_elem_func -> pr_space_func -> fullType ->
 303          (storage * il) option -> unit) =
 304   fun pr_elem pr_space ->
 305     let pp_expression e = pp_expression_gen pr_elem pr_space e in
 306
 307     let rec pp_base_type =
 308       fun (qu, (ty, iity)) sto ->
 309         let get_sto sto =
 310           match sto with
 311           | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis
 312         in
 313         let print_sto_qu (sto, (qu, iiqu)) =
 314           let all_ii = get_sto sto ++ iiqu in
 315           all_ii
 316           +> List.sort Ast_c.compare_pos
 317           +> List.iter pr_elem;
 318
 319         in
 320         let print_sto_qu_ty (sto, (qu, iiqu), iity) =
 321           let all_ii = get_sto sto ++ iiqu ++ iity in
 322           let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in
 323
 324           if all_ii <> all_ii2
 325           then begin
 326             (* TODO in fact for pointer, the qualifier is after the type
 327              * cf -test strangeorder
 328              *)
 329             pr2 "STRANGEORDER";
 330             all_ii2 +> List.iter pr_elem
 331           end
 332           else all_ii2 +> List.iter pr_elem
 333         in
 334
 335         match ty, iity with
 336         | (Pointer t, [i])                           -> pp_base_type t sto
 337         | (ParenType t, _)                           -> pp_base_type t sto
 338         | (Array (eopt, t), [i1;i2])                 -> pp_base_type t sto
 339         | (FunctionType (returnt, paramst), [i1;i2]) ->
 340             pp_base_type returnt sto
 341
 342
 343         | (StructUnion (su, sopt, fields),iis) ->
 344             print_sto_qu (sto, qu);
 345
 346             (match sopt,iis with
 347             | Some s , [i1;i2;i3;i4] ->
 348                 pr_elem i1; pr_elem i2; pr_elem i3;
 349             | None, [i1;i2;i3] ->
 350                 pr_elem i1; pr_elem i2;
 351             | x -> raise Impossible
 352             );
 353
 354             fields +> List.iter
 355               (fun (xfield, iipttvirg) ->
 356
 357                 match xfield with
 358                 | FieldDeclList onefield_multivars ->
 359                  (match onefield_multivars with
 360                  | x::xs ->
 361                   (* handling the first var. Special case, with the
 362                      first var, we print the whole type *)
 363
 364                   (match x with
 365                   | (Simple (sopt, typ), iis), iivirg ->
 366                       (* first var cant have a preceding ',' *)
 367                       assert (List.length iivirg = 0);
 368                       let identinfo =
 369                         (match sopt, iis with
 370                         None,_ -> None
 371                         | (Some s, [iis]) -> Some (s, iis)
 372                         | x -> raise Impossible)
 373                       in
 374                       pp_type_with_ident_gen pr_elem pr_space
 375                         identinfo None typ;
 376
 377                   | (BitField (sopt, typ, expr), ii), iivirg ->
 378                       (* first var cant have a preceding ',' *)
 379                       assert (List.length iivirg = 0);
 380                       (match sopt, ii with
 381                       | (None , [idot]) ->
 382                           pp_type_gen pr_elem pr_space typ;
 383                           pr_elem idot;
 384                           pp_expression expr
 385                       | (Some s, [is;idot]) ->
 386                           pp_type_with_ident_gen
 387                             pr_elem pr_space (Some (s, is)) None typ;
 388                           pr_elem idot;
 389                           pp_expression expr
 390                       | x -> raise Impossible
 391                       )
 392
 393                   );
 394
 395                   (* for other vars *)
 396                   xs +> List.iter (function
 397                   | (Simple (sopt, typ), iis), iivirg ->
 398                       iivirg +> List.iter pr_elem;
 399                       let identinfo =
 400                         (match sopt, iis with
 401                         | None,_ -> None
 402                         | (Some s, [iis]) -> Some (s, iis)
 403                         | x -> raise Impossible)
 404                       in
 405                       pp_type_with_ident_rest_gen pr_elem pr_space
 406                         identinfo typ;
 407
 408                   | (BitField (sopt, typ, expr), ii), iivirg ->
 409                       iivirg +> List.iter pr_elem;
 410                       (match sopt, ii with
 411                       | (Some s, [is;idot]) ->
 412                           pp_type_with_ident_rest_gen
 413                             pr_elem pr_space (Some (s, is)) typ;
 414                           pr_elem idot;
 415                           pp_expression expr
 416                       | x -> raise Impossible
 417                       );
 418
 419                   );
 420
 421                   assert (List.length iipttvirg = 1);
 422                   iipttvirg +> List.iter pr_elem;
 423               | x -> raise Impossible
 424               )
 425             | EmptyField -> ()
 426             );
 427
 428             (match sopt,iis with
 429             | Some s , [i1;i2;i3;i4] -> pr_elem i4
 430             | None, [i1;i2;i3] ->       pr_elem i3;
 431             | x -> raise Impossible
 432             );
 433
 434
 435
 436         | (Enum  (sopt, enumt), iis) ->
 437             print_sto_qu (sto, qu);
 438
 439             (match sopt, iis with
 440             | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) ->
 441                 pr_elem i1; pr_elem i2; pr_elem i3;
 442             | (None, ([i1;i2;i3]|[i1;i2;i3;_])) ->
 443                 pr_elem i1; pr_elem i2
 444             | x -> raise Impossible
 445             );
 446
 447             enumt +> List.iter (fun (((s, eopt),ii_s_eq), iicomma) ->
 448               assert (List.length iicomma <= 1);
 449               iicomma +> List.iter (function x -> pr_elem x; pr_space());
 450               (match eopt, ii_s_eq with
 451               | None, [is] -> pr_elem is;
 452               | Some e, [is;ieq] -> pr_elem is; pr_elem ieq; pp_expression e
 453               | _ -> raise Impossible
 454               )
 455
 456             );
 457
 458             (match sopt, iis with
 459             | (Some s, [i1;i2;i3;i4]) ->    pr_elem i4
 460             | (Some s, [i1;i2;i3;i4;i5]) ->
 461                 pr_elem i5; pr_elem i4 (* trailing comma *)
 462             | (None, [i1;i2;i3]) ->         pr_elem i3
 463             | (None, [i1;i2;i3;i4]) ->
 464                 pr_elem i4; pr_elem i3 (* trailing comma *)
 465
 466
 467             | x -> raise Impossible
 468             );
 469
 470
 471         | (BaseType _, iis) ->
 472             print_sto_qu_ty (sto, qu, iis);
 473
 474         | (StructUnionName (s, structunion), iis) ->
 475             assert (List.length iis = 2);
 476             print_sto_qu_ty (sto, qu, iis);
 477
 478         | (EnumName  s, iis) ->
 479             assert (List.length iis = 2);
 480             print_sto_qu_ty (sto, qu, iis);
 481
 482         | (TypeName (s,_typ), iis) ->
 483             assert (List.length iis = 1);
 484             print_sto_qu_ty (sto, qu, iis);
 485
 486         | (TypeOfExpr (e), iis) ->
 487             print_sto_qu (sto, qu);
 488             (match iis with
 489             | [itypeof;iopar;icpar] ->
 490                 pr_elem itypeof; pr_elem iopar;
 491                 pp_expression_gen pr_elem pr_space e;
 492                 pr_elem icpar;
 493             | _ -> raise Impossible
 494             )
 495
 496         | (TypeOfType (t), iis) ->
 497             print_sto_qu (sto, qu);
 498             (match iis with
 499             | [itypeof;iopar;icpar] ->
 500                 pr_elem itypeof; pr_elem iopar;
 501                 pp_type_gen pr_elem pr_space t;
 502                 pr_elem icpar;
 503             | _ -> raise Impossible
 504             )
 505
 506
 507         | x -> raise Impossible
 508     in
 509     pp_base_type
 510
 511
 512 (* used because of DeclList, in    int i,*j[23];  we dont print anymore the
 513    int before *j *)
 514 and (pp_type_with_ident_rest_gen:
 515         pr_elem_func -> pr_space_func ->
 516           (string * info) option -> fullType -> unit) =
 517   fun pr_elem pr_space ->
 518     fun ident (((qu, iiqu), (ty, iity)) as fullt) ->
 519       let print_ident ident = do_option (fun (s, iis) -> pr_elem iis) ident
 520       in
 521
 522       match ty, iity with
 523       (* the work is to do in base_type !! *)
 524       | (BaseType _, iis)                       -> print_ident ident
 525       | (Enum  (sopt, enumt), iis)              -> print_ident ident
 526       | (StructUnion (_, sopt, fields),iis)     -> print_ident ident
 527       | (StructUnionName (s, structunion), iis) -> print_ident ident
 528       | (EnumName  s, iis)                      -> print_ident ident
 529       | (TypeName (s,_typ), iis)                -> print_ident ident
 530       | (TypeOfExpr (e), iis)                   -> print_ident ident
 531       | (TypeOfType (e), iis)                   -> print_ident ident
 532
 533
 534
 535       | (Pointer t, [i]) ->
 536           (* subtil:  void ( *done)(int i)   is a Pointer
 537              (FunctionType (return=void, params=int i) *)
 538           (*WRONG I THINK, use left & right function *)
 539           (* bug: pp_type_with_ident_rest None t;      print_ident ident *)
 540           pr_elem i;
 541           iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
 542           pp_type_with_ident_rest_gen pr_elem pr_space ident t;
 543
 544       (* ugly special case ... todo? maybe sufficient in practice *)
 545       | (ParenType (q1, (Pointer (q2, (FunctionType t, ii3))   ,
 546                         [ipointer])  ), [i1;i2]) ->
 547           pp_type_left_gen pr_elem pr_space (q2, (FunctionType t, ii3));
 548           pr_elem i1;
 549           pr_elem ipointer;
 550           print_ident ident;
 551           pr_elem i2;
 552           pp_type_right_gen pr_elem pr_space (q2, (FunctionType t, ii3));
 553
 554       (* another ugly special case *)
 555       | (ParenType
 556           (q1, (Array (eopt,
 557             (q2, (Pointer
 558               (q3, (FunctionType t, iifunc)),
 559                  [ipointer]))),
 560                [iarray1;iarray2])), [i1;i2]) ->
 561           pp_type_left_gen pr_elem pr_space (q3, (FunctionType t, iifunc));
 562           pr_elem i1;
 563           pr_elem ipointer;
 564           print_ident ident;
 565           pr_elem iarray1;
 566           do_option (pp_expression_gen pr_elem pr_space) eopt;
 567           pr_elem iarray2;
 568           pr_elem i2;
 569           pp_type_right_gen pr_elem pr_space (q3, (FunctionType t, iifunc))
 570
 571
 572
 573       | (ParenType t, [i1;i2]) ->
 574           pr2 "PB PARENTYPE ZARB, I forget about the ()";
 575           pp_type_with_ident_rest_gen pr_elem pr_space ident t;
 576
 577
 578       | (Array (eopt, t), [i1;i2]) ->
 579           pp_type_left_gen pr_elem pr_space fullt;
 580
 581           iiqu +> List.iter pr_elem;
 582           print_ident ident;
 583
 584           pp_type_right_gen pr_elem pr_space fullt;
 585
 586
 587       | (FunctionType (returnt, paramst), [i1;i2]) ->
 588           pp_type_left_gen pr_elem pr_space fullt;
 589
 590           iiqu +> List.iter pr_elem;
 591           print_ident ident;
 592
 593           pp_type_right_gen pr_elem pr_space fullt;
 594
 595       | x -> raise Impossible
 596
 597
 598 and (pp_type_left_gen: pr_elem_func -> pr_space_func -> fullType -> unit) =
 599   fun pr_elem pr_space ->
 600     let rec pp_type_left = fun ((qu, iiqu), (ty, iity)) ->
 601       match ty, iity with
 602       | (Pointer t, [i]) ->
 603           pr_elem i;
 604           iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
 605           pp_type_left t
 606
 607       | (Array (eopt, t), [i1;i2]) -> pp_type_left t
 608       | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt
 609
 610       | (ParenType t, _) ->  failwith "parenType"
 611
 612
 613       | (BaseType _, iis)    -> ()
 614       | (Enum  (sopt, enumt), iis) -> ()
 615       | (StructUnion (_, sopt, fields),iis)  -> ()
 616       | (StructUnionName (s, structunion), iis) -> ()
 617       | (EnumName  s, iis) -> ()
 618       | (TypeName (s,_typ), iis) -> ()
 619       | x -> raise Impossible
 620     in
 621     pp_type_left
 622
 623
 624 and pp_param_gen pr_elem pr_space = fun ((b, sopt, t), ii_b_s) ->
 625   match b, sopt, ii_b_s with
 626   | false, None, [] ->
 627       pp_type_gen pr_elem pr_space t
 628   | true, None, [i1] ->
 629       pr_elem i1;
 630       pp_type_gen pr_elem pr_space t
 631
 632   | false, Some s, [i1] ->
 633       pp_type_with_ident_gen pr_elem pr_space (Some (s, i1)) None t;
 634   | true, Some s, [i1;i2] ->
 635       pr_elem i1;
 636       pp_type_with_ident_gen pr_elem pr_space (Some (s, i2)) None t;
 637   | _ -> raise Impossible
 638
 639
 640 and (pp_type_right_gen: pr_elem_func -> pr_space_func -> fullType -> unit) =
 641   fun pr_elem pr_space ->
 642     let rec pp_type_right = fun ((qu, iiqu), (ty, iity)) ->
 643       match ty, iity with
 644       | (Pointer t, [i]) ->  pp_type_right t
 645
 646       | (Array (eopt, t), [i1;i2]) ->
 647           pr_elem i1;
 648           eopt +> do_option (fun e -> pp_expression_gen pr_elem pr_space e);
 649           pr_elem i2;
 650           pp_type_right t
 651
 652       | (ParenType t, _) ->  failwith "parenType"
 653       | (FunctionType (returnt, paramst), [i1;i2]) ->
 654           pr_elem i1;
 655           (match paramst with
 656           | (ts, (b, iib)) ->
 657               ts +> List.iter (fun (param,iicomma) ->
 658                 assert ((List.length iicomma) <= 1);
 659                 iicomma +> List.iter (function x -> pr_elem x; pr_space());
 660
 661                 pp_param_gen pr_elem pr_space param;
 662               );
 663               iib +> List.iter pr_elem;
 664           );
 665           pr_elem i2;
 666
 667
 668
 669
 670       | (BaseType _, iis)        -> ()
 671       | (Enum  (sopt, enumt), iis) -> ()
 672       | (StructUnion (_, sopt, fields),iis)-> ()
 673       | (StructUnionName (s, structunion), iis) -> ()
 674       | (EnumName  s, iis) -> ()
 675       | (TypeName (s,_typ), iis) -> ()
 676       | x -> raise Impossible
 677     in
 678     pp_type_right
 679
 680 and pp_type_gen pr_elem pr_space t =
 681   pp_type_with_ident_gen pr_elem pr_space None None t
 682
 683 (* ---------------------- *)
 684 and pp_decl_gen pr_elem pr_space = function
 685   | DeclList ((((var, returnType, storage, _local),[])::xs),
 686              iivirg::ifakestart::iisto) ->
 687
 688       pr_elem ifakestart;
 689
 690       (* old: iisto +> List.iter pr_elem; *)
 691
 692
 693       (* handling the first var. Special case, we print the whole type *)
 694       (match var with
 695       | Some ((s, ini),  iis::iini) ->
 696           pp_type_with_ident_gen pr_elem pr_space
 697             (Some (s, iis)) (Some (storage, iisto))
 698             returnType;
 699           ini +> do_option (fun init ->
 700             List.iter pr_elem iini; pp_init_gen pr_elem pr_space init);
 701       | None -> pp_type_gen pr_elem pr_space returnType
 702       | _ -> raise Impossible
 703       );
 704
 705       (* for other vars, we just call pp_type_with_ident_rest. *)
 706       xs +> List.iter (function
 707       | ((Some ((s, ini), iis::iini), returnType, storage2, _local), iivirg) ->
 708           assert (storage2 = storage);
 709           iivirg +> List.iter pr_elem;
 710           pp_type_with_ident_rest_gen pr_elem pr_space
 711             (Some (s, iis)) returnType;
 712           ini +> do_option (fun (init) ->
 713             List.iter pr_elem iini; pp_init_gen pr_elem pr_space init);
 714
 715
 716       | x -> raise Impossible
 717       );
 718
 719       pr_elem iivirg;
 720
 721   | MacroDecl ((s, es), iis::lp::rp::iiend::ifakestart::iisto) ->
 722       pr_elem ifakestart;
 723       iisto +> List.iter pr_elem; (* static and const *)
 724       pr_elem iis;
 725       pr_elem lp;
 726       es +> List.iter (fun (e, opt) ->
 727         assert (List.length opt <= 1);
 728         opt +> List.iter pr_elem;
 729         pp_argument_gen pr_elem pr_space e;
 730       );
 731
 732       pr_elem rp;
 733       pr_elem iiend;
 734
 735   | x -> raise Impossible
 736
 737
 738 (* ---------------------- *)
 739 and pp_init_gen = fun pr_elem pr_space ->
 740   let pp_expression e = pp_expression_gen pr_elem pr_space e in
 741   let rec pp_init = fun (init, iinit) ->
 742     match init, iinit with
 743     | InitExpr e, [] -> pp_expression e;
 744     | InitList xs, i1::i2::iicommaopt ->
 745         pr_elem i1;
 746         xs +> List.iter (fun (x, ii) ->
 747           assert (List.length ii <= 1);
 748           ii +> List.iter pr_elem;
 749           pp_init x
 750         );
 751         iicommaopt +> List.iter pr_elem;
 752         pr_elem i2;
 753
 754     | InitDesignators (xs, initialiser), [i1] -> (* : *)
 755         xs +> List.iter (pp_designator pr_elem pr_space);
 756         pr_elem i1;
 757         pp_init initialiser
 758
 759     (* no use of '=' in the "Old" style *)
 760     | InitFieldOld (string, initialiser), [i1;i2] -> (* label:   in oldgcc *)
 761         pr_elem i1; pr_elem i2; pp_init initialiser
 762     | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *)
 763         pr_elem i1; pp_expression expression; pr_elem i2;
 764         pp_init initialiser
 765     | x -> raise Impossible
 766   in
 767   pp_init
 768
 769
 770
 771 and pp_designator pr_elem pr_space design =
 772   let pp_expression e = pp_expression_gen pr_elem pr_space e in
 773   match design with
 774   | DesignatorField (s), [i1; i2] ->
 775       pr_elem i1; pr_elem i2;
 776   | DesignatorIndex (expression), [i1;i2] ->
 777       pr_elem i1; pp_expression expression; pr_elem i2;
 778
 779   | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] ->
 780       pr_elem iocro; pp_expression e1; pr_elem iellipsis;
 781       pp_expression e2; pr_elem iccro;
 782   | x -> raise Impossible
 783
 784
 785
 786
 787 (* ---------------------- *)
 788 and pp_def_gen pr_elem pr_space def =
 789   match def with
 790   | ((s, (returnt, (paramst, (b, iib))), sto, statxs),
 791                      is::iifunc1::iifunc2::i1::i2::ifakestart::isto) ->
 792
 793          pr_elem ifakestart;
 794
 795          pp_type_with_ident_gen pr_elem pr_space None (Some (sto, isto))
 796                          returnt;
 797          pr_elem is;
 798          pr_elem iifunc1;
 799
 800         (* not anymore, cf tests/optional_name_parameter and
 801            macro_parameter_shortcut.c
 802          (match paramst with
 803          | [(((bool, None, t), ii_b_s), iicomma)] ->
 804              assert
 805                (match t with
 806                | qu, (BaseType Void, ii) -> true
 807                | _ -> true
 808                );
 809              assert (null iicomma);
 810              assert (null ii_b_s);
 811              pp_type_with_ident_gen pr_elem pr_space  None None t
 812
 813          | paramst ->
 814            paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) ->
 815             iicomma +> List.iter pr_elem;
 816
 817             (match b, s, ii_b_s with
 818             | false, Some s, [i1] ->
 819                 pp_type_with_ident_gen
 820                   pr_elem pr_space (Some (s, i1)) None t;
 821             | true, Some s, [i1;i2] ->
 822                 pr_elem i1;
 823                 pp_type_with_ident_gen
 824                   pr_elem pr_space (Some (s, i2)) None t;
 825
 826             (* in definition we have name for params, except when f(void) *)
 827              | _, None, _ -> raise Impossible
 828             | false, None, [] ->
 829
 830             | _ -> raise Impossible
 831             )
 832          );
 833            );
 834
 835          (* normally ii represent the ",..." but it is also abused
 836             with the f(void) case *)
 837          (* assert (List.length iib <= 2);*)
 838          iib +> List.iter pr_elem;
 839
 840         *)
 841          paramst +> List.iter (fun (param,iicomma) ->
 842            assert ((List.length iicomma) <= 1);
 843            iicomma +> List.iter (function x -> pr_elem x; pr_space());
 844
 845            pp_param_gen pr_elem pr_space param;
 846          );
 847          iib +> List.iter pr_elem;
 848
 849
 850          pr_elem iifunc2;
 851          pr_elem i1;
 852          statxs +> List.iter (pp_statement_gen pr_elem pr_space);
 853          pr_elem i2;
 854      | _ -> raise Impossible
 855
 856
 857
 858
 859 let pp_program_gen pr_elem pr_space progelem =
 860   match progelem with
 861   | Declaration decl -> pp_decl_gen pr_elem pr_space decl
 862   | Definition def -> pp_def_gen pr_elem pr_space def
 863
 864   | Include ((s, [i1;i2]),h_rel_pos) ->
 865       pr_elem i1; pr_elem i2
 866   | Define ((s,[idefine;iident;ieol]), (defkind, defval)) ->
 867       pr_elem idefine;
 868       pr_elem iident;
 869
 870       let define_val = function
 871         | DefineExpr e -> pp_expression_gen pr_elem pr_space e
 872         | DefineStmt st -> pp_statement_gen pr_elem pr_space st
 873         | DefineDoWhileZero (st, ii) ->
 874             (match ii with
 875             | [ido;iwhile;iopar;iint;icpar] ->
 876                 pr_elem ido;
 877                 pp_statement_gen pr_elem pr_space st;
 878                 pr_elem iwhile; pr_elem iopar; pr_elem iint; pr_elem icpar
 879             | _ -> raise Impossible
 880             )
 881         | DefineFunction def -> pp_def_gen pr_elem pr_space def
 882
 883         | DefineType ty -> pp_type_gen pr_elem pr_space ty
 884         | DefineText (s, ii) -> List.iter pr_elem ii
 885         | DefineEmpty -> ()
 886       in
 887       (match defkind with
 888       | DefineVar -> ()
 889       | DefineFunc (params, ii) ->
 890           let (i1,i2) = tuple_of_list2 ii in
 891           pr_elem i1;
 892           params +> List.iter (fun ((s,iis), iicomma) ->
 893             assert (List.length iicomma <= 1);
 894             iicomma +> List.iter pr_elem;
 895             iis +> List.iter pr_elem;
 896           );
 897           pr_elem i2;
 898       );
 899       define_val defval;
 900       pr_elem ieol
 901
 902
 903   | MacroTop (s, es,   [i1;i2;i3;i4]) ->
 904       pr_elem i1;
 905       pr_elem i2;
 906       es +> List.iter (fun (e, opt) ->
 907         assert (List.length opt <= 1);
 908         opt +> List.iter pr_elem;
 909         pp_argument_gen pr_elem pr_space e;
 910       );
 911       pr_elem i3;
 912       pr_elem i4;
 913
 914
 915   | EmptyDef ii -> ii +> List.iter pr_elem
 916   | NotParsedCorrectly ii ->
 917       assert (List.length ii >= 1);
 918       ii +> List.iter pr_elem
 919   | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info)
 920
 921   | _ -> raise Impossible
 922
 923
 924
 925
 926 (*****************************************************************************)
 927
 928 (* Here we do not use (mcode, env). It is a simple C pretty printer. *)
 929 let pr_elem info =
 930   let s = Ast_c.str_of_info info in
 931   pp s
 932
 933 let pr_space _ = Format.print_space()
 934
 935 let pp_expression_simple = pp_expression_gen pr_elem pr_space
 936 let pp_statement_simple  = pp_statement_gen pr_elem pr_space
 937 let pp_type_simple  = pp_type_gen pr_elem pr_space