parsing_cocci/pretty_print_cocci.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (*
  26  * Copyright 2010, INRIA, University of Copenhagen
  27  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  28  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  29  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  30  * This file is part of Coccinelle.
  31  *
  32  * Coccinelle is free software: you can redistribute it and/or modify
  33  * it under the terms of the GNU General Public License as published by
  34  * the Free Software Foundation, according to version 2 of the License.
  35  *
  36  * Coccinelle is distributed in the hope that it will be useful,
  37  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  38  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39  * GNU General Public License for more details.
  40  *
  41  * You should have received a copy of the GNU General Public License
  42  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  43  *
  44  * The authors reserve the right to distribute this or future versions of
  45  * Coccinelle under other licenses.
  46  *)
  47
  48
  49 open Format
  50 module Ast = Ast_cocci
  51
  52 let print_plus_flag = ref true
  53 let print_minus_flag = ref true
  54 let print_newlines_disj = ref true
  55
  56 let start_block str =
  57   force_newline(); print_string "  "; open_box 0
  58
  59 let end_block str =
  60   close_box(); force_newline ()
  61
  62 let print_string_box s = print_string s; open_box 0
  63
  64
  65 let print_option = Common.do_option
  66 let print_between = Common.print_between
  67
  68 (* --------------------------------------------------------------------- *)
  69 (* Modified code *)
  70
  71 (* avoid polyvariance problems *)
  72 let anything : (Ast.anything -> unit) ref = ref (function _ -> ())
  73
  74 let rec print_anything str = function
  75     [] -> ()
  76   | stream ->
  77       start_block();
  78       print_between force_newline
  79         (function x ->
  80           print_string str; open_box 0; print_anything_list x; close_box())
  81         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 print_string " ";
  99       print_anything_list rest
 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
 107
 108 let print_string_befaft fn x info =
 109   let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
 110   List.iter (function (s,_,_) -> print s; force_newline()) info.Ast.strbef;
 111   fn x;
 112   List.iter (function (s,_,_) -> force_newline(); print s) info.Ast.straft
 113
 114 let print_meta (r,x) = print_string r; print_string ":"; print_string x
 115
 116 let print_pos = function
 117     Ast.MetaPos(name,_,_,_,_) ->
 118       let name = Ast.unwrap_mcode name in
 119       print_string "@"; print_meta name
 120   | _ -> ()
 121
 122 let mcode fn = function
 123     (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) ->
 124       if !print_minus_flag
 125       then print_string (if !Flag.sgrep_mode2 then "*" else "-");
 126       fn x; print_pos pos;
 127       if !print_plus_flag
 128       then print_anything ">>> " plus_stream
 129   | (x, _, Ast.CONTEXT(_,plus_streams), pos) ->
 130       if !print_plus_flag
 131       then
 132         let fn x = fn x; print_pos pos in
 133         print_around fn x plus_streams
 134       else (fn x; print_pos pos)
 135   | (x, info, Ast.PLUS _, pos) ->
 136       let fn x = fn x; print_pos pos in
 137       print_string_befaft fn x info
 138
 139 let print_mcodekind = function
 140     Ast.MINUS(_,_,_,plus_stream) ->
 141       print_string "MINUS";
 142       print_anything ">>> " plus_stream
 143   | Ast.CONTEXT(_,plus_streams) ->
 144       print_around (function _ -> print_string "CONTEXT") () plus_streams
 145   | Ast.PLUS _ -> print_string "PLUS"
 146
 147 (* --------------------------------------------------------------------- *)
 148 (* --------------------------------------------------------------------- *)
 149 (* Dots *)
 150
 151 let dots between fn d =
 152   match Ast.unwrap d with
 153     Ast.DOTS(l) -> print_between between fn l
 154   | Ast.CIRCLES(l) -> print_between between fn l
 155   | Ast.STARS(l) -> print_between between fn l
 156
 157 let nest_dots starter ender fn f d =
 158   mcode print_string starter;
 159   f(); start_block();
 160   (match Ast.unwrap d with
 161     Ast.DOTS(l)    -> print_between force_newline fn l
 162   | Ast.CIRCLES(l) -> print_between force_newline fn l
 163   | Ast.STARS(l)   -> print_between force_newline fn l);
 164   end_block();
 165   mcode print_string ender
 166
 167 (* --------------------------------------------------------------------- *)
 168
 169 let print_type keep info = function
 170     None -> ()
 171         (* print_string "/* ";
 172            print_string "keep:"; print_unitary keep;
 173            print_string " inherited:"; print_bool inherited;
 174            print_string " */"*)
 175   | Some ty -> ()
 176       (*;
 177       print_string "/* ";
 178       print_between (function _ -> print_string ", ") Type_cocci.typeC ty;(*
 179       print_string "keep:"; print_unitary keep;
 180       print_string " inherited:"; print_bool inherited;*)
 181       print_string " */"*)
 182
 183 (* --------------------------------------------------------------------- *)
 184 (* Contraint on Identifier and Function *)
 185 (* FIXME: Not called at the moment *)
 186
 187 let rec idconstraint = function
 188     Ast.IdNoConstraint  -> print_string "/* No constraint */"
 189   | Ast.IdNegIdSet (str,meta)     ->
 190       List.iter (function s -> print_string (" "^s)) str;
 191       List.iter (function (r,n) -> print_string " "; print_meta(r,n)) meta
 192   | Ast.IdRegExpConstraint re -> regconstraint re
 193
 194 and regconstraint = function
 195     Ast.IdRegExp (re,_) ->
 196       print_string "~= \""; print_string re; print_string "\""
 197   | Ast.IdNotRegExp (re,_) ->
 198       print_string "~!= \""; print_string re; print_string "\""
 199
 200 (* --------------------------------------------------------------------- *)
 201 (* Identifier *)
 202
 203 let rec ident i =
 204   match Ast.unwrap i with
 205       Ast.Id(name) -> mcode print_string name
 206     | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
 207     | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
 208     | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
 209     | Ast.OptIdent(id) -> print_string "?"; ident id
 210     | Ast.UniqueIdent(id) -> print_string "!"; ident id
 211
 212 and print_unitary = function
 213     Type_cocci.Unitary -> print_string "unitary"
 214   | Type_cocci.Nonunitary -> print_string "nonunitary"
 215   | Type_cocci.Saved -> print_string "saved"
 216
 217 (* --------------------------------------------------------------------- *)
 218 (* Expression *)
 219
 220 let print_disj_list fn l =
 221   if !print_newlines_disj
 222   then (force_newline(); print_string "("; force_newline())
 223   else print_string "(";
 224   print_between
 225     (function _ ->
 226       if !print_newlines_disj
 227       then (force_newline(); print_string "|"; force_newline())
 228       else print_string " | ")
 229     fn l;
 230   if !print_newlines_disj
 231   then (force_newline(); print_string ")"; force_newline())
 232   else print_string ")"
 233
 234 let rec expression e =
 235   match Ast.unwrap e with
 236     Ast.Ident(id) -> ident id
 237   | Ast.Constant(const) -> mcode constant const
 238   | Ast.FunCall(fn,lp,args,rp) ->
 239       expression fn; mcode print_string_box lp;
 240       dots (function _ -> ()) expression args;
 241       close_box(); mcode print_string rp
 242   | Ast.Assignment(left,op,right,simple) ->
 243       expression left; print_string " "; mcode assignOp op;
 244       print_string " "; expression right
 245   | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
 246       expression exp1; print_string " "; mcode print_string why;
 247       print_option (function e -> print_string " "; expression e) exp2;
 248       print_string " "; mcode print_string colon; expression exp3
 249   | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
 250   | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
 251   | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
 252   | Ast.Binary(left,op,right) ->
 253       expression left; print_string " "; mcode binaryOp op; print_string " ";
 254       expression right
 255   | Ast.Nested(left,op,right) ->
 256       expression left; print_string " "; mcode binaryOp op; print_string " ";
 257       expression right
 258   | Ast.Paren(lp,exp,rp) ->
 259       mcode print_string_box lp; expression exp; close_box();
 260       mcode print_string rp
 261   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 262       expression exp1; mcode print_string_box lb; expression exp2; close_box();
 263       mcode print_string rb
 264   | Ast.RecordAccess(exp,pt,field) ->
 265       expression exp; mcode print_string pt; ident field
 266   | Ast.RecordPtAccess(exp,ar,field) ->
 267       expression exp; mcode print_string ar; ident field
 268   | Ast.Cast(lp,ty,rp,exp) ->
 269       mcode print_string_box lp; fullType ty; close_box();
 270       mcode print_string rp; expression exp
 271   | Ast.SizeOfExpr(sizeof,exp) ->
 272       mcode print_string sizeof; expression exp
 273   | Ast.SizeOfType(sizeof,lp,ty,rp) ->
 274       mcode print_string sizeof;
 275       mcode print_string_box lp; fullType ty; close_box();
 276       mcode print_string rp
 277   | Ast.TypeExp(ty) -> fullType ty
 278
 279   | Ast.MetaErr(name,_,_,_) -> mcode print_meta name
 280   | Ast.MetaExpr(name,_,keep,ty,form,inherited) ->
 281       mcode print_meta name; print_type keep inherited ty
 282   | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name
 283   | Ast.EComma(cm) -> mcode print_string cm; print_space()
 284   | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list
 285   | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi) ->
 286       nest_dots starter ender expression
 287         (function _ -> print_string "   when != "; expression whencode)
 288         expr_dots
 289   | Ast.NestExpr(starter,expr_dots,ender,None,multi) ->
 290       nest_dots starter ender expression (function _ -> ()) expr_dots
 291   | Ast.Edots(dots,Some whencode)
 292   | Ast.Ecircles(dots,Some whencode)
 293   | Ast.Estars(dots,Some whencode) ->
 294       mcode print_string dots; print_string "   when != "; expression whencode
 295   | Ast.Edots(dots,None)
 296   | Ast.Ecircles(dots,None)
 297   | Ast.Estars(dots,None) -> mcode print_string dots
 298   | Ast.OptExp(exp) -> print_string "?"; expression exp
 299   | Ast.UniqueExp(exp) -> print_string "!"; expression exp
 300
 301 and  unaryOp = function
 302     Ast.GetRef -> print_string "&"
 303   | Ast.DeRef -> print_string "*"
 304   | Ast.UnPlus -> print_string "+"
 305   | Ast.UnMinus -> print_string "-"
 306   | Ast.Tilde -> print_string "~"
 307   | Ast.Not -> print_string "!"
 308
 309 and  assignOp = function
 310     Ast.SimpleAssign -> print_string "="
 311   | Ast.OpAssign(aop) -> arithOp aop; print_string "="
 312
 313 and  fixOp = function
 314     Ast.Dec -> print_string "--"
 315   | Ast.Inc -> print_string "++"
 316
 317 and  binaryOp = function
 318     Ast.Arith(aop) -> arithOp aop
 319   | Ast.Logical(lop) -> logicalOp lop
 320
 321 and  arithOp = function
 322     Ast.Plus -> print_string "+"
 323   | Ast.Minus -> print_string "-"
 324   | Ast.Mul -> print_string "*"
 325   | Ast.Div -> print_string "/"
 326   | Ast.Mod -> print_string "%"
 327   | Ast.DecLeft -> print_string "<<"
 328   | Ast.DecRight -> print_string ">>"
 329   | Ast.And -> print_string "&"
 330   | Ast.Or -> print_string "|"
 331   | Ast.Xor -> print_string "^"
 332
 333 and  logicalOp = function
 334     Ast.Inf -> print_string "<"
 335   | Ast.Sup -> print_string ">"
 336   | Ast.InfEq -> print_string "<="
 337   | Ast.SupEq -> print_string ">="
 338   | Ast.Eq -> print_string "=="
 339   | Ast.NotEq -> print_string "!="
 340   | Ast.AndLog -> print_string "&&"
 341   | Ast.OrLog -> print_string "||"
 342
 343 and constant = function
 344     Ast.String(s) -> print_string "\""; print_string s; print_string "\""
 345   | Ast.Char(s) -> print_string "'"; print_string s; print_string "'"
 346   | Ast.Int(s) -> print_string s
 347   | Ast.Float(s) -> print_string s
 348
 349 (* --------------------------------------------------------------------- *)
 350 (* Declarations *)
 351
 352 and storage = function
 353     Ast.Static -> print_string "static "
 354   | Ast.Auto -> print_string "auto "
 355   | Ast.Register -> print_string "register "
 356   | Ast.Extern -> print_string "extern "
 357
 358 (* --------------------------------------------------------------------- *)
 359 (* Types *)
 360
 361 and fullType ft =
 362   match Ast.unwrap ft with
 363     Ast.Type(cv,ty) ->
 364       print_option (function x -> mcode const_vol x; print_string " ") cv;
 365       typeC ty
 366   | Ast.DisjType(decls) -> print_disj_list fullType decls
 367   | Ast.OptType(ty) -> print_string "?"; fullType ty
 368   | Ast.UniqueType(ty) -> print_string "!"; fullType ty
 369
 370 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
 371   fullType ty; mcode print_string lp1; mcode print_string star; fn();
 372   mcode print_string rp1; mcode print_string lp1;
 373   parameter_list params; mcode print_string rp2
 374
 375 and print_function_type (ty,lp1,params,rp1) fn =
 376   print_option fullType ty; fn(); mcode print_string lp1;
 377   parameter_list params; mcode print_string rp1
 378
 379 and print_fninfo = function
 380     Ast.FStorage(stg) -> mcode storage stg
 381   | Ast.FType(ty) -> fullType ty
 382   | Ast.FInline(inline) -> mcode print_string inline; print_string " "
 383   | Ast.FAttr(attr) -> mcode print_string attr; print_string " "
 384
 385 and typeC ty =
 386   match Ast.unwrap ty with
 387     Ast.BaseType(ty,strings) ->
 388       List.iter (function s -> mcode print_string s; print_string " ") strings
 389   | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option typeC ty
 390   | Ast.Pointer(ty,star) -> fullType ty; mcode print_string star
 391   | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 392       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 393         (function _ -> ())
 394   | Ast.FunctionType (_,ty,lp1,params,rp1) ->
 395       print_function_type (ty,lp1,params,rp1) (function _ -> ())
 396   | Ast.Array(ty,lb,size,rb) ->
 397       fullType ty; mcode print_string lb; print_option expression size;
 398       mcode print_string rb
 399   | Ast.EnumName(kind,name) ->
 400       mcode print_string kind;
 401       print_option (function x -> ident x; print_string " ") name
 402   | Ast.EnumDef(ty,lb,ids,rb) ->
 403       fullType ty; mcode print_string lb;
 404       dots force_newline expression ids;
 405       mcode print_string rb
 406   | Ast.StructUnionName(kind,name) ->
 407       mcode structUnion kind;
 408       print_option (function x -> ident x; print_string " ") name
 409   | Ast.StructUnionDef(ty,lb,decls,rb) ->
 410       fullType ty; mcode print_string lb;
 411       dots force_newline declaration decls;
 412       mcode print_string rb
 413   | Ast.TypeName(name) -> mcode print_string name; print_string " "
 414   | Ast.MetaType(name,_,_) ->
 415       mcode print_meta name; print_string " "
 416
 417 and baseType = function
 418     Ast.VoidType -> print_string "void "
 419   | Ast.CharType -> print_string "char "
 420   | Ast.ShortType -> print_string "short "
 421   | Ast.IntType -> print_string "int "
 422   | Ast.DoubleType -> print_string "double "
 423   | Ast.FloatType -> print_string "float "
 424   | Ast.LongType -> print_string "long "
 425   | Ast.LongLongType -> print_string "long long "
 426   | Ast.SizeType -> print_string "size_t "
 427   | Ast.SSizeType -> print_string "ssize_t "
 428   | Ast.PtrDiffType -> print_string "ptrdiff_t "
 429
 430 and structUnion = function
 431     Ast.Struct -> print_string "struct "
 432   | Ast.Union -> print_string "union "
 433
 434 and sign = function
 435     Ast.Signed -> print_string "signed "
 436   | Ast.Unsigned -> print_string "unsigned "
 437
 438 and const_vol = function
 439     Ast.Const -> print_string "const"
 440   | Ast.Volatile -> print_string "volatile"
 441
 442 (* --------------------------------------------------------------------- *)
 443 (* Variable declaration *)
 444 (* Even if the Cocci program specifies a list of declarations, they are
 445    split out into multiple declarations of a single variable each. *)
 446
 447 and print_named_type ty id =
 448   match Ast.unwrap ty with
 449     Ast.Type(None,ty1) ->
 450       (match Ast.unwrap ty1 with
 451         Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 452           print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 453             (function _ -> print_string " "; ident id)
 454       | Ast.FunctionType(_,ty,lp1,params,rp1) ->
 455           print_function_type (ty,lp1,params,rp1)
 456             (function _ -> print_string " "; ident id)
 457       | Ast.Array(ty,lb,size,rb) ->
 458           let rec loop ty k =
 459             match Ast.unwrap ty with
 460               Ast.Array(ty,lb,size,rb) ->
 461                 (match Ast.unwrap ty with
 462                   Ast.Type(None,ty) ->
 463                     loop ty
 464                       (function _ ->
 465                         k ();
 466                         mcode print_string lb;
 467                         print_option expression size;
 468                         mcode print_string rb)
 469                 | _ -> failwith "complex array types not supported")
 470             | _ -> typeC ty; ident id; k () in
 471           loop ty1 (function _ -> ())
 472       | _ -> fullType ty; ident id)
 473   | _ -> fullType ty; ident id
 474
 475 and declaration d =
 476   match Ast.unwrap d with
 477     Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) -> mcode print_meta name
 478   | Ast.Init(stg,ty,id,eq,ini,sem) ->
 479       print_option (mcode storage) stg; print_named_type ty id;
 480       print_string " "; mcode print_string eq;
 481       print_string " "; initialiser ini; mcode print_string sem
 482   | Ast.UnInit(stg,ty,id,sem) ->
 483       print_option (mcode storage) stg; print_named_type ty id;
 484       mcode print_string sem
 485   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 486       ident name; mcode print_string_box lp;
 487       dots (function _ -> ()) expression args;
 488       close_box(); mcode print_string rp; mcode print_string sem
 489   | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
 490   | Ast.Typedef(stg,ty,id,sem) ->
 491       mcode print_string stg; print_string " "; fullType ty; typeC id;
 492       mcode print_string sem
 493   | Ast.DisjDecl(decls) -> print_disj_list declaration decls
 494   | Ast.Ddots(dots,Some whencode) ->
 495       mcode print_string dots; print_string "   when != "; declaration whencode
 496   | Ast.Ddots(dots,None) -> mcode print_string dots
 497   | Ast.OptDecl(decl) -> print_string "?"; declaration decl
 498   | Ast.UniqueDecl(decl) -> print_string "!"; declaration decl
 499
 500 (* --------------------------------------------------------------------- *)
 501 (* Initialiser *)
 502
 503 and initialiser i =
 504   match Ast.unwrap i with
 505     Ast.MetaInit(name,_,_) ->
 506       mcode print_meta name; print_string " "
 507   | Ast.InitExpr(exp) -> expression exp
 508   | Ast.ArInitList(lb,initlist,rb) ->
 509       mcode print_string lb; open_box 0;
 510       dots force_newline initialiser initlist; close_box();
 511       mcode print_string rb
 512   | Ast.StrInitList(allminus,lb,initlist,rb,whencode) ->
 513       mcode print_string lb; open_box 0;
 514       if not (whencode = [])
 515       then
 516         (print_string "   WHEN != ";
 517          print_between (function _ -> print_string " v ")
 518            initialiser whencode;
 519          force_newline());
 520       List.iter initialiser initlist; close_box();
 521       mcode print_string rb
 522   | Ast.InitGccExt(designators,eq,ini) ->
 523       List.iter designator designators; print_string " ";
 524       mcode print_string eq; print_string " "; initialiser ini
 525   | Ast.InitGccName(name,eq,ini) ->
 526       ident name; mcode print_string eq; initialiser ini
 527   | Ast.IComma(comma) -> mcode print_string comma; force_newline()
 528   | Ast.Idots(dots,Some whencode) ->
 529       mcode print_string dots; print_string "   when != "; initialiser whencode
 530   | Ast.Idots(dots,None) -> mcode print_string dots
 531   | Ast.OptIni(ini) -> print_string "?"; initialiser ini
 532   | Ast.UniqueIni(ini) -> print_string "!"; initialiser ini
 533
 534 and designator = function
 535     Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
 536   | Ast.DesignatorIndex(lb,exp,rb) ->
 537       mcode print_string lb; expression exp; mcode print_string rb
 538   | Ast.DesignatorRange(lb,min,dots,max,rb) ->
 539       mcode print_string lb; expression min; mcode print_string dots;
 540       expression max; mcode print_string rb
 541
 542 (* --------------------------------------------------------------------- *)
 543 (* Parameter *)
 544
 545 and parameterTypeDef p =
 546   match Ast.unwrap p with
 547     Ast.VoidParam(ty) -> fullType ty
 548   | Ast.Param(ty,Some id) -> print_named_type ty id
 549   | Ast.Param(ty,None) -> fullType ty
 550   | Ast.MetaParam(name,_,_) -> mcode print_meta name
 551   | Ast.MetaParamList(name,_,_,_) -> mcode print_meta name
 552   | Ast.PComma(cm) -> mcode print_string cm; print_space()
 553   | Ast.Pdots(dots) -> mcode print_string dots
 554   | Ast.Pcircles(dots) -> mcode print_string dots
 555   | Ast.OptParam(param) -> print_string "?"; parameterTypeDef param
 556   | Ast.UniqueParam(param) -> print_string "!"; parameterTypeDef param
 557
 558 and parameter_list l = dots (function _ -> ()) parameterTypeDef l
 559
 560 (* --------------------------------------------------------------------- *)
 561 (* Top-level code *)
 562
 563 let rec rule_elem arity re =
 564   match Ast.unwrap re with
 565     Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
 566       mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
 567       print_string arity; List.iter print_fninfo fninfo;
 568       ident name; mcode print_string_box lp;
 569       parameter_list params; close_box(); mcode print_string rp;
 570       print_string " "
 571   | Ast.Decl(bef,allminus,decl) ->
 572       mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
 573       print_string arity;
 574       declaration decl
 575   | Ast.SeqStart(brace) ->
 576       print_string arity; mcode print_string brace;
 577       if !print_newlines_disj then start_block()
 578   | Ast.SeqEnd(brace) ->
 579       if !print_newlines_disj then end_block();
 580       print_string arity; mcode print_string brace
 581   | Ast.ExprStatement(exp,sem) ->
 582       print_string arity; expression exp; mcode print_string sem
 583   | Ast.IfHeader(iff,lp,exp,rp) ->
 584       print_string arity;
 585       mcode print_string iff; print_string " "; mcode print_string_box lp;
 586       expression exp; close_box(); mcode print_string rp; print_string " "
 587   | Ast.Else(els) ->
 588       print_string arity; mcode print_string els; print_string " "
 589   | Ast.WhileHeader(whl,lp,exp,rp) ->
 590       print_string arity;
 591       mcode print_string whl; print_string " "; mcode print_string_box lp;
 592       expression exp; close_box(); mcode print_string rp; print_string " "
 593   | Ast.DoHeader(d) ->
 594       print_string arity; mcode print_string d; print_string " "
 595   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 596       print_string arity;
 597       mcode print_string whl; print_string " "; mcode print_string_box lp;
 598       expression exp; close_box(); mcode print_string rp;
 599       mcode print_string sem
 600   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 601       print_string arity;
 602       mcode print_string fr; mcode print_string_box lp;
 603       print_option expression e1; mcode print_string sem1;
 604       print_option expression e2; mcode print_string sem2;
 605       print_option expression e3; close_box();
 606       mcode print_string rp; print_string " "
 607   | Ast.IteratorHeader(nm,lp,args,rp) ->
 608       print_string arity;
 609       ident nm; print_string " "; mcode print_string_box lp;
 610       dots (function _ -> ()) expression args; close_box();
 611       mcode print_string rp; print_string " "
 612   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 613       print_string arity;
 614       mcode print_string switch; print_string " "; mcode print_string_box lp;
 615       expression exp; close_box(); mcode print_string rp; print_string " "
 616   | Ast.Break(br,sem) ->
 617       print_string arity; mcode print_string br; mcode print_string sem
 618   | Ast.Continue(cont,sem) ->
 619       print_string arity; mcode print_string cont; mcode print_string sem
 620   | Ast.Label(l,dd) -> ident l; mcode print_string dd
 621   | Ast.Goto(goto,l,sem) ->
 622       mcode print_string goto; ident l; mcode print_string sem
 623   | Ast.Return(ret,sem) ->
 624       print_string arity; mcode print_string ret; mcode print_string sem
 625   | Ast.ReturnExpr(ret,exp,sem) ->
 626       print_string arity; mcode print_string ret; print_string " ";
 627       expression exp; mcode print_string sem
 628   | Ast.MetaRuleElem(name,_,_) ->
 629       print_string arity; mcode print_meta name
 630   | Ast.MetaStmt(name,_,_,_) ->
 631       print_string arity; mcode print_meta name
 632   | Ast.MetaStmtList(name,_,_) ->
 633       print_string arity;  mcode print_meta name
 634   | Ast.Exp(exp) -> print_string arity; expression exp
 635   | Ast.TopExp(exp) -> print_string arity; expression exp
 636   | Ast.Ty(ty) -> print_string arity; fullType ty
 637   | Ast.TopInit(init) -> initialiser init
 638   | Ast.Include(inc,s) ->
 639       mcode print_string inc; print_string " "; mcode inc_file s
 640   | Ast.DefineHeader(def,id,params) ->
 641       mcode print_string def; print_string " "; ident id;
 642       print_define_parameters params
 643   | Ast.Default(def,colon) ->
 644       mcode print_string def; mcode print_string colon; print_string " "
 645   | Ast.Case(case,exp,colon) ->
 646       mcode print_string case; print_string " "; expression exp;
 647       mcode print_string colon; print_string " "
 648   | Ast.DisjRuleElem(res) ->
 649       print_string arity;
 650       force_newline(); print_string "("; force_newline();
 651       print_between
 652         (function _ -> force_newline();print_string "|"; force_newline())
 653         (rule_elem arity)
 654         res;
 655       force_newline(); print_string ")"
 656
 657
 658 and print_define_parameters params =
 659   match Ast.unwrap params with
 660     Ast.NoParams -> ()
 661   | Ast.DParams(lp,params,rp) ->
 662       mcode print_string lp;
 663       dots (function _ -> ()) print_define_param params; mcode print_string rp
 664
 665 and print_define_param param =
 666   match Ast.unwrap param with
 667     Ast.DParam(id) -> ident id
 668   | Ast.DPComma(comma) -> mcode print_string comma
 669   | Ast.DPdots(dots) -> mcode print_string dots
 670   | Ast.DPcircles(circles) -> mcode print_string circles
 671   | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp
 672   | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp
 673
 674 and statement arity s =
 675   match Ast.unwrap s with
 676     Ast.Seq(lbrace,body,rbrace) ->
 677       rule_elem arity lbrace;
 678       dots force_newline (statement arity) body;
 679       rule_elem arity rbrace
 680   | Ast.IfThen(header,branch,(_,_,_,aft)) ->
 681       rule_elem arity header; statement arity branch;
 682       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 683   | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
 684       rule_elem arity header; statement arity branch1; print_string " ";
 685       rule_elem arity els; statement arity branch2;
 686       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 687   | Ast.While(header,body,(_,_,_,aft)) ->
 688       rule_elem arity header; statement arity body;
 689       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 690   | Ast.Do(header,body,tail) ->
 691       rule_elem arity header; statement arity body;
 692       rule_elem arity tail
 693   | Ast.For(header,body,(_,_,_,aft)) ->
 694       rule_elem arity header; statement arity body;
 695       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 696   | Ast.Iterator(header,body,(_,_,_,aft)) ->
 697       rule_elem arity header; statement arity body;
 698       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 699   | Ast.Switch(header,lb,decls,cases,rb) ->
 700       rule_elem arity header; rule_elem arity lb;
 701       dots force_newline (statement arity) decls;
 702       List.iter (function x -> case_line arity x; force_newline()) cases;
 703       rule_elem arity rb
 704   | Ast.Atomic(re) -> rule_elem arity re
 705   | Ast.FunDecl(header,lbrace,body,rbrace) ->
 706       rule_elem arity header; rule_elem arity lbrace;
 707       dots force_newline (statement arity) body;
 708       rule_elem arity rbrace
 709   | Ast.Disj([stmt_dots]) ->
 710       print_string arity;
 711       dots (function _ -> if !print_newlines_disj then force_newline())
 712         (statement arity) stmt_dots
 713   | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
 714       print_string arity;
 715       force_newline(); print_string "("; force_newline();
 716       print_between
 717         (function _ -> force_newline();print_string "|"; force_newline())
 718         (dots force_newline (statement arity))
 719         stmt_dots_list;
 720       force_newline(); print_string ")"
 721   | Ast.Define(header,body) ->
 722       rule_elem arity header; print_string " ";
 723       dots force_newline (statement arity) body
 724   | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) ->
 725       print_string arity;
 726       nest_dots starter ender (statement arity)
 727         (function _ ->
 728           open_box 0;
 729           print_between force_newline
 730             (whencode (dots force_newline (statement "")) (statement "")) whn;
 731           close_box(); force_newline())
 732         stmt_dots
 733   | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
 734       print_string arity; mcode print_string d;
 735       open_box 0;
 736       print_between force_newline
 737         (whencode (dots force_newline (statement "")) (statement "")) whn;
 738       close_box(); force_newline()
 739   | Ast.OptStm(s) -> statement "?" s
 740   | Ast.UniqueStm(s) -> statement "!" s
 741
 742 and print_statement_when whencode =
 743   print_string "   WHEN != ";
 744   open_box 0;
 745   print_between (function _ -> print_string " &"; force_newline())
 746     (dots force_newline (statement "")) whencode;
 747   close_box()
 748
 749
 750 and whencode notfn alwaysfn = function
 751     Ast.WhenNot a ->
 752       print_string "   WHEN != "; open_box 0; notfn a; close_box()
 753   | Ast.WhenAlways a ->
 754       print_string "   WHEN = "; open_box 0; alwaysfn a; close_box()
 755   | Ast.WhenModifier x -> print_string "   WHEN "; print_when_modif x
 756   | Ast.WhenNotTrue a ->
 757       print_string "   WHEN != TRUE "; open_box 0; rule_elem "" a; close_box()
 758   | Ast.WhenNotFalse a ->
 759       print_string "   WHEN != FALSE "; open_box 0; rule_elem "" a; close_box()
 760
 761 and print_when_modif = function
 762   | Ast.WhenAny    -> print_string "ANY"
 763   | Ast.WhenStrict -> print_string "STRICT"
 764   | Ast.WhenForall -> print_string "FORALL"
 765   | Ast.WhenExists -> print_string "EXISTS"
 766
 767 and case_line arity c =
 768   match Ast.unwrap c with
 769     Ast.CaseLine(header,code) ->
 770       rule_elem arity header; print_string " ";
 771       dots force_newline (statement arity) code
 772   | Ast.OptCase(case) -> case_line "?" case
 773
 774 (* --------------------------------------------------------------------- *)
 775 (* CPP code *)
 776
 777 and inc_file = function
 778     Ast.Local(elems) ->
 779       print_string "\"";
 780       print_between (function _ -> print_string "/") inc_elem elems;
 781       print_string "\""
 782   | Ast.NonLocal(elems) ->
 783       print_string "<";
 784       print_between (function _ -> print_string "/") inc_elem elems;
 785       print_string ">"
 786
 787 and inc_elem = function
 788     Ast.IncPath s -> print_string s
 789   | Ast.IncDots -> print_string "..."
 790
 791 (* for export only *)
 792 let statement_dots l = dots force_newline (statement "") l
 793
 794 let top_level t =
 795   match Ast.unwrap t with
 796     Ast.FILEINFO(old_file,new_file) ->
 797       print_string "--- "; mcode print_string old_file; force_newline();
 798       print_string "+++ "; mcode print_string new_file
 799   | Ast.DECL(stmt) -> statement "" stmt
 800   | Ast.CODE(stmt_dots) ->
 801       dots force_newline (statement "") stmt_dots
 802   | Ast.ERRORWORDS(exps) ->
 803       print_string "error words = [";
 804       print_between (function _ -> print_string ", ") expression exps;
 805       print_string "]"
 806
 807 let rule =
 808   print_between (function _ -> force_newline(); force_newline()) top_level
 809
 810 let pp_print_anything x = !anything x
 811
 812 let _ =
 813   anything := function
 814       Ast.FullTypeTag(x) -> fullType x
 815     | Ast.BaseTypeTag(x) -> baseType x
 816     | Ast.StructUnionTag(x) -> structUnion x
 817     | Ast.SignTag(x) -> sign x
 818     | Ast.IdentTag(x) -> ident x
 819     | Ast.ExpressionTag(x) -> expression x
 820     | Ast.ConstantTag(x) -> constant x
 821     | Ast.UnaryOpTag(x) -> unaryOp x
 822     | Ast.AssignOpTag(x) -> assignOp x
 823     | Ast.FixOpTag(x) -> fixOp x
 824     | Ast.BinaryOpTag(x) -> binaryOp x
 825     | Ast.ArithOpTag(x) -> arithOp x
 826     | Ast.LogicalOpTag(x) -> logicalOp x
 827     | Ast.InitTag(x) -> initialiser x
 828     | Ast.DeclarationTag(x) -> declaration x
 829     | Ast.StorageTag(x) -> storage x
 830     | Ast.IncFileTag(x) -> inc_file x
 831     | Ast.Rule_elemTag(x) -> rule_elem "" x
 832     | Ast.StatementTag(x) -> statement "" x
 833     | Ast.CaseLineTag(x) -> case_line "" x
 834     | Ast.ConstVolTag(x) -> const_vol x
 835     | Ast.Token(x,Some info) -> print_string_befaft print_string x info
 836     | Ast.Token(x,None) -> print_string x
 837     | Ast.Pragma(xs) ->
 838         let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
 839         print_between force_newline print xs
 840     | Ast.Code(x) -> let _ = top_level x in ()
 841     | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x
 842     | Ast.ParamDotsTag(x) -> parameter_list x
 843     | Ast.StmtDotsTag(x) -> dots (function _ -> ()) (statement "") x
 844     | Ast.DeclDotsTag(x) -> dots (function _ -> ()) declaration x
 845     | Ast.TypeCTag(x) -> typeC x
 846     | Ast.ParamTag(x) -> parameterTypeDef x
 847     | Ast.SgrepStartTag(x) -> print_string x
 848     | Ast.SgrepEndTag(x) -> print_string x
 849
 850 let rec dep in_and = function
 851     Ast.Dep(s) -> print_string s
 852   | Ast.AntiDep(s) -> print_string "!"; print_string s
 853   | Ast.EverDep(s) -> print_string "ever "; print_string s
 854   | Ast.NeverDep(s) -> print_string "never "; print_string s
 855   | Ast.AndDep(s1,s2) ->
 856       let print_and _ = dep true s1; print_string " && "; dep true s2 in
 857       if in_and
 858       then print_and ()
 859       else (print_string "("; print_and(); print_string ")")
 860   | Ast.OrDep(s1,s2) ->
 861       let print_or _ = dep false s1; print_string " || "; dep false s2 in
 862       if not in_and
 863       then print_or ()
 864       else (print_string "("; print_or(); print_string ")")
 865   | Ast.NoDep   -> print_string "no_dep"
 866   | Ast.FailDep -> print_string "fail_dep"
 867
 868 let script_header str lang deps code =
 869   print_string "@@";
 870   force_newline();
 871   print_string (str ^ ":" ^ lang);
 872   (match deps with
 873     Ast.NoDep -> ()
 874   | _ -> print_string " depends on "; dep true deps);
 875   force_newline();
 876   print_string "@@";
 877   force_newline();
 878   print_string code;
 879   force_newline()
 880
 881 let unparse z =
 882   match z with
 883     Ast.InitialScriptRule (name,lang,deps,code) ->
 884       script_header "initialize" lang deps code
 885   | Ast.FinalScriptRule (name,lang,deps,code) ->
 886       script_header "finalize" lang deps code
 887   | Ast.ScriptRule (name,lang,deps,bindings,script_vars,code) ->
 888       script_header "script" lang deps code
 889   | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) ->
 890       print_string "@@";
 891       force_newline();
 892       print_string nm;
 893       (match deps with
 894         Ast.NoDep -> ()
 895       | _ -> print_string " depends on "; dep true deps);
 896     (*
 897     print_string "line ";
 898     print_int (Ast.get_line (List.hd x));
 899     *)
 900       force_newline();
 901       print_string "@@";
 902       print_newlines_disj := true;
 903       force_newline();
 904       force_newline();
 905       rule x;
 906       force_newline()
 907
 908 let rule_elem_to_string x =
 909   print_newlines_disj := true;
 910   Common.format_to_string (function _ -> rule_elem "" x)
 911
 912 let ident_to_string x =
 913   print_newlines_disj := true;
 914   Common.format_to_string (function _ -> ident x)
 915
 916 let unparse_to_string x =
 917   print_newlines_disj := true;
 918   Common.format_to_string (function _ -> unparse x)
 919
 920 let print_rule_elem re =
 921   let nl = !print_newlines_disj in
 922   print_newlines_disj := false;
 923   rule_elem "" re;
 924   print_newlines_disj := nl
 925