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