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