parsing_c/unparse_cocci2.ml

   1 open Common
   2
   3 (*****************************************************************************)
   4 (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml
   5  * todo?: try to factorize ?
   6  *)
   7 (*****************************************************************************)
   8
   9 module Ast = Ast_cocci
  10
  11 let term s = Ast.unwrap_mcode s
  12
  13 (* or perhaps can have in plus, for instance a Disj, but those Disj must be
  14  *  handled by interactive tool (by proposing alternatives)
  15  *)
  16 exception CantBeInPlus
  17
  18 (*****************************************************************************)
  19
  20 type pos = Before | After | InPlace
  21
  22 let rec pp_list_list_any (env, pr, pr_elem, pr_space, indent, unindent)
  23     xxs before =
  24
  25 (* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
  26 let print_string = pr in
  27 let close_box _ = () in
  28 let print_space() = pr " "  in
  29 let force_newline () = pr "\n" in
  30
  31 let start_block () = force_newline(); indent() in
  32 let end_block () = unindent(); force_newline () in
  33 let print_string_box s = print_string s in
  34
  35 let print_option = Common.do_option in
  36 let print_between = Common.print_between in
  37
  38 (* --------------------------------------------------------------------- *)
  39
  40 let handle_metavar name fn =
  41   match (Common.optionise (fun () -> List.assoc (term name) env)) with
  42   | None ->
  43       let name_string (_,s) = s in
  44       failwith (Printf.sprintf "SP line %d: Not found a value in env for: %s"
  45                   (Ast_cocci.get_mcode_line name) (name_string (term name)))
  46   | Some e  -> fn e
  47 in
  48
  49 (* --------------------------------------------------------------------- *)
  50 (* Here we don't care about the annotation on s. *)
  51 let mcode fn (s,info,_,_) =
  52   List.iter (function str -> print_string str; print_string "\n")
  53     info.Ast.strbef;
  54   if info.Ast.column > 0 && not(info.Ast.strbef = [])
  55   then print_string (String.make info.Ast.column ' ');
  56   fn s;
  57   match info.Ast.straft with
  58     [] -> ()
  59   | aft ->
  60       List.iter (function str -> print_string "\n"; print_string str) aft;
  61       print_string "\n"; (*XXX pr current_tabbing *)
  62 in
  63
  64 (* --------------------------------------------------------------------- *)
  65 let dots between fn d =
  66   match Ast.unwrap d with
  67     Ast.DOTS(l) -> print_between between fn l
  68   | Ast.CIRCLES(l) -> print_between between fn l
  69   | Ast.STARS(l) -> print_between between fn l
  70 in
  71
  72
  73 (* --------------------------------------------------------------------- *)
  74 (* Identifier *)
  75
  76 let rec ident i =
  77   match Ast.unwrap i with
  78     Ast.Id(name) -> mcode print_string name
  79   | Ast.MetaId(name,_,_,_) ->
  80       handle_metavar name (function
  81         | (Ast_c.MetaIdVal id) -> pr id
  82         | _ -> raise Impossible
  83         )
  84   | Ast.MetaFunc(name,_,_,_) ->
  85       handle_metavar name (function
  86         | (Ast_c.MetaFuncVal id) -> pr id
  87         | _ -> raise Impossible
  88         )
  89   | Ast.MetaLocalFunc(name,_,_,_) ->
  90       handle_metavar name (function
  91         | (Ast_c.MetaLocalFuncVal id) -> pr id
  92         | _ -> raise Impossible
  93         )
  94
  95   | Ast.OptIdent(_) | Ast.UniqueIdent(_) ->
  96       raise CantBeInPlus
  97
  98 in
  99
 100 (* --------------------------------------------------------------------- *)
 101 (* Expression *)
 102
 103 let rec expression e =
 104   match Ast.unwrap e with
 105     Ast.Ident(id) -> ident id
 106
 107   | Ast.Constant(const) -> mcode constant const
 108   | Ast.FunCall(fn,lp,args,rp) ->
 109       expression fn; mcode print_string_box lp;
 110       dots (function _ -> ()) expression args;
 111       close_box(); mcode print_string rp
 112   | Ast.Assignment(left,op,right,_) ->
 113       expression left; print_string " "; mcode assignOp op;
 114       print_string " "; expression right
 115   | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
 116       expression exp1; print_string " "; mcode print_string why;
 117       print_option (function e -> print_string " "; expression e) exp2;
 118       print_string " "; mcode print_string colon; expression exp3
 119   | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
 120   | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
 121   | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
 122   | Ast.Binary(left,op,right) ->
 123       expression left; print_string " "; mcode binaryOp op; print_string " ";
 124       expression right
 125   | Ast.Nested(left,op,right) -> failwith "nested only in minus code"
 126   | Ast.Paren(lp,exp,rp) ->
 127       mcode print_string_box lp; expression exp; close_box();
 128       mcode print_string rp
 129   | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
 130       expression exp1; mcode print_string_box lb; expression exp2; close_box();
 131       mcode print_string rb
 132   | Ast.RecordAccess(exp,pt,field) ->
 133       expression exp; mcode print_string pt; ident field
 134   | Ast.RecordPtAccess(exp,ar,field) ->
 135       expression exp; mcode print_string ar; ident field
 136   | Ast.Cast(lp,ty,rp,exp) ->
 137       mcode print_string_box lp; fullType ty; close_box();
 138       mcode print_string rp; expression exp
 139   | Ast.SizeOfExpr(sizeof,exp) ->
 140       mcode print_string sizeof; expression exp
 141   | Ast.SizeOfType(sizeof,lp,ty,rp) ->
 142       mcode print_string sizeof;
 143       mcode print_string_box lp; fullType ty; close_box();
 144       mcode print_string rp
 145   | Ast.TypeExp(ty) -> fullType ty
 146
 147   | Ast.MetaErr(name,_,_,_) ->
 148       failwith "metaErr not handled"
 149
 150   | Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) ->
 151       handle_metavar name  (function
 152         | Ast_c.MetaExprVal exp ->
 153             Pretty_print_c.pp_expression_gen pr_elem pr_space  exp
 154         | _ -> raise Impossible
 155       )
 156
 157   | Ast.MetaExprList (name,_,_,_) ->
 158       failwith "not handling MetaExprList"
 159
 160   | Ast.EComma(cm) -> mcode print_string cm; print_space()
 161
 162   | Ast.DisjExpr _
 163   | Ast.NestExpr(_)
 164   | Ast.Edots(_)
 165   | Ast.Ecircles(_)
 166   | Ast.Estars(_)
 167     -> raise CantBeInPlus
 168
 169   | Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
 170       raise CantBeInPlus
 171
 172 and  unaryOp = function
 173     Ast.GetRef -> print_string "&"
 174   | Ast.DeRef -> print_string "*"
 175   | Ast.UnPlus -> print_string "+"
 176   | Ast.UnMinus -> print_string "-"
 177   | Ast.Tilde -> print_string "~"
 178   | Ast.Not -> print_string "!"
 179
 180 and  assignOp = function
 181     Ast.SimpleAssign -> print_string "="
 182   | Ast.OpAssign(aop) -> arithOp aop; print_string "="
 183
 184 and  fixOp = function
 185     Ast.Dec -> print_string "--"
 186   | Ast.Inc -> print_string "++"
 187
 188 and  binaryOp = function
 189     Ast.Arith(aop) -> arithOp aop
 190   | Ast.Logical(lop) -> logicalOp lop
 191
 192 and  arithOp = function
 193     Ast.Plus -> print_string "+"
 194   | Ast.Minus -> print_string "-"
 195   | Ast.Mul -> print_string "*"
 196   | Ast.Div -> print_string "/"
 197   | Ast.Mod -> print_string "%"
 198   | Ast.DecLeft -> print_string "<<"
 199   | Ast.DecRight -> print_string ">>"
 200   | Ast.And -> print_string "&"
 201   | Ast.Or -> print_string "|"
 202   | Ast.Xor -> print_string "^"
 203
 204 and  logicalOp = function
 205     Ast.Inf -> print_string "<"
 206   | Ast.Sup -> print_string ">"
 207   | Ast.InfEq -> print_string "<="
 208   | Ast.SupEq -> print_string ">="
 209   | Ast.Eq -> print_string "=="
 210   | Ast.NotEq -> print_string "!="
 211   | Ast.AndLog -> print_string "&&"
 212   | Ast.OrLog -> print_string "||"
 213
 214 and constant = function
 215     Ast.String(s) -> print_string "\""; print_string s; print_string "\""
 216   | Ast.Char(s) -> print_string s
 217   | Ast.Int(s) -> print_string s
 218   | Ast.Float(s) -> print_string s
 219
 220 (* --------------------------------------------------------------------- *)
 221 (* Types *)
 222
 223
 224 and fullType ft =
 225   match Ast.unwrap ft with
 226     Ast.Type(cv,ty) ->
 227       print_option (function x -> mcode const_vol x; print_string " ") cv;
 228       typeC ty
 229   | Ast.DisjType _ -> failwith "can't be in plus"
 230   | Ast.OptType(_) | Ast.UniqueType(_) ->
 231       raise CantBeInPlus
 232
 233 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
 234   fullType ty; mcode print_string lp1; mcode print_string star; fn();
 235   mcode print_string rp1; mcode print_string lp1;
 236   parameter_list params; mcode print_string rp2
 237
 238 and print_function_type (ty,lp1,params,rp1) fn =
 239   print_option fullType ty; fn(); mcode print_string lp1;
 240   parameter_list params; mcode print_string rp1
 241
 242 and typeC ty =
 243   match Ast.unwrap ty with
 244     Ast.BaseType(ty,sgn) -> print_option (mcode sign) sgn; mcode baseType ty
 245   | Ast.ImplicitInt(sgn) -> mcode signns sgn
 246   | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star
 247   | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 248       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 249         (function _ -> ())
 250   | Ast.FunctionType (am,ty,lp1,params,rp1) ->
 251       print_function_type (ty,lp1,params,rp1) (function _ -> ())
 252   | Ast.Array(ty,lb,size,rb) ->
 253       fullType ty; mcode print_string lb; print_option expression size;
 254       mcode print_string rb
 255   | Ast.StructUnionName(kind,name) ->
 256       mcode structUnion kind;
 257       print_option ident name
 258   | Ast.StructUnionDef(ty,lb,decls,rb) ->
 259       fullType ty;
 260       mcode print_string lb;
 261       dots force_newline declaration decls;
 262       mcode print_string rb
 263   | Ast.TypeName(name)-> mcode print_string name
 264   | Ast.MetaType(name,_,_) ->
 265       handle_metavar name  (function
 266           Ast_c.MetaTypeVal exp ->
 267             Pretty_print_c.pp_type_gen pr_elem pr_space exp
 268         | _ -> raise Impossible)
 269
 270 and baseType = function
 271     Ast.VoidType -> print_string "void"
 272   | Ast.CharType -> print_string "char"
 273   | Ast.ShortType -> print_string "short"
 274   | Ast.IntType -> print_string "int"
 275   | Ast.DoubleType -> print_string "double"
 276   | Ast.FloatType -> print_string "float"
 277   | Ast.LongType -> print_string "long"
 278
 279 and structUnion = function
 280     Ast.Struct -> print_string "struct "
 281   | Ast.Union -> print_string "union "
 282
 283 and sign = function
 284     Ast.Signed -> print_string "signed "
 285   | Ast.Unsigned -> print_string "unsigned "
 286
 287 and signns = function (* no space, like a normal type *)
 288     Ast.Signed -> print_string "signed"
 289   | Ast.Unsigned -> print_string "unsigned"
 290
 291
 292 and const_vol = function
 293     Ast.Const -> print_string "const "
 294   | Ast.Volatile -> print_string "volatile "
 295
 296 (* --------------------------------------------------------------------- *)
 297 (* Function declaration *)
 298
 299 and storage = function
 300     Ast.Static -> print_string "static "
 301   | Ast.Auto -> print_string "auto "
 302   | Ast.Register -> print_string "register "
 303   | Ast.Extern -> print_string "extern "
 304
 305 (* --------------------------------------------------------------------- *)
 306 (* Variable declaration *)
 307
 308 and print_named_type ty id =
 309   match Ast.unwrap ty with
 310     Ast.Type(None,ty1) ->
 311       (match Ast.unwrap ty1 with
 312         Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 313           print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 314             (function _ -> print_string " "; ident id)
 315       | Ast.FunctionType(am,ty,lp1,params,rp1) ->
 316           print_function_type (ty,lp1,params,rp1)
 317             (function _ -> print_string " "; ident id)
 318       | Ast.Array(_,_,_,_) ->
 319           let rec loop ty k =
 320             match Ast.unwrap ty with
 321               Ast.Array(ty,lb,size,rb) ->
 322                 (match Ast.unwrap ty with
 323                   Ast.Type(None,ty) ->
 324                     loop ty
 325                       (function _ ->
 326                         k ();
 327                         mcode print_string lb;
 328                         print_option expression size;
 329                         mcode print_string rb)
 330                 | _ -> failwith "complex array types not supported")
 331             | _ -> typeC ty; ty_space ty; ident id; k () in
 332           loop ty1 (function _ -> ())
 333     (*| should have a case here for pointer to array or function type
 334         that would put ( * ) around the variable.  This makes one wonder
 335         why we really need a special case for function pointer *)
 336       | _ -> fullType ty; ft_space ty; ident id)
 337   | _ -> fullType ty; ft_space ty; ident id
 338
 339 and ty_space ty =
 340   match Ast.unwrap ty with
 341     Ast.Pointer(_,_) -> ()
 342   | _ -> print_space()
 343
 344 and ft_space ty =
 345   match Ast.unwrap ty with
 346     Ast.Type(cv,ty) ->
 347       (match Ast.unwrap ty with
 348         Ast.Pointer(_,_) -> ()
 349       | _ -> print_space())
 350   | _ -> print_space()
 351
 352 and declaration d =
 353   match Ast.unwrap d with
 354     Ast.Init(stg,ty,id,eq,ini,sem) ->
 355       print_option (mcode storage) stg;
 356       print_named_type ty id;
 357       print_string " "; mcode print_string eq;
 358       print_string " "; initialiser true ini; mcode print_string sem
 359   | Ast.UnInit(stg,ty,id,sem) ->
 360       print_option (mcode storage) stg;
 361       print_named_type ty id;
 362       mcode print_string sem
 363   | Ast.MacroDecl(name,lp,args,rp,sem) ->
 364       ident name; mcode print_string_box lp;
 365       dots (function _ -> ()) expression args;
 366       close_box(); mcode print_string rp; mcode print_string sem
 367   | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
 368   | Ast.Typedef(stg,ty,id,sem) ->
 369       mcode print_string stg;
 370       fullType ty; typeC id;
 371       mcode print_string sem
 372   | Ast.DisjDecl(_) | Ast.MetaDecl(_,_,_) -> raise CantBeInPlus
 373   | Ast.Ddots(_,_) -> raise CantBeInPlus
 374   | Ast.OptDecl(decl)  | Ast.UniqueDecl(decl) ->
 375       raise CantBeInPlus
 376
 377 (* --------------------------------------------------------------------- *)
 378 (* Initialiser *)
 379
 380 and initialiser nlcomma i =
 381   match Ast.unwrap i with
 382     Ast.InitExpr(exp) -> expression exp
 383   | Ast.InitList(lb,initlist,rb,[]) ->
 384       mcode print_string lb; start_block();
 385       (* awkward, because the comma is separate from the initialiser *)
 386       let rec loop = function
 387           [] -> ()
 388         | [x] -> initialiser false x
 389         | x::xs -> initialiser nlcomma x; loop xs in
 390       loop initlist;
 391       end_block(); mcode print_string rb
 392   | Ast.InitList(lb,initlist,rb,_) -> failwith "unexpected whencode in plus"
 393   | Ast.InitGccDotName(dot,name,eq,ini) ->
 394       mcode print_string dot; ident name; print_string " ";
 395       mcode print_string eq; print_string " "; initialiser nlcomma ini
 396   | Ast.InitGccName(name,eq,ini) ->
 397       ident name; mcode print_string eq; initialiser nlcomma ini
 398   | Ast.InitGccIndex(lb,exp,rb,eq,ini) ->
 399       mcode print_string lb; expression exp; mcode print_string rb;
 400       print_string " "; mcode print_string eq; print_string " ";
 401       initialiser nlcomma ini
 402   | Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
 403       mcode print_string lb; expression exp1; mcode print_string dots;
 404       expression exp2; mcode print_string rb;
 405       print_string " "; mcode print_string eq; print_string " ";
 406       initialiser nlcomma ini
 407   | Ast.IComma(comma) ->
 408       mcode print_string comma;
 409       if nlcomma then force_newline()
 410   | Ast.OptIni(ini) | Ast.UniqueIni(ini) ->
 411       raise CantBeInPlus
 412
 413 (* --------------------------------------------------------------------- *)
 414 (* Parameter *)
 415
 416 and parameterTypeDef p =
 417   match Ast.unwrap p with
 418     Ast.VoidParam(ty) -> fullType ty
 419   | Ast.Param(ty,Some id) -> print_named_type ty id
 420   | Ast.Param(ty,None) -> fullType ty
 421
 422   | Ast.MetaParam(name,_,_) ->
 423       failwith "not handling MetaParam"
 424   | Ast.MetaParamList(name,_,_,_) ->
 425       failwith "not handling MetaParamList"
 426
 427   | Ast.PComma(cm) -> mcode print_string cm; print_space()
 428   | Ast.Pdots(dots)
 429   | Ast.Pcircles(dots)
 430     ->  raise CantBeInPlus
 431   | Ast.OptParam(param) | Ast.UniqueParam(param) -> raise CantBeInPlus
 432
 433 and parameter_list l = dots (function _ -> ()) parameterTypeDef l
 434 in
 435
 436
 437 (* --------------------------------------------------------------------- *)
 438 (* CPP code *)
 439
 440 let rec inc_file = function
 441     Ast.Local(elems) ->
 442       print_string "\"";
 443       print_between (function _ -> print_string "/") inc_elem elems;
 444       print_string "\""
 445   | Ast.NonLocal(elems) ->
 446       print_string "<";
 447       print_between (function _ -> print_string "/") inc_elem elems;
 448       print_string ">"
 449
 450 and inc_elem = function
 451     Ast.IncPath s -> print_string s
 452   | Ast.IncDots -> print_string "..."
 453
 454 (* --------------------------------------------------------------------- *)
 455 (* Top-level code *)
 456
 457 and rule_elem arity re =
 458   match Ast.unwrap re with
 459     Ast.FunHeader(_,_,fninfo,name,lp,params,rp) ->
 460       print_string arity; List.iter print_fninfo fninfo;
 461       ident name; mcode print_string_box lp;
 462       parameter_list params; close_box(); mcode print_string rp;
 463       print_string " "
 464   | Ast.Decl(_,_,decl) -> print_string arity; declaration decl
 465
 466   | Ast.SeqStart(brace) ->
 467       print_string arity; mcode print_string brace; start_block()
 468   | Ast.SeqEnd(brace) ->
 469       end_block(); print_string arity; mcode print_string brace
 470
 471   | Ast.ExprStatement(exp,sem) ->
 472       print_string arity; expression exp; mcode print_string sem
 473
 474   | Ast.IfHeader(iff,lp,exp,rp) ->
 475       print_string arity;
 476       mcode print_string iff; print_string " "; mcode print_string_box lp;
 477       expression exp; close_box(); mcode print_string rp; print_string " "
 478   | Ast.Else(els) ->
 479       print_string arity; mcode print_string els; print_string " "
 480
 481   | Ast.WhileHeader(whl,lp,exp,rp) ->
 482       print_string arity;
 483       mcode print_string whl; print_string " "; mcode print_string_box lp;
 484       expression exp; close_box(); mcode print_string rp; print_string " "
 485   | Ast.DoHeader(d) ->
 486       print_string arity; mcode print_string d; print_string " "
 487   | Ast.WhileTail(whl,lp,exp,rp,sem) ->
 488       print_string arity;
 489       mcode print_string whl; print_string " "; mcode print_string_box lp;
 490       expression exp; close_box(); mcode print_string rp;
 491       mcode print_string sem
 492   | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
 493       print_string arity;
 494       mcode print_string fr; mcode print_string_box lp;
 495       print_option expression e1; mcode print_string sem1;
 496       print_option expression e2; mcode print_string sem2;
 497       print_option expression e3; close_box();
 498       mcode print_string rp; print_string " "
 499   | Ast.IteratorHeader(nm,lp,args,rp) ->
 500       print_string arity;
 501       ident nm; print_string " "; mcode print_string_box lp;
 502       dots (function _ -> ()) expression args; close_box();
 503       mcode print_string rp; print_string " "
 504
 505   | Ast.SwitchHeader(switch,lp,exp,rp) ->
 506       print_string arity;
 507       mcode print_string switch; print_string " "; mcode print_string_box lp;
 508       expression exp; close_box(); mcode print_string rp; print_string " "
 509
 510   | Ast.Break(br,sem) ->
 511       print_string arity; mcode print_string br; mcode print_string sem
 512   | Ast.Continue(cont,sem) ->
 513       print_string arity; mcode print_string cont; mcode print_string sem
 514   | Ast.Label(l,dd) -> ident l; mcode print_string dd
 515   | Ast.Goto(goto,l,sem) ->
 516       mcode print_string goto; ident l; mcode print_string sem
 517   | Ast.Return(ret,sem) ->
 518       print_string arity; mcode print_string ret;
 519       mcode print_string sem
 520   | Ast.ReturnExpr(ret,exp,sem) ->
 521       print_string arity; mcode print_string ret; print_string " ";
 522       expression exp; mcode print_string sem
 523
 524   | Ast.Exp(exp) -> print_string arity; expression exp
 525   | Ast.TopExp(exp) -> print_string arity; expression exp
 526   | Ast.Ty(ty) -> print_string arity; fullType ty
 527   | Ast.Include(inc,s) ->
 528       mcode print_string inc; print_string " "; mcode inc_file s
 529   | Ast.DefineHeader(def,id,params) ->
 530       mcode print_string def; print_string " "; ident id;
 531       print_define_parameters params
 532   | Ast.Default(def,colon) ->
 533       mcode print_string def; mcode print_string colon; print_string " "
 534   | Ast.Case(case,exp,colon) ->
 535       mcode print_string case; print_string " "; expression exp;
 536       mcode print_string colon; print_string " "
 537   | Ast.DisjRuleElem(res) -> raise CantBeInPlus
 538
 539   | Ast.MetaRuleElem(name,_,_) ->
 540       raise Impossible
 541
 542   | Ast.MetaStmt(name,_,_,_) ->
 543       handle_metavar name  (function
 544         | Ast_c.MetaStmtVal exp ->
 545             Pretty_print_c.pp_statement_gen pr_elem pr_space  exp
 546         | _ -> raise Impossible
 547                            )
 548   | Ast.MetaStmtList(name,_,_) ->
 549       failwith
 550         "MetaStmtList not supported (not even in ast_c metavars binding)"
 551
 552 and print_define_parameters params =
 553   match Ast.unwrap params with
 554     Ast.NoParams -> ()
 555   | Ast.DParams(lp,params,rp) ->
 556       mcode print_string lp;
 557       dots (function _ -> ()) print_define_param params; mcode print_string rp
 558
 559 and print_define_param param =
 560   match Ast.unwrap param with
 561     Ast.DParam(id) -> ident id
 562   | Ast.DPComma(comma) -> mcode print_string comma
 563   | Ast.DPdots(dots) -> mcode print_string dots
 564   | Ast.DPcircles(circles) -> mcode print_string circles
 565   | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp
 566   | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp
 567
 568 and print_fninfo = function
 569     Ast.FStorage(stg) -> mcode storage stg
 570   | Ast.FType(ty) -> fullType ty
 571   | Ast.FInline(inline) -> mcode print_string inline; print_string " "
 572   | Ast.FAttr(attr) -> mcode print_string attr; print_string " " in
 573
 574 let rec statement arity s =
 575   match Ast.unwrap s with
 576     Ast.Seq(lbrace,decls,body,rbrace) ->
 577       rule_elem arity lbrace;
 578       dots force_newline (statement arity) decls;
 579       dots force_newline (statement arity) body;
 580       rule_elem arity rbrace
 581
 582   | Ast.IfThen(header,branch,_) ->
 583       rule_elem arity header; statement arity branch
 584   | Ast.IfThenElse(header,branch1,els,branch2,_) ->
 585       rule_elem arity header; statement arity branch1; print_string " ";
 586       rule_elem arity els; statement arity branch2
 587
 588   | Ast.While(header,body,_) ->
 589       rule_elem arity header; statement arity body
 590   | Ast.Do(header,body,tail) ->
 591       rule_elem arity header; statement arity body;
 592       rule_elem arity tail
 593   | Ast.For(header,body,_) ->
 594       rule_elem arity header; statement arity body
 595   | Ast.Iterator(header,body,(_,_,_,aft)) ->
 596       rule_elem arity header; statement arity body;
 597       mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
 598
 599   | Ast.Switch(header,lb,cases,rb) ->
 600       rule_elem arity header; rule_elem arity lb;
 601       List.iter (function x -> case_line arity x; force_newline()) cases;
 602       rule_elem arity rb
 603
 604   | Ast.Atomic(re) -> rule_elem arity re
 605
 606   | Ast.FunDecl(header,lbrace,decls,body,rbrace) ->
 607       rule_elem arity header; rule_elem arity lbrace;
 608       dots force_newline (statement arity) decls;
 609       dots force_newline (statement arity) body; rule_elem arity rbrace
 610
 611   | Ast.Define(header,body) ->
 612       rule_elem arity header; print_string " ";
 613       dots force_newline (statement arity) body
 614
 615   | Ast.Disj(_)| Ast.Nest(_)
 616   | Ast.Dots(_) | Ast.Circles(_) | Ast.Stars(_) ->
 617       raise CantBeInPlus
 618
 619   | Ast.OptStm(s) | Ast.UniqueStm(s) ->
 620       raise CantBeInPlus
 621
 622 and case_line arity c =
 623   match Ast.unwrap c with
 624     Ast.CaseLine(header,code) ->
 625       rule_elem arity header; print_string " ";
 626       dots force_newline (statement arity) code
 627   | Ast.OptCase(case) -> raise CantBeInPlus in
 628
 629 let top_level t =
 630   match Ast.unwrap t with
 631     Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus
 632   | Ast.DECL(stmt) -> statement "" stmt
 633   | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots
 634   | Ast.ERRORWORDS(exps) -> raise CantBeInPlus
 635 in
 636
 637 (*
 638 let rule =
 639   print_between (function _ -> force_newline(); force_newline()) top_level
 640 in
 641 *)
 642
 643 let if_open_brace  = function "{" -> true | _ -> false in
 644
 645 let rec pp_any = function
 646   (* assert: normally there is only CONTEXT NOTHING tokens in any *)
 647     Ast.FullTypeTag(x) -> fullType x; false
 648   | Ast.BaseTypeTag(x) -> baseType x; false
 649   | Ast.StructUnionTag(x) -> structUnion x; false
 650   | Ast.SignTag(x) -> sign x; false
 651
 652   | Ast.IdentTag(x) -> ident x; false
 653
 654   | Ast.ExpressionTag(x) -> expression x; false
 655
 656   | Ast.ConstantTag(x) -> constant x; false
 657   | Ast.UnaryOpTag(x) -> unaryOp x; false
 658   | Ast.AssignOpTag(x) -> assignOp x; false
 659   | Ast.FixOpTag(x) -> fixOp x; false
 660   | Ast.BinaryOpTag(x) -> binaryOp x; false
 661   | Ast.ArithOpTag(x) -> arithOp x; false
 662   | Ast.LogicalOpTag(x) -> logicalOp x; false
 663
 664   | Ast.InitTag(x) -> initialiser false x; false
 665   | Ast.DeclarationTag(x) -> declaration x; false
 666
 667   | Ast.StorageTag(x) -> storage x; false
 668   | Ast.IncFileTag(x) -> inc_file x; false
 669
 670   | Ast.Rule_elemTag(x) -> rule_elem "" x; false
 671   | Ast.StatementTag(x) -> statement "" x; false
 672   | Ast.CaseLineTag(x) -> case_line "" x; false
 673
 674   | Ast.ConstVolTag(x) -> const_vol x; false
 675   | Ast.Token(x,None) -> print_string x; if_open_brace x
 676   | Ast.Token(x,Some info) ->
 677       mcode
 678         (function x ->
 679           (match x with
 680             "else" -> pr "\n"
 681           | _ -> ());
 682           print_string x;
 683           (* if x ==~ Common.regexp_alpha then print_string " "; *)
 684           (match x with
 685             (*"return" |*) "else" -> print_string " "
 686           | _ -> ()))
 687         (x,info,(),Ast.NoMetaPos);
 688       if_open_brace x
 689
 690   | Ast.Code(x) -> let _ = top_level x in false
 691
 692   (* this is not '...', but a list of expr/statement/params, and
 693      normally there should be no '...' inside them *)
 694   | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false
 695   | Ast.ParamDotsTag(x) -> parameter_list x; false
 696   | Ast.StmtDotsTag(x) -> dots (function _ -> pr "\n") (statement "") x; false
 697   | Ast.DeclDotsTag(x) -> dots (function _ -> pr "\n") declaration x; false
 698
 699   | Ast.TypeCTag(x) -> typeC x; false
 700   | Ast.ParamTag(x) -> parameterTypeDef x; false
 701   | Ast.SgrepStartTag(x) -> failwith "unexpected start tag"
 702   | Ast.SgrepEndTag(x) -> failwith "unexpected end tag"
 703 in
 704
 705   (* todo? imitate what is in pretty_print_cocci ? *)
 706   match xxs with
 707     [] -> ()
 708   | x::xs ->
 709       (* for many tags, we must not do a newline before the first '+' *)
 710       let isfn s =
 711         match Ast.unwrap s with Ast.FunDecl _ -> true | _ -> false in
 712       let unindent_before = function
 713         (* need to get unindent before newline for } *)
 714           (Ast.Token ("}",_)::_) -> true
 715         | _ -> false in
 716       let prnl x =
 717         (if unindent_before x then unindent());
 718         pr "\n" in
 719       let newline_before _ =
 720         if before = After
 721         then
 722           let hd = List.hd xxs in
 723           match hd with
 724             (Ast.StatementTag s::_) when isfn s -> pr "\n\n"
 725           | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
 726           | (Ast.InitTag _::_)
 727           | (Ast.DeclarationTag _::_) | (Ast.Token ("}",_)::_) -> prnl hd
 728           | _ -> () in
 729       let newline_after _ =
 730         if before = Before
 731         then
 732           match List.rev(List.hd(List.rev xxs)) with
 733             (Ast.StatementTag s::_) when isfn s -> pr "\n\n"
 734           | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_)
 735           | (Ast.InitTag _::_)
 736           | (Ast.DeclarationTag _::_) | (Ast.Token ("{",_)::_) -> pr "\n"
 737           | _ -> () in
 738       (* print a newline at the beginning, if needed *)
 739       newline_before();
 740       (* print a newline before each of the rest *)
 741       let rec loop leading_newline indent_needed = function
 742           [] -> ()
 743         | x::xs ->
 744             (if leading_newline
 745             then
 746               match (indent_needed,unindent_before x) with
 747                 (true,true) -> pr "\n"
 748               | (true,false) -> pr "\n"; indent()
 749               | (false,true) -> unindent(); pr "\n"
 750               | (false,false) -> pr "\n");
 751             let indent_needed =
 752               List.fold_left (function indent_needed -> pp_any) false x in
 753             loop true indent_needed xs in
 754       loop false false (x::xs);
 755       (* print a newline at the end, if needed *)
 756       newline_after()
 757