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