parsing_cocci/unparse_ast0.ml

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