parsing_cocci/unparse_ast0.ml

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