parsing_cocci/.#pretty_print_cocci.ml.1.134

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