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) -> mcode print_string kind; print_string " ";
 277           ident name
 278       | Ast0.StructUnionName(kind,name) ->
 279           mcode U.structUnion kind;
 280           print_option (function x -> ident x; print_string " ") name
 281       | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 282           typeC ty; mcode print_string lb;
 283           dots force_newline declaration decls;
 284           mcode print_string rb
 285       | Ast0.TypeName(name)-> mcode print_string name; print_string " "
 286       | Ast0.MetaType(name,_)-> mcode print_meta name; print_string " "
 287       | Ast0.DisjType(lp,types,mids,rp) ->
 288           print_string "\n"; mcode print_string lp; force_newline();
 289           print_between
 290             (function _ -> print_string "\n|"; force_newline())
 291             typeC types;
 292           print_string "\n"; mcode print_string rp
 293       | Ast0.OptType(ty) -> print_string "?"; typeC ty
 294       | Ast0.UniqueType(ty) -> print_string "!"; typeC ty)
 295
 296 (* --------------------------------------------------------------------- *)
 297 (* Variable declaration *)
 298 (* Even if the Cocci program specifies a list of declarations, they are
 299    split out into multiple declarations of a single variable each. *)
 300
 301 and print_named_type ty id =
 302   match Ast0.unwrap ty with
 303     Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 304       print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
 305         (function _ -> print_string " "; ident id)
 306   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 307       print_function_type (ty,lp1,params,rp1)
 308         (function _ -> print_string " "; ident id)
 309   | Ast0.Array(ty,lb,size,rb) ->
 310       let rec loop ty k =
 311         match Ast0.unwrap ty with
 312           Ast0.Array(ty,lb,size,rb) ->
 313             loop ty
 314               (function _ ->
 315                 k ();
 316                 mcode print_string lb;
 317                 print_option expression size;
 318                 mcode print_string rb)
 319         | _ -> typeC ty; ident id; k () in
 320       loop ty (function _ -> ())
 321   | _ -> typeC ty; ident id
 322
 323 and declaration d =
 324   print_context d
 325     (function _ ->
 326       match Ast0.unwrap d with
 327         Ast0.Init(stg,ty,id,eq,ini,sem) ->
 328           print_option (mcode U.storage) stg;
 329           print_named_type ty id;
 330           print_string " ";
 331           mcode print_string eq; print_string " "; initialiser ini;
 332           mcode print_string sem
 333       | Ast0.UnInit(stg,ty,id,sem) ->
 334           print_option (mcode U.storage) stg; print_named_type ty id;
 335           mcode print_string sem
 336       | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 337           ident name; mcode print_string_box lp;
 338           let _ = dots (function _ -> ()) expression args in
 339           close_box(); mcode print_string rp; mcode print_string sem
 340       | Ast0.TyDecl(ty,sem) -> typeC ty; mcode print_string sem
 341       | Ast0.Typedef(stg,ty,id,sem) ->
 342           mcode print_string stg; typeC ty; typeC id;
 343           mcode print_string sem
 344       | Ast0.DisjDecl(_,decls,_,_) ->
 345           print_string "\n("; force_newline();
 346           print_between
 347             (function _ -> print_string "\n|"; force_newline())
 348             declaration decls;
 349           print_string "\n)"
 350       | Ast0.Ddots(dots,Some whencode) ->
 351           mcode print_string dots; print_string "   when != ";
 352           declaration whencode
 353       | Ast0.Ddots(dots,None) -> mcode print_string dots
 354       | Ast0.OptDecl(decl) -> print_string "?"; declaration decl
 355       | Ast0.UniqueDecl(decl) -> print_string "!"; declaration decl)
 356
 357 and declaration_dots l = dots (function _ -> ()) declaration l
 358
 359 (* --------------------------------------------------------------------- *)
 360 (* Initialiser *)
 361
 362 and initialiser i =
 363   print_context i
 364     (function _ ->
 365       match Ast0.unwrap i with
 366         Ast0.MetaInit(name,_)-> mcode print_meta name; print_string " "
 367       | Ast0.InitExpr(exp) -> expression exp
 368       | Ast0.InitList(lb,initlist,rb) ->
 369           mcode print_string lb; open_box 0;
 370           let _ = dots (function _ -> ()) initialiser initlist in
 371           close_box(); mcode print_string rb
 372       | Ast0.InitGccExt(designators,eq,ini) ->
 373           List.iter designator designators; print_string " ";
 374           mcode print_string eq; print_string " "; initialiser ini
 375       | Ast0.InitGccName(name,eq,ini) ->
 376           ident name; mcode print_string eq; initialiser ini
 377       | Ast0.IComma(cm) -> mcode print_string cm; force_newline()
 378       | Ast0.Idots(d,Some whencode) ->
 379           mcode print_string d; print_string "   WHEN != ";
 380           initialiser whencode
 381       | Ast0.Idots(d,None) -> mcode print_string d
 382       | Ast0.OptIni(ini) -> print_string "?"; initialiser ini
 383       | Ast0.UniqueIni(ini) -> print_string "!"; initialiser ini)
 384
 385 and designator = function
 386       Ast0.DesignatorField(dot,id) -> mcode print_string dot; ident id
 387     | Ast0.DesignatorIndex(lb,exp,rb) ->
 388         mcode print_string lb; expression exp; mcode print_string rb
 389     | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 390         mcode print_string lb; expression min; mcode print_string dots;
 391         expression max; mcode print_string rb
 392
 393 and initialiser_list l = dots (function _ -> ()) initialiser l
 394
 395 (* --------------------------------------------------------------------- *)
 396 (* Parameter *)
 397
 398 and parameterTypeDef p =
 399   print_context p
 400     (function _ ->
 401       match Ast0.unwrap p with
 402         Ast0.VoidParam(ty) -> typeC ty
 403       | Ast0.Param(ty,Some id) -> print_named_type ty id
 404       | Ast0.Param(ty,None) -> typeC ty
 405       | Ast0.MetaParam(name,_) -> mcode print_meta name
 406       | Ast0.MetaParamList(name,_,_) -> mcode print_meta name
 407       | Ast0.PComma(cm) -> mcode print_string cm; print_space()
 408       | Ast0.Pdots(dots) -> mcode print_string dots
 409       | Ast0.Pcircles(dots) -> mcode print_string dots
 410       | Ast0.OptParam(param) -> print_string "?"; parameterTypeDef param
 411       | Ast0.UniqueParam(param) -> print_string "!"; parameterTypeDef param)
 412
 413 and parameter_list l = dots (function _ -> ()) parameterTypeDef l
 414
 415 (* --------------------------------------------------------------------- *)
 416 (* Top-level code *)
 417
 418 and statement arity s =
 419   print_context s
 420     (function _ ->
 421       match Ast0.unwrap s with
 422         Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 423           print_string arity;
 424           List.iter print_fninfo fninfo;
 425           ident name; mcode print_string_box lp;
 426           parameter_list params; close_box(); mcode print_string rp;
 427           print_string " ";
 428           print_string arity; mcode print_string lbrace; start_block();
 429           dots force_newline (statement arity) body;
 430           end_block(); print_string arity; mcode print_string rbrace
 431       | Ast0.Decl(_,decl) -> print_string arity; declaration decl
 432       | Ast0.Seq(lbrace,body,rbrace) ->
 433           print_string arity; mcode print_string lbrace; start_block();
 434           dots force_newline (statement arity) body;
 435           end_block(); print_string arity; mcode print_string rbrace
 436       | Ast0.ExprStatement(exp,sem) ->
 437           print_string arity; expression exp; mcode print_string sem
 438       | Ast0.IfThen(iff,lp,exp,rp,branch1,(info,aft)) ->
 439           print_string arity;
 440           mcode print_string iff; print_string " "; mcode print_string_box lp;
 441           expression exp; close_box(); mcode print_string rp; print_string " ";
 442           statement arity branch1;
 443           mcode (function _ -> ()) ((),(),info,aft,ref Ast0.NoMetaPos,-1)
 444       | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(info,aft)) ->
 445           print_string arity;
 446           mcode print_string iff; print_string " "; mcode print_string_box lp;
 447           expression exp; close_box(); mcode print_string rp; print_string " ";
 448           statement arity branch1;
 449           print_string arity; mcode print_string els; print_string " ";
 450           statement arity branch2;
 451           mcode (function _ -> ()) ((),(),info,aft,ref Ast0.NoMetaPos,-1)
 452       | Ast0.While(whl,lp,exp,rp,body,(info,aft)) ->
 453           print_string arity;
 454           mcode print_string whl; print_string " "; mcode print_string_box lp;
 455           expression exp; close_box(); mcode print_string rp; print_string " ";
 456           statement arity body;
 457           mcode (function _ -> ()) ((),(),info,aft,ref Ast0.NoMetaPos,-1)
 458       | Ast0.Do(d,body,whl,lp,exp,rp,sem) ->
 459           print_string arity; mcode print_string d; print_string " ";
 460           statement arity body;
 461           print_string arity;
 462           mcode print_string whl; print_string " "; mcode print_string_box lp;
 463           expression exp; close_box(); mcode print_string rp;
 464           mcode print_string sem
 465       | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,(info,aft)) ->
 466           print_string arity;
 467           mcode print_string fr; mcode print_string_box lp;
 468           print_option expression e1; mcode print_string sem1;
 469           print_option expression e2; mcode print_string sem2;
 470           print_option expression e3; close_box();
 471           mcode print_string rp; print_string " "; statement arity body;
 472           mcode (function _ -> ()) ((),(),info,aft,ref Ast0.NoMetaPos,-1)
 473       | Ast0.Iterator(nm,lp,args,rp,body,(info,aft)) ->
 474           print_string arity;
 475           ident nm; print_string " "; mcode print_string_box lp;
 476           let _ = dots (function _ -> ()) expression args in
 477           close_box(); mcode print_string rp; print_string " ";
 478           statement arity body;
 479           mcode (function _ -> ()) ((),(),info,aft,ref Ast0.NoMetaPos,-1)
 480       | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
 481           print_string arity;
 482           mcode print_string switch; print_string " ";
 483           mcode print_string_box lp; expression exp; close_box();
 484           mcode print_string rp; print_string " "; mcode print_string lb;
 485           dots force_newline (statement arity) decls;
 486           dots force_newline (case_line arity) cases;
 487           mcode print_string rb
 488       | Ast0.Break(br,sem) ->
 489           print_string arity; mcode print_string br; mcode print_string sem
 490       | Ast0.Continue(cont,sem) ->
 491           print_string arity; mcode print_string cont; mcode print_string sem
 492       | Ast0.Label(l,dd) -> ident l; print_string ":"
 493       | Ast0.Goto(goto,l,sem) ->
 494           mcode print_string goto; ident l; mcode print_string sem
 495       | Ast0.Return(ret,sem) ->
 496           print_string arity; mcode print_string ret; mcode print_string sem
 497       | Ast0.ReturnExpr(ret,exp,sem) ->
 498           print_string arity; mcode print_string ret; print_string " ";
 499           expression exp; mcode print_string sem
 500       | Ast0.MetaStmt(name,pure) ->
 501           print_string arity; mcode print_meta name;(*
 502           print_string "^";
 503           (match pure with
 504             Ast0.Pure -> print_string "pure"
 505           | Ast0.Impure -> print_string "impure"
 506           | Ast0.Context -> print_string "context"
 507           | Ast0.PureContext -> print_string "pure_context")*)
 508       | Ast0.MetaStmtList(name,_) ->
 509           print_string arity;  mcode print_meta name
 510       | Ast0.Disj(starter,statement_dots_list,_,ender) ->
 511           print_string arity;
 512           print_string "\n"; mcode print_string starter; force_newline();
 513           print_between
 514             (function _ -> print_string "\n|"; force_newline())
 515             (dots force_newline (statement arity))
 516             statement_dots_list;
 517           print_string "\n"; mcode print_string ender
 518       | Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
 519           print_string arity;
 520           mcode print_string starter;
 521           open_box 0;
 522           List.iter
 523             (whencode (dots force_newline (statement "")) (statement ""))
 524             whn;
 525           close_box();
 526           start_block();
 527           dots force_newline (statement arity) stmt_dots;
 528           end_block();
 529           mcode print_string ender
 530       | Ast0.Exp(exp) -> print_string arity; expression exp
 531       | Ast0.TopExp(exp) -> print_string arity; expression exp
 532       | Ast0.Ty(ty) -> print_string arity; typeC ty
 533       | Ast0.TopInit(init) -> initialiser init
 534       | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) ->
 535           print_string arity; mcode print_string d;
 536           List.iter
 537             (whencode (dots force_newline (statement "")) (statement ""))
 538             whn
 539       | Ast0.Include(inc,s) ->
 540           mcode print_string inc; print_string " "; mcode U.inc_file s
 541       | Ast0.Define(def,id,params,body) ->
 542           mcode print_string def; print_string " "; ident id;
 543           print_define_parameters params;
 544           print_string " ";
 545           dots force_newline (statement arity) body
 546       | Ast0.OptStm(re) -> statement "?" re
 547       | Ast0.UniqueStm(re) -> statement "!" re)
 548
 549 and print_define_parameters params =
 550   match Ast0.unwrap params with
 551     Ast0.NoParams -> ()
 552   | Ast0.DParams(lp,params,rp) ->
 553       mcode print_string lp;
 554       dots (function _ -> ()) print_define_param params; mcode print_string rp
 555
 556 and print_define_param param =
 557   match Ast0.unwrap param with
 558     Ast0.DParam(id) -> ident id
 559   | Ast0.DPComma(comma) -> mcode print_string comma
 560   | Ast0.DPdots(dots) -> mcode print_string dots
 561   | Ast0.DPcircles(circles) -> mcode print_string circles
 562   | Ast0.OptDParam(dp) -> print_string "?"; print_define_param dp
 563   | Ast0.UniqueDParam(dp) -> print_string "!"; print_define_param dp
 564
 565 and print_fninfo = function
 566     Ast0.FStorage(stg) -> mcode U.storage stg
 567   | Ast0.FType(ty) -> typeC ty
 568   | Ast0.FInline(inline) -> mcode print_string inline
 569   | Ast0.FAttr(attr) -> mcode print_string attr
 570
 571 and whencode notfn alwaysfn = function
 572     Ast0.WhenNot a ->
 573       print_string "   WHEN != "; open_box 0; notfn a; close_box()
 574   | Ast0.WhenAlways a ->
 575       print_string "   WHEN = "; open_box 0; alwaysfn a; close_box()
 576   | Ast0.WhenModifier x -> print_string "   WHEN "; U.print_when_modif x
 577   | Ast0.WhenNotTrue a ->
 578       print_string "   WHEN != TRUE "; open_box 0; expression a; close_box()
 579   | Ast0.WhenNotFalse a ->
 580       print_string "   WHEN != FALSE "; open_box 0; expression a; close_box()
 581
 582 and case_line arity c =
 583   print_context c
 584     (function _ ->
 585       match Ast0.unwrap c with
 586         Ast0.Default(def,colon,code) ->
 587           print_string arity;
 588           mcode print_string def; mcode print_string colon; print_string " ";
 589           dots force_newline (statement arity) code
 590       | Ast0.Case(case,exp,colon,code) ->
 591           print_string arity;
 592           mcode print_string case; print_string " "; expression exp;
 593           mcode print_string colon; print_string " ";
 594           dots force_newline (statement arity) code
 595       | Ast0.DisjCase(starter,case_lines,mids,ender) ->
 596           print_string "\n("; force_newline();
 597           print_between
 598             (function _ -> print_string "\n|"; force_newline())
 599             (case_line arity) case_lines;
 600           print_string "\n)"
 601       | Ast0.OptCase(case) -> case_line "?" case)
 602
 603 and statement_dots l = dots (function _ -> ()) (statement "") l
 604 and case_dots l = dots (function _ -> ()) (case_line "") l
 605
 606 (* --------------------------------------------------------------------- *)
 607 (* Top level code *)
 608
 609 let top_level t =
 610   print_context t
 611     (function _ ->
 612       match Ast0.unwrap t with
 613         Ast0.FILEINFO(old_file,new_file) ->
 614           print_string "--- "; mcode print_string old_file; force_newline();
 615           print_string "+++ "; mcode print_string new_file
 616       | Ast0.DECL(stmt) -> statement "" stmt
 617       | Ast0.CODE(stmt_dots) ->
 618           dots force_newline (statement "") stmt_dots
 619       | Ast0.ERRORWORDS(exps) ->
 620           print_string "error words = [";
 621           print_between (function _ -> print_string ", ") expression exps;
 622           print_string "]"
 623       | Ast0.OTHER(s) ->
 624           print_string "OTHER("; statement "" s; print_string ")")
 625
 626 let rule =
 627   print_between (function _ -> force_newline(); force_newline()) top_level
 628
 629 let unparse_anything x =
 630   let q = !quiet in
 631   quiet := true;
 632   (match x with
 633     Ast0.DotsExprTag(d) ->
 634       print_string "ExpDots:"; force_newline();
 635       expression_dots d
 636   | Ast0.DotsParamTag(d) ->
 637       parameter_list d
 638   | Ast0.DotsInitTag(d) ->
 639       initialiser_list d
 640   | Ast0.DotsStmtTag(d) ->
 641       print_string "StmDots:"; force_newline();
 642       statement_dots d
 643   | Ast0.DotsDeclTag(d) ->
 644       declaration_dots d
 645   | Ast0.DotsCaseTag(d) ->
 646       case_dots d
 647   | Ast0.IdentTag(d) ->
 648       ident d
 649   | Ast0.ExprTag(d) | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 650       print_string "Exp:"; force_newline();
 651       expression d
 652   | Ast0.TypeCTag(d) ->
 653       typeC d
 654   | Ast0.ParamTag(d) ->
 655       parameterTypeDef d
 656   | Ast0.InitTag(d) ->
 657       initialiser d
 658   | Ast0.DeclTag(d) ->
 659       declaration d
 660   | Ast0.StmtTag(d) ->
 661       print_string "Stm:"; force_newline();
 662       statement "" d
 663   | Ast0.CaseLineTag(d) ->
 664       case_line "" d
 665   | Ast0.TopTag(d) ->
 666       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)