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