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