parsing_cocci/unparse_ast0.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./unparse_ast0.ml"
  28 open Format
  29 module Ast = Ast_cocci
  30 module Ast0 = Ast0_cocci
  31 module U = Pretty_print_cocci
  32
  33 let quiet = ref true (* true = no decoration on - context, etc *)
  34
  35 let full_ids = ref false (* true = print rule name as well *)
  36
  37 let start_block str =
  38   force_newline(); print_string "  "; open_box 0
  39
  40 let end_block str =
  41   close_box(); force_newline ()
  42
  43 let print_option = Common.do_option
  44 let print_between = Common.print_between
  45
  46 (* --------------------------------------------------------------------- *)
  47 (* Positions *)
  48
  49 let rec meta_pos l =
  50   List.iter
  51     (function var ->
  52       let current_name = Ast0.meta_pos_name var in
  53       let (_,name) = Ast0.unwrap_mcode current_name in
  54       print_string "@";
  55       print_string name;
  56       meta_pos (Ast0.get_pos current_name))
  57     l
  58
  59 (* --------------------------------------------------------------------- *)
  60 (* Modified code *)
  61
  62 let mcodekind brackets fn x info mc =
  63   let print = function
  64       Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in
  65   List.iter (function (s,_) -> print s) info.Ast0.strings_before;
  66   (match mc with
  67     Ast0.MINUS(plus_stream) ->
  68       let (lb,rb) =
  69         if !quiet
  70         then ("","")
  71         else
  72           match brackets with
  73             Some x -> ("[","]^"^(string_of_int x))
  74           | None -> ("","") in
  75       let (plus_stream,_) = !plus_stream in
  76       if !quiet
  77       then fn x
  78       else (print_string "-";
  79             print_string lb; fn x; print_string rb);
  80       (match plus_stream with
  81         Ast.NOREPLACEMENT -> ()
  82       | Ast.REPLACEMENT(plus_stream,_) -> U.print_anything ">>> " plus_stream)
  83   | Ast0.CONTEXT(plus_streams) ->
  84       let (lb,rb) =
  85         if !quiet
  86         then ("","")
  87         else
  88           match brackets with
  89             Some x -> ("[",("]^"^(string_of_int x))) | None -> ("","") in
  90       let (plus_streams,t1,t2) = !plus_streams in
  91       U.print_around
  92         (function x ->
  93           print_string lb; fn x; print_string rb)
  94         x plus_streams
  95   | Ast0.PLUS _ -> print_int (info.Ast0.pos_info.Ast0.column); fn x
  96   | Ast0.MIXED(plus_streams) ->
  97       let (lb,rb) =
  98         if !quiet
  99         then ("","")
 100         else
 101           let n =
 102             match brackets with Some x -> "^"^(string_of_int x) | None -> "" in
 103           ("§","½"^n) in
 104       let (plus_streams,_,_) = !plus_streams in
 105       U.print_around (function x -> print_string lb; fn x; print_string rb)
 106         x plus_streams);
 107   List.iter (function (s,_) -> print s) info.Ast0.strings_after
 108
 109 let mcode fn (x,_,info,mc,pos,adj) =
 110   let fn x = fn x; meta_pos !pos in
 111   mcodekind (Some info.Ast0.pos_info.Ast0.line_start)(*None*) fn x info mc
 112
 113 let print_context x fn =
 114   mcodekind (Some (Ast0.get_line x)) fn () (Ast0.get_info x)
 115     (Ast0.get_mcodekind x)
 116
 117 let print_meta (ctx,name) =
 118   (if !full_ids
 119   then (print_string ctx; print_string ":"));
 120   print_string name
 121
 122 (* --------------------------------------------------------------------- *)
 123 (* --------------------------------------------------------------------- *)
 124 (* Dots *)
 125
 126 let dots between fn d =
 127   print_context d
 128     (function _ ->
 129       match Ast0.unwrap d with
 130         Ast0.DOTS(l) -> print_between between fn l
 131       | Ast0.CIRCLES(l) -> print_between between fn l
 132       | Ast0.STARS(l) -> print_between between fn l)
 133
 134 (* --------------------------------------------------------------------- *)
 135 (* Disjunctions *)
 136
 137 let do_disj lst processor =
 138   print_string "\n("; force_newline();
 139   print_between (function _ -> print_string "\n|"; force_newline())
 140     processor lst;
 141   print_string "\n)"
 142
 143 (* --------------------------------------------------------------------- *)
 144
 145 let print_types = function
 146     None -> ()
 147   | Some ty ->
 148       print_string "/* ";
 149       Format.print_flush();
 150       print_between (function _ -> print_string ", ") Type_cocci.typeC ty;
 151       Format.print_flush();
 152       print_string " */"
 153
 154 (* --------------------------------------------------------------------- *)
 155 (* Identifier *)
 156
 157 let rec ident i =
 158   print_context i
 159     (function _ ->
 160       match Ast0.unwrap i with
 161         Ast0.Id(name) -> mcode print_string name
 162       | Ast0.MetaId(name,_,_,_) -> mcode print_meta name
 163       | Ast0.MetaFunc(name,_,_) -> mcode print_meta name
 164       | Ast0.MetaLocalFunc(name,_,_) -> mcode print_meta name
 165       | Ast0.DisjId(_,id_list,_,_) -> do_disj id_list ident
 166       | Ast0.OptIdent(id) -> print_string "?"; ident id
 167       | Ast0.UniqueIdent(id) -> print_string "!"; ident id)
 168
 169 (* --------------------------------------------------------------------- *)
 170 (* Expression *)
 171
 172 let print_string_box s = print_string s; open_box 0
 173
 174 let rec expression e =
 175   print_option Type_cocci.typeC (Ast0.get_type e);
 176   print_context e
 177     (function _ ->
 178       match Ast0.unwrap e with
 179         Ast0.Ident(id) -> ident id
 180       | Ast0.Constant(const) -> mcode U.constant const
 181       | Ast0.FunCall(fn,lp,args,rp) ->
 182           expression fn; mcode print_string_box lp;
 183           let _ = dots (function _ -> ()) expression args in
 184           close_box(); mcode print_string rp
 185       | Ast0.Assignment(left,op,right,_) ->
 186           expression left; print_string " "; mcode U.assignOp op;
 187           print_string " "; expression right
 188       | Ast0.Sequence(left,op,right) ->
 189           expression left; mcode print_string op;
 190           print_string " "; expression right
 191       | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 192           expression exp1; print_string " "; mcode print_string why;
 193           print_option (function e -> print_string " "; expression e) exp2;
 194           print_string " "; mcode print_string colon; expression exp3
 195       | Ast0.Postfix(exp,op) -> expression exp; mcode U.fixOp op
 196       | Ast0.Infix(exp,op) -> mcode U.fixOp op; expression exp
 197       | Ast0.Unary(exp,op) -> mcode U.unaryOp op; expression exp
 198       | Ast0.Binary(left,op,right) ->
 199           print_string "(";
 200           expression left; print_string " "; mcode U.binaryOp op;
 201           print_string " "; expression right;
 202           print_string ")"
 203       | Ast0.Nested(left,op,right) ->
 204           print_string "(";
 205           expression left; print_string " "; mcode U.binaryOp op;
 206           print_string " "; expression right;
 207           print_string ")"
 208       | Ast0.Paren(lp,exp,rp) ->
 209           mcode print_string_box lp; expression exp; close_box();
 210           mcode print_string rp
 211       | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 212           expression exp1; mcode print_string_box lb; expression exp2;
 213           close_box(); mcode print_string rb
 214       | Ast0.RecordAccess(exp,pt,field) ->
 215           expression exp; mcode print_string pt; ident field
 216       | Ast0.RecordPtAccess(exp,ar,field) ->
 217           expression exp; mcode print_string ar; ident field
 218       | Ast0.Cast(lp,ty,rp,exp) ->
 219           mcode print_string_box lp; typeC ty; close_box();
 220           mcode print_string rp; expression exp
 221       | Ast0.SizeOfExpr(szf,exp) ->
 222           mcode print_string szf; expression exp
 223       | Ast0.SizeOfType(szf,lp,ty,rp) ->
 224           mcode print_string szf;
 225           mcode print_string_box lp; typeC ty; close_box();
 226           mcode print_string rp
 227       | Ast0.TypeExp(ty) -> typeC ty
 228       | Ast0.Constructor(lp,ty,rp,init) ->
 229           mcode print_string_box lp; typeC ty; close_box();
 230           mcode print_string rp; initialiser init
 231       | Ast0.MetaErr(name,_,_) -> mcode print_meta name
 232       | Ast0.MetaExpr(name,_,ty,_,pure) ->
 233           mcode print_meta name; print_types ty(*;
 234           print_string "^";
 235           (match pure with
 236             Ast0.Pure -> print_string "pure"
 237           | Ast0.Impure -> print_string "impure"
 238           | Ast0.Context -> print_string "context"
 239           | Ast0.PureContext -> print_string "pure_context")*)
 240       | Ast0.MetaExprList(name,_,_) -> mcode print_meta name
 241       | Ast0.EComma(cm) -> mcode print_string cm; print_space()
 242       | Ast0.DisjExpr(_,exp_list,_,_) -> do_disj exp_list expression
 243       | Ast0.NestExpr(starter,expr_dots,ender,None,multi) ->
 244           mcode print_string starter;
 245           start_block(); dots force_newline expression expr_dots; end_block();
 246           mcode print_string ender
 247       | Ast0.NestExpr(starter,expr_dots,ender,Some whencode,multi) ->
 248           mcode print_string starter; print_string "   WHEN != ";
 249           expression whencode;
 250           start_block(); dots force_newline expression expr_dots; end_block();
 251           mcode print_string ender
 252       | Ast0.Edots(dots,Some whencode)
 253       | Ast0.Ecircles(dots,Some whencode)
 254       | Ast0.Estars(dots,Some whencode) ->
 255           mcode print_string dots; print_string "   WHEN != ";
 256           expression whencode
 257       | Ast0.Edots(dots,None)
 258       | Ast0.Ecircles(dots,None)
 259       | Ast0.Estars(dots,None) -> mcode print_string dots
 260       | Ast0.OptExp(exp) -> print_string "?"; expression exp
 261       | Ast0.UniqueExp(exp) -> print_string "!"; expression exp
 262       | Ast0.AsExpr(exp,asexp) -> expression exp; print_string "@";
 263           expression asexp)
 264
 265 and expression_dots x = dots (function _ -> ()) expression x
 266
 267 (* --------------------------------------------------------------------- *)
 268 (* Types *)
 269
 270 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
 271   typeC ty; mcode print_string lp1; mcode print_string star; fn();
 272   mcode print_string rp1; mcode print_string lp2;
 273   parameter_list params; mcode print_string rp2
 274
 275 and print_function_type (ty,lp1,params,rp1) fn =
 276   print_option typeC ty; fn(); mcode print_string lp1;
 277   parameter_list params; mcode print_string rp1
 278
 279 and typeC t =
 280   print_context t
 281     (function _ ->
 282       match Ast0.unwrap t with
 283         Ast0.ConstVol(cv,ty) ->
 284           mcode U.const_vol cv; print_string " "; typeC ty
 285       | Ast0.BaseType(ty,strings) ->
 286           List.iter (function s -> mcode print_string s; print_string " ")
 287             strings
 288       | Ast0.Signed(sgn,ty) -> mcode U.sign sgn; print_option typeC ty
 289       | Ast0.Pointer(ty,star) -> typeC ty; mcode print_string star
 290       | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 291           print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 292             (function _ -> ())
 293       | Ast0.FunctionType(ty,lp1,params,rp1) ->
 294           print_function_type (ty,lp1,params,rp1) (function _ -> ())
 295       | Ast0.Array(ty,lb,size,rb) ->
 296           typeC ty; mcode print_string lb; print_option expression size;
 297           mcode print_string rb
 298       | Ast0.EnumName(kind,name) ->
 299           mcode print_string kind;
 300           print_option (function x -> ident x; print_string " ") name
 301       | Ast0.EnumDef(ty,lb,ids,rb) ->
 302           typeC ty; mcode print_string lb;
 303           dots force_newline expression ids;
 304           mcode print_string rb
 305       | Ast0.StructUnionName(kind,name) ->
 306           mcode U.structUnion kind;
 307           print_option (function x -> ident x; print_string " ") name
 308       | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 309           typeC ty; mcode print_string lb;
 310           dots force_newline declaration decls;
 311           mcode print_string rb
 312       | Ast0.TypeName(name)-> mcode print_string name; print_string " "
 313       | Ast0.MetaType(name,_)-> mcode print_meta name; print_string " "
 314       | Ast0.DisjType(_,types,_,_) -> do_disj types typeC
 315       | Ast0.OptType(ty) -> print_string "?"; typeC ty
 316       | Ast0.UniqueType(ty) -> print_string "!"; typeC ty
 317       | Ast0.AsType(ty,asty) -> typeC ty; print_string "@"; typeC asty)
 318
 319 (* --------------------------------------------------------------------- *)
 320 (* Variable declaration *)
 321 (* Even if the Cocci program specifies a list of declarations, they are
 322    split out into multiple declarations of a single variable each. *)
 323
 324 and print_named_type ty id =
 325   match Ast0.unwrap ty with
 326     Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 327       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 328         (function _ -> print_string " "; ident id)
 329   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 330       print_function_type (ty,lp1,params,rp1)
 331         (function _ -> print_string " "; ident id)
 332   | Ast0.Array(ty,lb,size,rb) ->
 333       let rec loop ty k =
 334         match Ast0.unwrap ty with
 335           Ast0.Array(ty,lb,size,rb) ->
 336             loop ty
 337               (function _ ->
 338                 k ();
 339                 mcode print_string lb;
 340                 print_option expression size;
 341                 mcode print_string rb)
 342         | _ -> typeC ty; ident id; k () in
 343       loop ty (function _ -> ())
 344   | _ -> typeC ty; ident id
 345
 346 and declaration d =
 347   print_context d
 348     (function _ ->
 349       match Ast0.unwrap d with
 350         Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_)
 351       | Ast0.MetaFieldList(name,_,_) ->
 352           mcode print_meta name
 353       | Ast0.Init(stg,ty,id,eq,ini,sem) ->
 354           print_option (mcode U.storage) stg;
 355           print_named_type ty id;
 356           print_string " ";
 357           mcode print_string eq; print_string " "; initialiser ini;
 358           mcode print_string sem
 359       | Ast0.UnInit(stg,ty,id,sem) ->
 360           print_option (mcode U.storage) stg; print_named_type ty id;
 361           mcode print_string sem
 362       | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 363           ident name; mcode print_string_box lp;
 364           let _ = dots (function _ -> ()) expression args in
 365           close_box(); mcode print_string rp; mcode print_string sem
 366       | Ast0.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
 367           ident name; mcode print_string_box lp;
 368           let _ = dots (function _ -> ()) expression args in
 369           close_box(); mcode print_string rp;
 370           print_string " ";
 371           mcode print_string eq; print_string " "; initialiser ini;
 372           mcode print_string sem
 373       | Ast0.TyDecl(ty,sem) -> typeC ty; mcode print_string sem
 374       | Ast0.Typedef(stg,ty,id,sem) ->
 375           mcode print_string stg; typeC ty; typeC id;
 376           mcode print_string sem
 377       | Ast0.DisjDecl(_,decls,_,_) ->
 378           print_string "\n("; force_newline();
 379           print_between
 380             (function _ -> print_string "\n|"; force_newline())
 381             declaration decls;
 382           print_string "\n)"
 383       | Ast0.Ddots(dots,Some whencode) ->
 384           mcode print_string dots; print_string "   when != ";
 385           declaration whencode
 386       | Ast0.Ddots(dots,None) -> mcode print_string dots
 387       | Ast0.OptDecl(decl) -> print_string "?"; declaration decl
 388       | Ast0.UniqueDecl(decl) -> print_string "!"; declaration decl
 389       | Ast0.AsDecl(decl,asdecl) ->
 390           declaration decl; print_string "@"; declaration asdecl)
 391
 392 and declaration_dots l = dots (function _ -> ()) declaration l
 393
 394 (* --------------------------------------------------------------------- *)
 395 (* Initialiser *)
 396
 397 and initialiser i =
 398   print_context i
 399     (function _ ->
 400       match Ast0.unwrap i with
 401         Ast0.MetaInit(name,_)-> mcode print_meta name; print_string " "
 402       | Ast0.MetaInitList(name,_,_)-> mcode print_meta name; print_string " "
 403       | Ast0.InitExpr(exp) -> expression exp
 404       | Ast0.InitList(lb,initlist,rb,ordered) ->
 405           (*doesn't show commas dropped in unordered case*)
 406           mcode print_string lb; open_box 0;
 407           let _ = dots (function _ -> ()) initialiser initlist in
 408           close_box(); mcode print_string rb
 409       | Ast0.InitGccExt(designators,eq,ini) ->
 410           List.iter designator designators; print_string " ";
 411           mcode print_string eq; print_string " "; initialiser ini
 412       | Ast0.InitGccName(name,eq,ini) ->
 413           ident name; mcode print_string eq; initialiser ini
 414       | Ast0.IComma(cm) -> mcode print_string cm; force_newline()
 415       | Ast0.Idots(d,Some whencode) ->
 416           mcode print_string d; print_string "   WHEN != ";
 417           initialiser whencode
 418       | Ast0.Idots(d,None) -> mcode print_string d
 419       | Ast0.OptIni(ini) -> print_string "?"; initialiser ini
 420       | Ast0.UniqueIni(ini) -> print_string "!"; initialiser ini
 421       | Ast0.AsInit(ini,asini) -> initialiser ini; print_string "@";
 422           initialiser asini)
 423
 424 and designator = function
 425       Ast0.DesignatorField(dot,id) -> mcode print_string dot; ident id
 426     | Ast0.DesignatorIndex(lb,exp,rb) ->
 427         mcode print_string lb; expression exp; mcode print_string rb
 428     | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 429         mcode print_string lb; expression min; mcode print_string dots;
 430         expression max; mcode print_string rb
 431
 432 and initialiser_list l = dots (function _ -> ()) initialiser l
 433
 434 (* --------------------------------------------------------------------- *)
 435 (* Parameter *)
 436
 437 and parameterTypeDef p =
 438   print_context p
 439     (function _ ->
 440       match Ast0.unwrap p with
 441         Ast0.VoidParam(ty) -> typeC ty
 442       | Ast0.Param(ty,Some id) -> print_named_type ty id
 443       | Ast0.Param(ty,None) -> typeC ty
 444       | Ast0.MetaParam(name,_) -> mcode print_meta name
 445       | Ast0.MetaParamList(name,_,_) -> mcode print_meta name
 446       | Ast0.PComma(cm) -> mcode print_string cm; print_space()
 447       | Ast0.Pdots(dots) -> mcode print_string dots
 448       | Ast0.Pcircles(dots) -> mcode print_string dots
 449       | Ast0.OptParam(param) -> print_string "?"; parameterTypeDef param
 450       | Ast0.UniqueParam(param) -> print_string "!"; parameterTypeDef param)
 451
 452 and parameter_list l = dots (function _ -> ()) parameterTypeDef l
 453
 454 (* --------------------------------------------------------------------- *)
 455 (* Top-level code *)
 456
 457 and statement arity s =
 458   print_context s
 459     (function _ ->
 460       match Ast0.unwrap s with
 461         Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 462           print_string arity;
 463           List.iter print_fninfo fninfo;
 464           ident name; mcode print_string_box lp;
 465           parameter_list params; close_box(); mcode print_string rp;
 466           print_string " ";
 467           print_string arity; mcode print_string lbrace; start_block();
 468           dots force_newline (statement arity) body;
 469           end_block(); print_string arity; mcode print_string rbrace
 470       | Ast0.Decl(_,decl) ->
 471           Printf.printf "statement mcodekind %s\n"
 472             (Dumper.dump (Ast0.get_mcodekind s));
 473           Printf.printf "decl mcodekind %s\n"
 474             (Dumper.dump (Ast0.get_mcodekind decl));
 475           print_string arity; declaration decl
 476       | Ast0.Seq(lbrace,body,rbrace) ->
 477           print_string arity; mcode print_string lbrace; start_block();
 478           dots force_newline (statement arity) body;
 479           end_block(); print_string arity; mcode print_string rbrace
 480       | Ast0.ExprStatement(exp,sem) ->
 481           print_string arity; print_option expression exp;
 482           mcode print_string sem
 483       | Ast0.IfThen(iff,lp,exp,rp,branch1,(info,aft)) ->
 484           print_string arity;
 485           mcode print_string iff; print_string " "; mcode print_string_box lp;
 486           expression exp; close_box(); mcode print_string rp; print_string " ";
 487           statement arity branch1;
 488           mcode (function _ -> ()) ((),(),info,aft,ref [],-1)
 489       | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,aft)) ->
 490           print_string arity;
 491           mcode print_string iff; print_string " "; mcode print_string_box lp;
 492           expression exp; close_box(); mcode print_string rp; print_string " ";
 493           statement arity branch1;
 494           print_string arity; mcode print_string els; print_string " ";
 495           statement arity branch2;
 496           mcode (function _ -> ()) ((),(),info,aft,ref [],-1)
 497       | Ast0.While(whl,lp,exp,rp,body,(info,aft)) ->
 498           print_string arity;
 499           mcode print_string whl; print_string " "; mcode print_string_box lp;
 500           expression exp; close_box(); mcode print_string rp; print_string " ";
 501           statement arity body;
 502           mcode (function _ -> ()) ((),(),info,aft,ref [],-1)
 503       | Ast0.Do(d,body,whl,lp,exp,rp,sem) ->
 504           print_string arity; mcode print_string d; print_string " ";
 505           statement arity body;
 506           print_string arity;
 507           mcode print_string whl; print_string " "; mcode print_string_box lp;
 508           expression exp; close_box(); mcode print_string rp;
 509           mcode print_string sem
 510       | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,(info,aft)) ->
 511           print_string arity;
 512           mcode print_string fr; mcode print_string_box lp;
 513           print_option expression e1; mcode print_string sem1;
 514           print_option expression e2; mcode print_string sem2;
 515           print_option expression e3; close_box();
 516           mcode print_string rp; print_string " "; statement arity body;
 517           mcode (function _ -> ()) ((),(),info,aft,ref [],-1)
 518       | Ast0.Iterator(nm,lp,args,rp,body,(info,aft)) ->
 519           print_string arity;
 520           ident nm; print_string " "; mcode print_string_box lp;
 521           let _ = dots (function _ -> ()) expression args in
 522           close_box(); mcode print_string rp; print_string " ";
 523           statement arity body;
 524           mcode (function _ -> ()) ((),(),info,aft,ref [],-1)
 525       | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 526           print_string arity;
 527           mcode print_string switch; print_string " ";
 528           mcode print_string_box lp; expression exp; close_box();
 529           mcode print_string rp; print_string " "; mcode print_string lb;
 530           dots force_newline (statement arity) decls;
 531           dots force_newline (case_line arity) cases;
 532           mcode print_string rb
 533       | Ast0.Break(br,sem) ->
 534           print_string arity; mcode print_string br; mcode print_string sem
 535       | Ast0.Continue(cont,sem) ->
 536           print_string arity; mcode print_string cont; mcode print_string sem
 537       | Ast0.Label(l,dd) -> ident l; print_string ":"
 538       | Ast0.Goto(goto,l,sem) ->
 539           mcode print_string goto; ident l; mcode print_string sem
 540       | Ast0.Return(ret,sem) ->
 541           print_string arity; mcode print_string ret; mcode print_string sem
 542       | Ast0.ReturnExpr(ret,exp,sem) ->
 543           print_string arity; mcode print_string ret; print_string " ";
 544           expression exp; mcode print_string sem
 545       | Ast0.MetaStmt(name,pure) ->
 546           print_string arity; mcode print_meta name;(*
 547           print_string "^";
 548           (match pure with
 549             Ast0.Pure -> print_string "pure"
 550           | Ast0.Impure -> print_string "impure"
 551           | Ast0.Context -> print_string "context"
 552           | Ast0.PureContext -> print_string "pure_context")*)
 553       | Ast0.MetaStmtList(name,_) ->
 554           print_string arity;  mcode print_meta name
 555       | Ast0.Disj(starter,statement_dots_list,_,ender) ->
 556           print_string arity;
 557           print_string "\n"; mcode print_string starter; force_newline();
 558           print_between
 559             (function _ -> print_string "\n|"; force_newline())
 560             (dots force_newline (statement arity))
 561             statement_dots_list;
 562           print_string "\n"; mcode print_string ender
 563       | Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
 564           print_string arity;
 565           mcode print_string starter;
 566           open_box 0;
 567           List.iter
 568             (whencode (dots force_newline (statement "")) (statement ""))
 569             whn;
 570           close_box();
 571           start_block();
 572           dots force_newline (statement arity) stmt_dots;
 573           end_block();
 574           mcode print_string ender
 575       | Ast0.Exp(exp) -> print_string arity; expression exp
 576       | Ast0.TopExp(exp) -> print_string arity; expression exp
 577       | Ast0.Ty(ty) -> print_string arity; typeC ty
 578       | Ast0.TopInit(init) -> initialiser init
 579       | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) ->
 580           print_string arity; mcode print_string d;
 581           List.iter
 582             (whencode (dots force_newline (statement "")) (statement ""))
 583             whn
 584       | Ast0.Include(inc,s) ->
 585           mcode print_string inc; print_string " "; mcode U.inc_file s
 586       | Ast0.Undef(def,id) ->
 587           mcode print_string def; print_string " "; ident id
 588       | Ast0.Define(def,id,params,body) ->
 589           mcode print_string def; print_string " "; ident id;
 590           print_define_parameters params;
 591           print_string " ";
 592           dots force_newline (statement arity) body
 593       | Ast0.OptStm(re) -> statement "?" re
 594       | Ast0.UniqueStm(re) -> statement "!" re
 595       | Ast0.AsStmt(stm,asstm) -> statement arity stm; print_string "@";
 596           statement arity asstm)
 597
 598 and print_define_parameters params =
 599   match Ast0.unwrap params with
 600     Ast0.NoParams -> ()
 601   | Ast0.DParams(lp,params,rp) ->
 602       mcode print_string lp;
 603       dots (function _ -> ()) print_define_param params; mcode print_string rp
 604
 605 and print_define_param param =
 606   match Ast0.unwrap param with
 607     Ast0.DParam(id) -> ident id
 608   | Ast0.DPComma(comma) -> mcode print_string comma
 609   | Ast0.DPdots(dots) -> mcode print_string dots
 610   | Ast0.DPcircles(circles) -> mcode print_string circles
 611   | Ast0.OptDParam(dp) -> print_string "?"; print_define_param dp
 612   | Ast0.UniqueDParam(dp) -> print_string "!"; print_define_param dp
 613
 614 and print_fninfo = function
 615     Ast0.FStorage(stg) -> mcode U.storage stg
 616   | Ast0.FType(ty) -> typeC ty
 617   | Ast0.FInline(inline) -> mcode print_string inline
 618   | Ast0.FAttr(attr) -> mcode print_string attr
 619
 620 and whencode notfn alwaysfn = function
 621     Ast0.WhenNot a ->
 622       print_string "   WHEN != "; open_box 0; notfn a; close_box()
 623   | Ast0.WhenAlways a ->
 624       print_string "   WHEN = "; open_box 0; alwaysfn a; close_box()
 625   | Ast0.WhenModifier x -> print_string "   WHEN "; U.print_when_modif x
 626   | Ast0.WhenNotTrue a ->
 627       print_string "   WHEN != TRUE "; open_box 0; expression a; close_box()
 628   | Ast0.WhenNotFalse a ->
 629       print_string "   WHEN != FALSE "; open_box 0; expression a; close_box()
 630
 631 and case_line arity c =
 632   print_context c
 633     (function _ ->
 634       match Ast0.unwrap c with
 635         Ast0.Default(def,colon,code) ->
 636           print_string arity;
 637           mcode print_string def; mcode print_string colon; print_string " ";
 638           dots force_newline (statement arity) code
 639       | Ast0.Case(case,exp,colon,code) ->
 640           print_string arity;
 641           mcode print_string case; print_string " "; expression exp;
 642           mcode print_string colon; print_string " ";
 643           dots force_newline (statement arity) code
 644       | Ast0.DisjCase(starter,case_lines,mids,ender) ->
 645           print_string "\n("; force_newline();
 646           print_between
 647             (function _ -> print_string "\n|"; force_newline())
 648             (case_line arity) case_lines;
 649           print_string "\n)"
 650       | Ast0.OptCase(case) -> case_line "?" case)
 651
 652 and statement_dots l = dots (function _ -> ()) (statement "") l
 653 and case_dots l = dots (function _ -> ()) (case_line "") l
 654
 655 (* --------------------------------------------------------------------- *)
 656 (* Top level code *)
 657
 658 let top_level t =
 659   print_context t
 660     (function _ ->
 661       match Ast0.unwrap t with
 662         Ast0.FILEINFO(old_file,new_file) ->
 663           print_string "--- "; mcode print_string old_file; force_newline();
 664           print_string "+++ "; mcode print_string new_file
 665       | Ast0.NONDECL(stmt) -> statement "" stmt
 666       | Ast0.CODE(stmt_dots) | Ast0.TOPCODE(stmt_dots) ->
 667           dots force_newline (statement "") stmt_dots
 668       | Ast0.ERRORWORDS(exps) ->
 669           print_string "error words = [";
 670           print_between (function _ -> print_string ", ") expression exps;
 671           print_string "]"
 672       | Ast0.OTHER(s) ->
 673           print_string "OTHER("; statement "" s; print_string ")")
 674
 675 let rule =
 676   print_between (function _ -> force_newline(); force_newline()) top_level
 677
 678 let unparse_anything x =
 679   let q = !quiet in
 680   quiet := true;
 681   (match x with
 682     Ast0.DotsExprTag(d) ->
 683       print_string "ExpDots:"; force_newline();
 684       expression_dots d
 685   | Ast0.DotsParamTag(d) ->
 686       parameter_list d
 687   | Ast0.DotsInitTag(d) ->
 688       initialiser_list d
 689   | Ast0.DotsStmtTag(d) ->
 690       print_string "StmDots:"; force_newline();
 691       statement_dots d
 692   | Ast0.DotsDeclTag(d) -> declaration_dots d
 693   | Ast0.DotsCaseTag(d) -> case_dots d
 694   | Ast0.IdentTag(d)    -> ident d
 695   | Ast0.ExprTag(d) | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 696       print_string "Exp:"; force_newline();
 697       expression d
 698   | Ast0.TypeCTag(d) -> typeC d
 699   | Ast0.ParamTag(d) -> parameterTypeDef d
 700   | Ast0.InitTag(d)  -> initialiser d
 701   | Ast0.DeclTag(d)  -> declaration d
 702   | Ast0.StmtTag(d)  ->
 703       print_string "Stm:"; force_newline();
 704       statement "" d
 705   | Ast0.CaseLineTag(d)  -> case_line "" d
 706   | Ast0.TopTag(d)       -> top_level d
 707   | Ast0.IsoWhenTag(x)   -> U.print_when_modif x
 708   | Ast0.IsoWhenTTag(e)  -> expression e
 709   | Ast0.IsoWhenFTag(e)  -> expression e
 710   | Ast0.MetaPosTag(var) -> meta_pos [x]
 711   | Ast0.HiddenVarTag(var) -> failwith "should not need to be printed");
 712   quiet := q;
 713   print_newline()
 714
 715 let unparse x =
 716   print_string "\n@@\n@@";
 717   force_newline();
 718   force_newline();
 719   rule x;
 720   print_newline()
 721
 722 let unparse_to_string x = Common.format_to_string (function _ -> unparse x)