parsing_c/unparse_cocci.ml

   1 (*
   2  * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
   3  * Copyright (C) 2006, 2007 Julia Lawall
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License (GPL)
   7  * version 2 as published by the Free Software Foundation.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * file license.txt for more details.
  13  *
  14  * This file was part of Coccinelle.
  15  *)
  16 open Common
  17
  18 (*****************************************************************************)
  19 (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml
  20  * todo?: try to factorize ?
  21  *)
  22 (*****************************************************************************)
  23
  24 module Ast = Ast_cocci
  25
  26 let term s = Ast.unwrap_mcode s
  27
  28 (* or perhaps can have in plus, for instance a Disj, but those Disj must be
  29  *  handled by interactive tool (by proposing alternatives)
  30  *)
  31 exception CantBeInPlus
  32
  33 (*****************************************************************************)
  34
  35 type pos = Before | After | InPlace
  36
  37 let unknown = -1
  38
  39 let rec do_all
  40     (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
  41      indent, unindent)
  42     generating xxs before =
  43
  44 (* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
  45 let print_string s line lcol =
  46   let rcol = if lcol = unknown then unknown else lcol + (String.length s) in
  47   pr s line lcol rcol in
  48 let print_text s = pr s unknown unknown unknown in
  49 let close_box _ = () in
  50 let force_newline _ = print_text "\n" in
  51
  52 let start_block () = force_newline(); indent() in
  53 let end_block () = unindent(); force_newline () in
  54 let print_string_box s = print_string s in
  55
  56 let print_option = Common.do_option in
  57 let print_option_prespace fn = function
  58     None -> ()
  59   | Some x -> pr_space(); fn x in
  60 let print_option_space fn = function
  61     None -> ()
  62   | Some x -> fn x; pr_space() in
  63 let print_between = Common.print_between in
  64
  65 let outdent _ = () (* should go to leftmost col, does nothing now *) in
  66
  67 let pretty_print_c =
  68   Pretty_print_c.mk_pretty_printers pr_celem pr_cspace
  69     force_newline indent outdent unindent in
  70
  71 (* --------------------------------------------------------------------- *)
  72 (* Only for make_hrule, print plus code, unbound metavariables *)
  73
  74 (* avoid polyvariance problems *)
  75 let anything : (Ast.anything -> unit) ref = ref (function _ -> ()) in
  76
  77 let rec print_anything = function
  78     [] -> ()
  79   | stream ->
  80       start_block();
  81       print_between force_newline print_anything_list stream;
  82       end_block()
  83
  84 and print_anything_list = function
  85     [] -> ()
  86   | [x] -> !anything x
  87   | bef::((aft::_) as rest) ->
  88       !anything bef;
  89       let space =
  90         (match bef with
  91           Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
  92         | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_)
  93         | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or
  94         (match aft with
  95           Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
  96         | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
  97         | _ -> false) in
  98       if space then pr_space ();
  99       print_anything_list rest in
 100
 101 let print_around printer term = function
 102     Ast.NOTHING -> printer term
 103   | Ast.BEFORE(bef,_) -> print_anything bef; printer term
 104   | Ast.AFTER(aft,_) -> printer term; print_anything aft
 105   | Ast.BEFOREAFTER(bef,aft,_) ->
 106       print_anything bef; printer term; print_anything aft in
 107
 108 let print_string_befaft fn fn1 x info =
 109   List.iter
 110     (function (s,ln,col) -> fn1(); print_string s ln col; force_newline())
 111     info.Ast.strbef;
 112   fn x;
 113   List.iter
 114     (function (s,ln,col) -> force_newline(); fn1(); print_string s ln col)
 115     info.Ast.straft in
 116 let print_meta (r,x) = print_text x in
 117
 118 let print_pos = function
 119     Ast.MetaPos(name,_,_,_,_) ->
 120       let name = Ast.unwrap_mcode name in
 121       print_text "@"; print_meta name
 122   | _ -> () in
 123
 124 (* --------------------------------------------------------------------- *)
 125
 126 let mcode fn (s,info,mc,pos) =
 127   let line = info.Ast.line in
 128   let lcol = info.Ast.column in
 129   match (generating,mc) with
 130     (false,_) ->
 131     (* printing for transformation *)
 132     (* Here we don't care about the annotation on s. *)
 133       let print_comments lb comments =
 134         List.fold_left
 135           (function line_before ->
 136             function (str,line,col) ->
 137               match line_before with
 138                 None -> print_string str line col; Some line
 139               | Some lb when line =|= lb ->
 140                   print_string str line col; Some line
 141               | _ -> force_newline(); print_string str line col; Some line)
 142           lb comments in
 143       let line_before = print_comments None info.Ast.strbef in
 144       (match line_before with
 145         None -> ()
 146       | Some lb when lb =|= info.Ast.line -> ()
 147       | _ -> force_newline());
 148       fn s line lcol;
 149       let _ = print_comments (Some info.Ast.line) info.Ast.straft in
 150       (* newline after a pragma
 151          should really store parsed versions of the strings, but make a cheap
 152          effort here
 153          print_comments takes care of interior newlines *)
 154       (match List.rev info.Ast.straft with
 155         (str,_,_)::_ when String.length str > 0 && String.get str 0 = '#' ->
 156           force_newline()
 157       | _ -> ());
 158       ()
 159       (* printing for rule generation *)
 160   | (true, Ast.MINUS(_,_,_,plus_stream)) ->
 161       force_newline();
 162       print_text "- ";
 163       fn s line lcol; print_pos pos;
 164       print_anything plus_stream
 165   | (true, Ast.CONTEXT(_,plus_streams)) ->
 166       let fn s = force_newline(); fn s line lcol; print_pos pos in
 167       print_around fn s plus_streams
 168   | (true,Ast.PLUS Ast.ONE) ->
 169       let fn s =
 170         force_newline(); print_text "+ "; fn s line lcol; print_pos pos in
 171       print_string_befaft fn (function _ -> print_text "+ ") s info
 172   | (true,Ast.PLUS Ast.MANY) ->
 173       let fn s =
 174         force_newline(); print_text "++ "; fn s line lcol; print_pos pos in
 175       print_string_befaft fn (function _ -> print_text "++ ") s info
 176 in
 177
 178
 179 (* --------------------------------------------------------------------- *)
 180
 181 let handle_metavar name fn =
 182   let ((_,b) as s,info,mc,pos) = name in
 183   let line = info.Ast.line in
 184   let lcol = info.Ast.column in
 185   match Common.optionise (fun () -> List.assoc s env) with
 186     None ->
 187       let name_string (_,s) = s in
 188       if generating
 189       then
 190         mcode (function _ -> print_string (name_string s)) name
 191       else
 192         failwith
 193           (Printf.sprintf "SP line %d: Not found a value in env for: %s"
 194              line (name_string s))
 195   | Some e  ->
 196       pr_barrier line lcol;
 197       (if generating
 198       then
 199         (* call mcode to preserve the -+ annotation *)
 200         mcode (fun _ _ _ -> fn e) name
 201       else fn e);
 202       let rcol = if lcol = unknown then unknown else lcol + (String.length b) in
 203       pr_barrier line rcol
 204 in
 205 (* --------------------------------------------------------------------- *)
 206 let dots between fn d =
 207   match Ast.unwrap d with
 208     Ast.DOTS(l) -> print_between between fn l
 209   | Ast.CIRCLES(l) -> print_between between fn l
 210   | Ast.STARS(l) -> print_between between fn l
 211 in
 212
 213 let nest_dots multi fn f d =
 214   let mo s = if multi then "<+"^s else "<"^s in
 215   let mc s = if multi then s^"+>" else s^">" in
 216   match Ast.unwrap d with
 217     Ast.DOTS(l) ->
 218       print_text (mo "..."); f(); start_block();
 219       print_between force_newline fn l;
 220       end_block(); print_text (mc "...")
 221   | Ast.CIRCLES(l) ->
 222       print_text (mo "ooo"); f(); start_block();
 223       print_between force_newline fn l;
 224       end_block(); print_text (mc "ooo")
 225   | Ast.STARS(l) ->
 226       print_text (mo "***"); f(); start_block();
 227       print_between force_newline fn l;
 228       end_block(); print_text (mc "***")
 229 in
 230
 231 (* --------------------------------------------------------------------- *)
 232 (* Identifier *)
 233
 234 let rec ident i =
 235   match Ast.unwrap i with
 236       Ast.Id(name) -> mcode print_string name
 237     | Ast.MetaId(name,_,_,_) ->
 238         handle_metavar name (function
 239                                | (Ast_c.MetaIdVal id) -> print_text id
 240                                | _ -> raise Impossible
 241                             )
 242     | Ast.MetaFunc(name,_,_,_) ->
 243         handle_metavar name (function
 244                                | (Ast_c.MetaFuncVal id) -> print_text id
 245                                | _ -> raise Impossible
 246                             )
 247     | Ast.MetaLocalFunc(name,_,_,_) ->
 248         handle_metavar name (function
 249                                | (Ast_c.MetaLocalFuncVal id) -> print_text id
 250                                | _ -> raise Impossible
 251                             )
 252
 253     | Ast.OptIdent(_) | Ast.UniqueIdent(_) ->
 254         raise CantBeInPlus
 255
 256 in
 257
 258 (* --------------------------------------------------------------------- *)
 259 (* Expression *)
 260
 261 let print_disj_list fn l =
 262   print_text "\n(\n";
 263   print_between (function _ -> print_text "\n|\n") fn l;
 264   print_text "\n)\n" in
 265
 266 let rec expression e =
 267   match Ast.unwrap e with
 268     Ast.Ident(id) -> ident id
 269   | Ast.Constant(const) -> mcode constant const
 270   | Ast.FunCall(fn,lp,args,rp) ->
 271       expression fn; mcode print_string_box lp;
 272       let comma e =
 273         expression e;
 274         match Ast.unwrap e with
 275           Ast.EComma(cm) -> pr_space()
 276         | _ -> () in
 277       dots (function _ -> ()) comma args;
 278       close_box(); mcode print_string rp
 279   | Ast.Assignment(left,op,right,_) ->
 280       expression left; pr_space(); mcode assignOp op;
 281       pr_space(); expression right
 282   | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
 283       expression exp1; pr_space(); mcode print_string why;
 284       print_option (function e -> pr_space(); expression e) exp2;
 285       pr_space(); mcode print_string colon; expression exp3
 286   | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
 287   | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
 288   | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
 289   | Ast.Binary(left,op,right) ->
 290       expression left; pr_space(); mcode binaryOp op; pr_space();
 291       expression right
 292   | Ast.Nested(left,op,right) -> failwith "nested only in minus code"
 293   | Ast.Paren(lp,exp,rp) ->
 294       mcode print_string_box lp; expression exp; close_box();
 295       mcode print_string rp
 296   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 297       expression exp1; mcode print_string_box lb; expression exp2; close_box();
 298       mcode print_string rb
 299   | Ast.RecordAccess(exp,pt,field) ->
 300       expression exp; mcode print_string pt; ident field
 301   | Ast.RecordPtAccess(exp,ar,field) ->
 302       expression exp; mcode print_string ar; ident field
 303   | Ast.Cast(lp,ty,rp,exp) ->
 304       mcode print_string_box lp; fullType ty; close_box();
 305       mcode print_string rp; expression exp
 306   | Ast.SizeOfExpr(sizeof,exp) ->
 307       mcode print_string sizeof; expression exp
 308   | Ast.SizeOfType(sizeof,lp,ty,rp) ->
 309       mcode print_string sizeof;
 310       mcode print_string_box lp; fullType ty; close_box();
 311       mcode print_string rp
 312   | Ast.TypeExp(ty) -> fullType ty
 313
 314   | Ast.MetaErr(name,_,_,_) ->
 315       failwith "metaErr not handled"
 316
 317   | Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) ->
 318       handle_metavar name  (function
 319         | Ast_c.MetaExprVal exp ->
 320             pretty_print_c.Pretty_print_c.expression exp
 321         | _ -> raise Impossible
 322       )
 323
 324   | Ast.MetaExprList (name,_,_,_) ->
 325       handle_metavar name  (function
 326         | Ast_c.MetaExprListVal args ->
 327             pretty_print_c.Pretty_print_c.arg_list args
 328         | _ -> raise Impossible
 329       )
 330
 331   | Ast.EComma(cm) -> mcode print_string cm
 332
 333   | Ast.DisjExpr(exp_list) ->
 334       if generating
 335       then print_disj_list expression exp_list
 336       else raise CantBeInPlus
 337   | Ast.NestExpr(expr_dots,Some whencode,multi) when generating ->
 338       nest_dots multi expression
 339         (function _ -> print_text "   when != "; expression whencode)
 340         expr_dots
 341   | Ast.NestExpr(expr_dots,None,multi) when generating ->
 342       nest_dots multi expression (function _ -> ()) expr_dots
 343   | Ast.NestExpr(_) -> raise CantBeInPlus
 344   | Ast.Edots(dots,Some whencode)
 345   | Ast.Ecircles(dots,Some whencode)
 346   | Ast.Estars(dots,Some whencode) ->
 347       if generating
 348       then
 349         (mcode print_string dots;
 350          print_text "   when != ";
 351          expression whencode)
 352       else raise CantBeInPlus
 353   | Ast.Edots(dots,None)
 354   | Ast.Ecircles(dots,None)
 355   | Ast.Estars(dots,None) ->
 356       if generating
 357       then mcode print_string dots
 358       else raise CantBeInPlus
 359
 360   | Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
 361       raise CantBeInPlus
 362
 363 and  unaryOp = function
 364     Ast.GetRef -> print_string "&"
 365   | Ast.DeRef -> print_string "*"
 366   | Ast.UnPlus -> print_string "+"
 367   | Ast.UnMinus -> print_string "-"
 368   | Ast.Tilde -> print_string "~"
 369   | Ast.Not -> print_string "!"
 370
 371 and  assignOp = function
 372     Ast.SimpleAssign -> print_string "="
 373   | Ast.OpAssign(aop) ->
 374       (function line -> function lcol ->
 375         arithOp aop line lcol; print_string "=" line lcol)
 376
 377 and  fixOp = function
 378     Ast.Dec -> print_string "--"
 379   | Ast.Inc -> print_string "++"
 380
 381 and  binaryOp = function
 382     Ast.Arith(aop) -> arithOp aop
 383   | Ast.Logical(lop) -> logicalOp lop
 384
 385 and  arithOp = function
 386     Ast.Plus -> print_string "+"
 387   | Ast.Minus -> print_string "-"
 388   | Ast.Mul -> print_string "*"
 389   | Ast.Div -> print_string "/"
 390   | Ast.Mod -> print_string "%"
 391   | Ast.DecLeft -> print_string "<<"
 392   | Ast.DecRight -> print_string ">>"
 393   | Ast.And -> print_string "&"
 394   | Ast.Or -> print_string "|"
 395   | Ast.Xor -> print_string "^"
 396
 397 and  logicalOp = function
 398     Ast.Inf -> print_string "<"
 399   | Ast.Sup -> print_string ">"
 400   | Ast.InfEq -> print_string "<="
 401   | Ast.SupEq -> print_string ">="
 402   | Ast.Eq -> print_string "=="
 403   | Ast.NotEq -> print_string "!="
 404   | Ast.AndLog -> print_string "&&"
 405   | Ast.OrLog -> print_string "||"
 406
 407 and constant = function
 408     Ast.String(s) -> print_string ("\""^s^"\"")
 409   | Ast.Char(s) -> print_string ("\'"^s^"\'")
 410   | Ast.Int(s) -> print_string s
 411   | Ast.Float(s) -> print_string s
 412
 413 (* --------------------------------------------------------------------- *)
 414 (* Types *)
 415
 416
 417 and fullType ft =
 418   match Ast.unwrap ft with
 419     Ast.Type(cv,ty) -> print_option_space (mcode const_vol) cv; typeC ty
 420   | Ast.DisjType _ -> failwith "can't be in plus"
 421   | Ast.OptType(_) | Ast.UniqueType(_) ->
 422       raise CantBeInPlus
 423
 424 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
 425   fullType ty; mcode print_string lp1; mcode print_string star; fn();
 426   mcode print_string rp1; mcode print_string lp1;
 427   parameter_list params; mcode print_string rp2
 428
 429 and print_function_type (ty,lp1,params,rp1) fn =
 430   print_option fullType ty; fn(); mcode print_string lp1;
 431   parameter_list params; mcode print_string rp1
 432
 433 and typeC ty =
 434   match Ast.unwrap ty with
 435     Ast.BaseType(ty,strings) ->
 436       print_between pr_space (mcode print_string) strings
 437   | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty
 438   | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star
 439   | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 440       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 441         (function _ -> ())
 442   | Ast.FunctionType (am,ty,lp1,params,rp1) ->
 443       print_function_type (ty,lp1,params,rp1) (function _ -> ())
 444   | Ast.Array(ty,lb,size,rb) ->
 445       fullType ty; mcode print_string lb; print_option expression size;
 446       mcode print_string rb
 447   | Ast.EnumName(kind,name) -> mcode print_string kind; pr_space();
 448       ident name
 449   | Ast.StructUnionName(kind,name) ->
 450       mcode structUnion kind; print_option_prespace ident name
 451   | Ast.StructUnionDef(ty,lb,decls,rb) ->
 452       fullType ty; ft_space ty;
 453       mcode print_string lb;
 454       dots force_newline declaration decls;
 455       mcode print_string rb
 456   | Ast.TypeName(name)-> mcode print_string name
 457   | Ast.MetaType(name,_,_) ->
 458       handle_metavar name  (function
 459           Ast_c.MetaTypeVal exp ->
 460             pretty_print_c.Pretty_print_c.ty exp
 461         | _ -> raise Impossible)
 462
 463 and baseType = function
 464     Ast.VoidType -> print_string "void"
 465   | Ast.CharType -> print_string "char"
 466   | Ast.ShortType -> print_string "short"
 467   | Ast.IntType -> print_string "int"
 468   | Ast.DoubleType -> print_string "double"
 469   | Ast.FloatType -> print_string "float"
 470   | Ast.LongType -> print_string "long"
 471   | Ast.LongLongType -> print_string "long long"
 472
 473 and structUnion = function
 474     Ast.Struct -> print_string "struct"
 475   | Ast.Union -> print_string "union"
 476
 477 and sign = function
 478     Ast.Signed -> print_string "signed"
 479   | Ast.Unsigned -> print_string "unsigned"
 480
 481
 482 and const_vol = function
 483     Ast.Const -> print_string "const"
 484   | Ast.Volatile -> print_string "volatile"
 485
 486 (* --------------------------------------------------------------------- *)
 487 (* Function declaration *)
 488
 489 and storage = function
 490     Ast.Static -> print_string "static"
 491   | Ast.Auto -> print_string "auto"
 492   | Ast.Register -> print_string "register"
 493   | Ast.Extern -> print_string "extern"
 494
 495 (* --------------------------------------------------------------------- *)
 496 (* Variable declaration *)
 497
 498 and print_named_type ty id =
 499   match Ast.unwrap ty with
 500     Ast.Type(None,ty1) ->
 501       (match Ast.unwrap ty1 with
 502         Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 503           print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 504             (function _ -> pr_space(); ident id)
 505       | Ast.FunctionType(am,ty,lp1,params,rp1) ->
 506           print_function_type (ty,lp1,params,rp1)
 507             (function _ -> pr_space(); ident id)
 508       | Ast.Array(_,_,_,_) ->
 509           let rec loop ty k =
 510             match Ast.unwrap ty with
 511               Ast.Array(ty,lb,size,rb) ->
 512                 (match Ast.unwrap ty with
 513                   Ast.Type(None,ty) ->
 514                     loop ty
 515                       (function _ ->
 516                         k ();
 517                         mcode print_string lb;
 518                         print_option expression size;
 519                         mcode print_string rb)
 520                 | _ -> failwith "complex array types not supported")
 521             | _ -> typeC ty; ty_space ty; ident id; k () in
 522           loop ty1 (function _ -> ())
 523     (*| should have a case here for pointer to array or function type
 524         that would put ( * ) around the variable.  This makes one wonder
 525         why we really need a special case for function pointer *)
 526       | _ -> fullType ty; ft_space ty; ident id)
 527   | _ -> fullType ty; ft_space ty; ident id
 528
 529 and ty_space ty =
 530   match Ast.unwrap ty with
 531     Ast.Pointer(_,_) -> ()
 532   | _ -> pr_space()
 533
 534 and ft_space ty =
 535   match Ast.unwrap ty with
 536     Ast.Type(cv,ty) ->
 537       (match Ast.unwrap ty with
 538         Ast.Pointer(_,_) -> ()
 539       | _ -> pr_space())
 540   | _ -> pr_space()
 541
 542 and declaration d =
 543   match Ast.unwrap d with
 544     Ast.Init(stg,ty,id,eq,ini,sem) ->
 545       print_option (mcode storage) stg;
 546       print_option (function _ -> pr_space()) stg;
 547       print_named_type ty id;
 548       pr_space(); mcode print_string eq;
 549       pr_space(); initialiser true ini; mcode print_string sem
 550   | Ast.UnInit(stg,ty,id,sem) ->
 551       print_option (mcode storage) stg;
 552       print_option (function _ -> pr_space()) stg;
 553       print_named_type ty id;
 554       mcode print_string sem
 555   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 556       ident name; mcode print_string_box lp;
 557       dots (function _ -> ()) expression args;
 558       close_box(); mcode print_string rp; mcode print_string sem
 559   | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
 560   | Ast.Typedef(stg,ty,id,sem) ->
 561       mcode print_string stg;
 562       fullType ty; typeC id;
 563       mcode print_string sem
 564   | Ast.DisjDecl(_) | Ast.MetaDecl(_,_,_) -> raise CantBeInPlus
 565   | Ast.Ddots(_,_) -> raise CantBeInPlus
 566   | Ast.OptDecl(decl)  | Ast.UniqueDecl(decl) ->
 567       raise CantBeInPlus
 568
 569 (* --------------------------------------------------------------------- *)
 570 (* Initialiser *)
 571
 572 and initialiser nlcomma i =
 573   match Ast.unwrap i with
 574     Ast.MetaInit(name,_,_) ->
 575       handle_metavar name  (function
 576           Ast_c.MetaInitVal ini ->
 577             pretty_print_c.Pretty_print_c.init ini
 578         | _ -> raise Impossible)
 579   | Ast.InitExpr(exp) -> expression exp
 580   | Ast.InitList(lb,initlist,rb,[]) ->
 581       mcode print_string lb; start_block();
 582       (* awkward, because the comma is separate from the initialiser *)
 583       let rec loop = function
 584           [] -> ()
 585         | [x] -> initialiser false x
 586         | x::xs -> initialiser nlcomma x; loop xs in
 587       loop initlist;
 588       end_block(); mcode print_string rb
 589   | Ast.InitList(lb,initlist,rb,_) -> failwith "unexpected whencode in plus"
 590   | Ast.InitGccExt(designators,eq,ini) ->
 591       List.iter designator designators; pr_space();
 592       mcode print_string eq; pr_space(); initialiser nlcomma ini
 593   | Ast.InitGccName(name,eq,ini) ->
 594       ident name; mcode print_string eq; initialiser nlcomma ini
 595   | Ast.IComma(comma) ->
 596       mcode print_string comma;
 597       if nlcomma then force_newline()
 598   | Ast.OptIni(ini) | Ast.UniqueIni(ini) ->
 599       raise CantBeInPlus
 600
 601 and designator = function
 602     Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
 603   | Ast.DesignatorIndex(lb,exp,rb) ->
 604       mcode print_string lb; expression exp; mcode print_string rb
 605   | Ast.DesignatorRange(lb,min,dots,max,rb) ->
 606       mcode print_string lb; expression min; mcode print_string dots;
 607       expression max; mcode print_string rb
 608
 609 (* --------------------------------------------------------------------- *)
 610 (* Parameter *)
 611
 612 and parameterTypeDef p =
 613   match Ast.unwrap p with
 614     Ast.VoidParam(ty) -> fullType ty
 615   | Ast.Param(ty,Some id) -> print_named_type ty id
 616   | Ast.Param(ty,None) -> fullType ty
 617
 618   | Ast.MetaParam(name,_,_) ->
 619       failwith "not handling MetaParam"
 620   | Ast.MetaParamList(name,_,_,_) ->
 621       failwith "not handling MetaParamList"
 622
 623   | Ast.PComma(cm) -> mcode print_string cm
 624   | Ast.Pdots(dots) | Ast.Pcircles(dots) when generating ->
 625       mcode print_string dots
 626   | Ast.Pdots(dots) | Ast.Pcircles(dots) -> raise CantBeInPlus
 627   | Ast.OptParam(param) | Ast.UniqueParam(param) -> raise CantBeInPlus
 628
 629 and parameter_list l =
 630   let comma p =
 631     parameterTypeDef p;
 632     match Ast.unwrap p with
 633       Ast.PComma(cm) -> pr_space()
 634     | _ -> () in
 635   dots (function _ -> ()) comma l
 636 in
 637
 638
 639 (* --------------------------------------------------------------------- *)
 640 (* CPP code *)
 641
 642 let rec inc_file = function
 643     Ast.Local(elems) ->
 644       print_string ("\""^(String.concat "/" (List.map inc_elem elems))^"\"")
 645   | Ast.NonLocal(elems) ->
 646       print_string ("<"^(String.concat "/" (List.map inc_elem elems))^">")
 647
 648 and inc_elem = function
 649     Ast.IncPath s -> s
 650   | Ast.IncDots -> "..."
 651
 652 (* --------------------------------------------------------------------- *)
 653 (* Top-level code *)
 654
 655 and rule_elem arity re =
 656   match Ast.unwrap re with
 657     Ast.FunHeader(_,_,fninfo,name,lp,params,rp) ->
 658       pr_arity arity; List.iter print_fninfo fninfo;
 659       ident name; mcode print_string_box lp;
 660       parameter_list params; close_box(); mcode print_string rp;
 661       pr_space()
 662   | Ast.Decl(_,_,decl) -> pr_arity arity; declaration decl
 663
 664   | Ast.SeqStart(brace) ->
 665       pr_arity arity; mcode print_string brace; start_block()
 666   | Ast.SeqEnd(brace) ->
 667       end_block(); pr_arity arity; mcode print_string brace
 668
 669   | Ast.ExprStatement(exp,sem) ->
 670       pr_arity arity; expression exp; mcode print_string sem
 671
 672   | Ast.IfHeader(iff,lp,exp,rp) ->
 673       pr_arity arity;
 674       mcode print_string iff; pr_space(); mcode print_string_box lp;
 675       expression exp; close_box(); mcode print_string rp
 676   | Ast.Else(els) ->
 677       pr_arity arity; mcode print_string els
 678
 679   | Ast.WhileHeader(whl,lp,exp,rp) ->
 680       pr_arity arity;
 681       mcode print_string whl; pr_space(); mcode print_string_box lp;
 682       expression exp; close_box(); mcode print_string rp
 683   | Ast.DoHeader(d) ->
 684       pr_arity arity; mcode print_string d
 685   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 686       pr_arity arity;
 687       mcode print_string whl; pr_space(); mcode print_string_box lp;
 688       expression exp; close_box(); mcode print_string rp;
 689       mcode print_string sem
 690   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 691       pr_arity arity;
 692       mcode print_string fr; mcode print_string_box lp;
 693       print_option expression e1; mcode print_string sem1;
 694       print_option expression e2; mcode print_string sem2;
 695       print_option expression e3; close_box();
 696       mcode print_string rp
 697   | Ast.IteratorHeader(nm,lp,args,rp) ->
 698       pr_arity arity;
 699       ident nm; pr_space(); mcode print_string_box lp;
 700       dots (function _ -> ()) expression args; close_box();
 701       mcode print_string rp
 702
 703   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 704       pr_arity arity;
 705       mcode print_string switch; pr_space(); mcode print_string_box lp;
 706       expression exp; close_box(); mcode print_string rp
 707
 708   | Ast.Break(br,sem) ->
 709       pr_arity arity; mcode print_string br; mcode print_string sem
 710   | Ast.Continue(cont,sem) ->
 711       pr_arity arity; mcode print_string cont; mcode print_string sem
 712   | Ast.Label(l,dd) -> ident l; mcode print_string dd
 713   | Ast.Goto(goto,l,sem) ->
 714       mcode print_string goto; ident l; mcode print_string sem
 715   | Ast.Return(ret,sem) ->
 716       pr_arity arity; mcode print_string ret;
 717       mcode print_string sem
 718   | Ast.ReturnExpr(ret,exp,sem) ->
 719       pr_arity arity; mcode print_string ret; pr_space();
 720       expression exp; mcode print_string sem
 721
 722   | Ast.Exp(exp) -> pr_arity arity; expression exp
 723   | Ast.TopExp(exp) -> pr_arity arity; expression exp
 724   | Ast.Ty(ty) -> pr_arity arity; fullType ty
 725   | Ast.TopInit(init) -> initialiser false init
 726   | Ast.Include(inc,s) ->
 727       mcode print_string inc; print_text " "; mcode inc_file s
 728   | Ast.DefineHeader(def,id,params) ->
 729       mcode print_string def; pr_space(); ident id;
 730       print_define_parameters params
 731   | Ast.Default(def,colon) ->
 732       mcode print_string def; mcode print_string colon; pr_space()
 733   | Ast.Case(case,exp,colon) ->
 734       mcode print_string case; pr_space(); expression exp;
 735       mcode print_string colon; pr_space()
 736   | Ast.DisjRuleElem(res) ->
 737       if generating
 738       then
 739         (pr_arity arity; print_text "\n(\n";
 740          print_between (function _ -> print_text "\n|\n") (rule_elem arity)
 741            res;
 742          print_text "\n)")
 743       else raise CantBeInPlus
 744
 745   | Ast.MetaRuleElem(name,_,_) ->
 746       raise Impossible
 747
 748   | Ast.MetaStmt(name,_,_,_) ->
 749       handle_metavar name  (function
 750         | Ast_c.MetaStmtVal stm ->
 751             pretty_print_c.Pretty_print_c.statement stm
 752         | _ -> raise Impossible
 753                            )
 754   | Ast.MetaStmtList(name,_,_) ->
 755       failwith
 756         "MetaStmtList not supported (not even in ast_c metavars binding)"
 757
 758 and print_define_parameters params =
 759   match Ast.unwrap params with
 760     Ast.NoParams -> ()
 761   | Ast.DParams(lp,params,rp) ->
 762       mcode print_string lp;
 763       dots (function _ -> ()) print_define_param params; mcode print_string rp
 764
 765 and print_define_param param =
 766   match Ast.unwrap param with
 767     Ast.DParam(id) -> ident id
 768   | Ast.DPComma(comma) -> mcode print_string comma
 769   | Ast.DPdots(dots) -> mcode print_string dots
 770   | Ast.DPcircles(circles) -> mcode print_string circles
 771   | Ast.OptDParam(dp) -> print_text "?"; print_define_param dp
 772   | Ast.UniqueDParam(dp) -> print_text "!"; print_define_param dp
 773
 774 and print_fninfo = function
 775     Ast.FStorage(stg) -> mcode storage stg
 776   | Ast.FType(ty) -> fullType ty
 777   | Ast.FInline(inline) -> mcode print_string inline; pr_space()
 778   | Ast.FAttr(attr) -> mcode print_string attr; pr_space() in
 779
 780 let indent_if_needed s f =
 781   match Ast.unwrap s with
 782     Ast.Seq(lbrace,body,rbrace) -> pr_space(); f()
 783   | _ ->
 784       (*no newline at the end - someone else will do that*)
 785       start_block(); f(); unindent() in
 786
 787 let rec statement arity s =
 788   match Ast.unwrap s with
 789     Ast.Seq(lbrace,body,rbrace) ->
 790       rule_elem arity lbrace;
 791       dots force_newline (statement arity) body;
 792       rule_elem arity rbrace
 793
 794   | Ast.IfThen(header,branch,_) ->
 795       rule_elem arity header;
 796       indent_if_needed branch (function _ -> statement arity branch)
 797   | Ast.IfThenElse(header,branch1,els,branch2,_) ->
 798       rule_elem arity header;
 799       indent_if_needed branch1 (function _ -> statement arity branch1);
 800       force_newline();
 801       rule_elem arity els;
 802       indent_if_needed branch2 (function _ -> statement arity branch2)
 803   | Ast.While(header,body,_) ->
 804       rule_elem arity header;
 805       indent_if_needed body (function _ -> statement arity body)
 806   | Ast.Do(header,body,tail) ->
 807       rule_elem arity header;
 808       indent_if_needed body (function _ -> statement arity body);
 809       rule_elem arity tail
 810   | Ast.For(header,body,_) ->
 811       rule_elem arity header;
 812       indent_if_needed body (function _ -> statement arity body)
 813   | Ast.Iterator(header,body,(_,_,_,aft)) ->
 814       rule_elem arity header;
 815       indent_if_needed body (function _ -> statement arity body);
 816       mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 817
 818   | Ast.Switch(header,lb,decls,cases,rb) ->
 819       rule_elem arity header; pr_space(); rule_elem arity lb;
 820       dots force_newline (statement arity) decls;
 821       List.iter (function x -> case_line arity x; force_newline()) cases;
 822       rule_elem arity rb
 823
 824   | Ast.Atomic(re) -> rule_elem arity re
 825
 826   | Ast.FunDecl(header,lbrace,body,rbrace) ->
 827       rule_elem arity header; rule_elem arity lbrace;
 828       dots force_newline (statement arity) body; rule_elem arity rbrace
 829
 830   | Ast.Define(header,body) ->
 831       rule_elem arity header; pr_space();
 832       dots force_newline (statement arity) body
 833
 834   | Ast.Disj([stmt_dots]) ->
 835       if generating
 836       then
 837         (pr_arity arity;
 838          dots force_newline (statement arity) stmt_dots)
 839       else raise CantBeInPlus
 840   | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
 841       if generating
 842       then
 843         (pr_arity arity; print_text "\n(\n";
 844          print_between (function _ -> print_text "\n|\n")
 845            (dots force_newline (statement arity))
 846            stmt_dots_list;
 847          print_text "\n)")
 848       else raise CantBeInPlus
 849   | Ast.Nest(stmt_dots,whn,multi,_,_) when generating ->
 850       pr_arity arity;
 851       nest_dots multi (statement arity)
 852         (function _ ->
 853           print_between force_newline
 854             (whencode (dots force_newline (statement "")) (statement "")) whn;
 855           force_newline())
 856         stmt_dots
 857   | Ast.Nest(_) -> raise CantBeInPlus
 858   | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
 859       if generating
 860       then
 861         (pr_arity arity; mcode print_string d;
 862          print_between force_newline
 863            (whencode (dots force_newline (statement "")) (statement "")) whn;
 864          force_newline())
 865       else raise CantBeInPlus
 866
 867   | Ast.OptStm(s) | Ast.UniqueStm(s) ->
 868       raise CantBeInPlus
 869
 870 and whencode notfn alwaysfn = function
 871     Ast.WhenNot a ->
 872       print_text "   WHEN != "; notfn a
 873   | Ast.WhenAlways a ->
 874       print_text "   WHEN = "; alwaysfn a
 875   | Ast.WhenModifier x -> print_text "   WHEN "; print_when_modif x
 876   | Ast.WhenNotTrue a ->
 877       print_text "   WHEN != TRUE "; rule_elem "" a
 878   | Ast.WhenNotFalse a ->
 879       print_text "   WHEN != FALSE "; rule_elem "" a
 880
 881 and print_when_modif = function
 882   | Ast.WhenAny    -> print_text "ANY"
 883   | Ast.WhenStrict -> print_text "STRICT"
 884   | Ast.WhenForall -> print_text "FORALL"
 885   | Ast.WhenExists -> print_text "EXISTS"
 886
 887 and case_line arity c =
 888   match Ast.unwrap c with
 889     Ast.CaseLine(header,code) ->
 890       rule_elem arity header; pr_space();
 891       dots force_newline (statement arity) code
 892   | Ast.OptCase(case) -> raise CantBeInPlus in
 893
 894 let top_level t =
 895   match Ast.unwrap t with
 896     Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus
 897   | Ast.DECL(stmt) -> statement "" stmt
 898   | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots
 899   | Ast.ERRORWORDS(exps) -> raise CantBeInPlus
 900 in
 901
 902 (*
 903 let rule =
 904   print_between (function _ -> force_newline(); force_newline()) top_level
 905 in
 906 *)
 907
 908 let if_open_brace  = function "{" -> true | _ -> false in
 909
 910 (* boolean result indicates whether an indent is needed *)
 911 let rec pp_any = function
 912   (* assert: normally there is only CONTEXT NOTHING tokens in any *)
 913     Ast.FullTypeTag(x) -> fullType x; false
 914   | Ast.BaseTypeTag(x) -> baseType x unknown unknown; false
 915   | Ast.StructUnionTag(x) -> structUnion x unknown unknown; false
 916   | Ast.SignTag(x) -> sign x unknown unknown; false
 917
 918   | Ast.IdentTag(x) -> ident x; false
 919
 920   | Ast.ExpressionTag(x) -> expression x; false
 921
 922   | Ast.ConstantTag(x) -> constant x unknown unknown; false
 923   | Ast.UnaryOpTag(x) -> unaryOp x unknown unknown; false
 924   | Ast.AssignOpTag(x) -> assignOp x unknown unknown; false
 925   | Ast.FixOpTag(x) -> fixOp x unknown unknown; false
 926   | Ast.BinaryOpTag(x) -> binaryOp x unknown unknown; false
 927   | Ast.ArithOpTag(x) -> arithOp x unknown unknown; false
 928   | Ast.LogicalOpTag(x) -> logicalOp x unknown unknown; false
 929
 930   | Ast.InitTag(x) -> initialiser false x; false
 931   | Ast.DeclarationTag(x) -> declaration x; false
 932
 933   | Ast.StorageTag(x) -> storage x unknown unknown; false
 934   | Ast.IncFileTag(x) -> inc_file x unknown unknown; false
 935
 936   | Ast.Rule_elemTag(x) -> rule_elem "" x; false
 937   | Ast.StatementTag(x) -> statement "" x; false
 938   | Ast.CaseLineTag(x) -> case_line "" x; false
 939
 940   | Ast.ConstVolTag(x) -> const_vol x unknown unknown; false
 941   | Ast.Pragma(xs) -> print_between force_newline print_text xs; false
 942   | Ast.Token(x,None) -> print_text x; if_open_brace x
 943   | Ast.Token(x,Some info) ->
 944       mcode
 945         (fun x line lcol ->
 946           (match x with
 947             "else" -> force_newline()
 948           | _ -> ());
 949           print_string x line lcol)
 950         (let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in
 951         (x,info,nomcodekind,Ast.NoMetaPos));
 952       if_open_brace x
 953
 954   | Ast.Code(x) -> let _ = top_level x in false
 955
 956   (* this is not '...', but a list of expr/statement/params, and
 957      normally there should be no '...' inside them *)
 958   | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false
 959   | Ast.ParamDotsTag(x) -> parameter_list x; false
 960   | Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false
 961   | Ast.DeclDotsTag(x) -> dots force_newline declaration x; false
 962
 963   | Ast.TypeCTag(x) -> typeC x; false
 964   | Ast.ParamTag(x) -> parameterTypeDef x; false
 965   | Ast.SgrepStartTag(x) -> failwith "unexpected start tag"
 966   | Ast.SgrepEndTag(x) -> failwith "unexpected end tag"
 967 in
 968
 969   anything := (function x -> let _ = pp_any x in ());
 970
 971   (* todo? imitate what is in pretty_print_cocci ? *)
 972   match xxs with
 973     [] -> ()
 974   | x::xs ->
 975       (* for many tags, we must not do a newline before the first '+' *)
 976       let isfn s =
 977         match Ast.unwrap s with Ast.FunDecl _ -> true | _ -> false in
 978       let unindent_before = function
 979         (* need to get unindent before newline for } *)
 980           (Ast.Token ("}",_)::_) -> true
 981         | _ -> false in
 982       let prnl x =
 983         (if unindent_before x then unindent());
 984         force_newline() in
 985       let newline_before _ =
 986         if before =*= After
 987         then
 988           let hd = List.hd xxs in
 989           match hd with
 990             (Ast.StatementTag s::_) when isfn s ->
 991               force_newline(); force_newline()
 992           | (Ast.Pragma _::_)
 993           | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
 994           | (Ast.InitTag _::_)
 995           | (Ast.DeclarationTag _::_) | (Ast.Token ("}",_)::_) -> prnl hd
 996           | _ -> () in
 997       let newline_after _ =
 998         if before =*= Before
 999         then
1000           match List.rev(List.hd(List.rev xxs)) with
1001             (Ast.StatementTag s::_) ->
1002               (if isfn s then force_newline());
1003               force_newline()
1004           | (Ast.Pragma _::_)
1005           | (Ast.Rule_elemTag _::_) | (Ast.InitTag _::_)
1006           | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) ->
1007               force_newline()
1008           | _ -> () in
1009       (* print a newline at the beginning, if needed *)
1010       newline_before();
1011       (* print a newline before each of the rest *)
1012       let rec loop leading_newline indent_needed = function
1013           [] -> ()
1014         | x::xs ->
1015             (if leading_newline
1016             then
1017               match (indent_needed,unindent_before x) with
1018                 (true,true) -> force_newline()
1019               | (true,false) -> force_newline(); indent()
1020               | (false,true) -> unindent(); force_newline()
1021               | (false,false) -> force_newline());
1022             let space_needed_before = function
1023                 Ast.ParamTag(x) ->
1024                   (match Ast.unwrap x with
1025                     Ast.PComma _ -> false
1026                   | _ -> true)
1027               | Ast.ExpressionTag(x) ->
1028                   (match Ast.unwrap x with
1029                     Ast.EComma _ -> false
1030                   | _ -> true)
1031               | Ast.InitTag(x) ->
1032                   (match Ast.unwrap x with
1033                     Ast.IComma _ -> false
1034                   | _ -> true)
1035               | Ast.Token(t,_) when List.mem t [",";";";"(";")"] -> false
1036               | _ -> true in
1037             let space_needed_after = function
1038                 Ast.Token(t,_) when List.mem t ["("] -> (*never needed*) false
1039               | Ast.Token(t,_) when List.mem t ["if";"for";"while";"do"] ->
1040                   (* space always needed *)
1041                   pr_space(); false
1042               | _ -> true in
1043             let indent_needed =
1044               let rec loop space_after indent_needed = function
1045                   [] -> indent_needed
1046                 | x::xs ->
1047                     (if space_after && space_needed_before x
1048                     then pr_space());
1049                     let indent_needed = pp_any x in
1050                     let space_after = space_needed_after x in
1051                     loop space_after indent_needed xs in
1052               loop false false x in
1053             loop true indent_needed xs in
1054       loop false false (x::xs);
1055       (* print a newline at the end, if needed *)
1056       newline_after()
1057
1058 let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity,
1059                           pr_barrier, indent, unindent)
1060     generating xxs before =
1061   List.iter
1062     (function env ->
1063       do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
1064               indent, unindent)
1065         generating xxs before)
1066     envs