parsing_cocci/unparse_ast0.ml

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