parsing_cocci/unparse_ast0.ml

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