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