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