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