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