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 / pretty_print_cocci.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
C		 23open Format
24module Ast = Ast_cocci
25
26let print_plus_flag = ref true
27let print_minus_flag = ref true
28let print_newlines_disj = ref true
29
30let start_block str =
31 force_newline(); print_string " "; open_box 0
32
33let end_block str =
34 close_box(); force_newline ()
35
36let print_string_box s = print_string s; open_box 0
37
38
39let print_option = Common.do_option
40let print_between = Common.print_between
41
42(* --------------------------------------------------------------------- *)
43(* Modified code *)
44
45(* avoid polyvariance problems *)
46let anything : (Ast.anything -> unit) ref = ref (function _ -> ())
47
48let rec print_anything str = function
49 [] -> ()
50 | stream ->
51 start_block();
52 print_between force_newline
53 (function x ->
54 print_string str; open_box 0; print_anything_list x; close_box())
55 stream;
56 end_block()
57
58and print_anything_list = function
59 [] -> ()
60 | [x] -> !anything x
61 | bef::((aft::_) as rest) ->
62 !anything bef;
63 let space =
64 (match bef with
65 Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
66 | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_)
67 | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or
68 (match aft with
69 Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
70 | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
71 | _ -> false) in
72 if space then print_string " ";
73 print_anything_list rest
74
75let print_around printer term = function
76 Ast.NOTHING -> printer term
951c7801
C		 77 | Ast.BEFORE(bef,_) -> print_anything "<<< " bef; printer term
78 | Ast.AFTER(aft,_) -> printer term; print_anything ">>> " aft
79 | Ast.BEFOREAFTER(bef,aft,_) ->
34e49164
C		 80 print_anything "<<< " bef; printer term; print_anything ">>> " aft
81
82let print_string_befaft fn x info =
c3e37e97
C		 83 let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
84 List.iter (function (s,_,_) -> print s; force_newline()) info.Ast.strbef;
34e49164 85 fn x;
c3e37e97 86 List.iter (function (s,_,_) -> force_newline(); print s) info.Ast.straft
34e49164
C		 87
88let print_meta (r,x) = print_string r; print_string ":"; print_string x
89
90let print_pos = function
91 Ast.MetaPos(name,_,_,_,_) ->
92 let name = Ast.unwrap_mcode name in
93 print_string "@"; print_meta name
94 | _ -> ()
95
96let mcode fn = function
708f4980 97 (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) ->
34e49164
C		 98 if !print_minus_flag
99 then print_string (if !Flag.sgrep_mode2 then "*" else "-");
100 fn x; print_pos pos;
faf9a90c 101 if !print_plus_flag
34e49164 102 then print_anything ">>> " plus_stream
faf9a90c 103 | (x, _, Ast.CONTEXT(_,plus_streams), pos) ->
34e49164
C		 104 if !print_plus_flag
105 then
106 let fn x = fn x; print_pos pos in
107 print_around fn x plus_streams
108 else (fn x; print_pos pos)
951c7801 109 | (x, info, Ast.PLUS _, pos) ->
34e49164
C		 110 let fn x = fn x; print_pos pos in
111 print_string_befaft fn x info
112
faf9a90c 113let print_mcodekind = function
708f4980 114 Ast.MINUS(_,_,_,plus_stream) ->
34e49164
C		 115 print_string "MINUS";
116 print_anything ">>> " plus_stream
117 | Ast.CONTEXT(_,plus_streams) ->
118 print_around (function _ -> print_string "CONTEXT") () plus_streams
951c7801 119 | Ast.PLUS _ -> print_string "PLUS"
34e49164
C		 120
121(* --------------------------------------------------------------------- *)
122(* --------------------------------------------------------------------- *)
123(* Dots *)
124
125let dots between fn d =
126 match Ast.unwrap d with
127 Ast.DOTS(l) -> print_between between fn l
128 | Ast.CIRCLES(l) -> print_between between fn l
129 | Ast.STARS(l) -> print_between between fn l
130
131let nest_dots multi fn f d =
132 let mo s = if multi then "<+"^s else "<"^s in
133 let mc s = if multi then s^"+>" else s^">" in
134 match Ast.unwrap d with
135 Ast.DOTS(l) ->
136 print_string (mo "..."); f(); start_block();
137 print_between force_newline fn l;
138 end_block(); print_string (mc "...")
139 | Ast.CIRCLES(l) ->
140 print_string (mo "ooo"); f(); start_block();
141 print_between force_newline fn l;
142 end_block(); print_string (mc "ooo")
143 | Ast.STARS(l) ->
144 print_string (mo "***"); f(); start_block();
145 print_between force_newline fn l;
146 end_block(); print_string (mc "***")
147
148(* --------------------------------------------------------------------- *)
149
150let print_type keep info = function
151 None -> ()
152 (* print_string "/* ";
153 print_string "keep:"; print_unitary keep;
154 print_string " inherited:"; print_bool inherited;
155 print_string " */"*)
156 | Some ty -> ()
157 (*;
158 print_string "/* ";
159 print_between (function _ -> print_string ", ") Type_cocci.typeC ty;(*
160 print_string "keep:"; print_unitary keep;
161 print_string " inherited:"; print_bool inherited;*)
162 print_string " */"*)
163
951c7801
C		 164(* --------------------------------------------------------------------- *)
165(* Contraint on Identifier and Function *)
166(* FIXME: Not called at the moment *)
167
168let idconstraint c =
169 match c with
170 Ast.IdNoConstraint -> print_string "/* No constraint */"
171 | Ast.IdNegIdSet ids -> List.iter (fun s -> print_string (" "^s)) ids
172 | Ast.IdRegExp (re,_) -> print_string "~= \""; print_string re; print_string "\""
173 | Ast.IdNotRegExp (re,_) -> print_string "~!= \""; print_string re; print_string "\""
174
34e49164
C		 175(* --------------------------------------------------------------------- *)
176(* Identifier *)
177
178let rec ident i =
179 match Ast.unwrap i with
951c7801
C		 180 Ast.Id(name) -> mcode print_string name
181 | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
182 | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
183 | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
184 | Ast.OptIdent(id) -> print_string "?"; ident id
185 | Ast.UniqueIdent(id) -> print_string "!"; ident id
34e49164
C		 186
187and print_unitary = function
188 Type_cocci.Unitary -> print_string "unitary"
189 | Type_cocci.Nonunitary -> print_string "nonunitary"
190 | Type_cocci.Saved -> print_string "saved"
191
192(* --------------------------------------------------------------------- *)
193(* Expression *)
194
195let print_disj_list fn l =
196 if !print_newlines_disj
197 then (force_newline(); print_string "("; force_newline())
198 else print_string "(";
199 print_between
200 (function _ ->
201 if !print_newlines_disj
202 then (force_newline(); print_string "|"; force_newline())
203 else print_string " | ")
204 fn l;
205 if !print_newlines_disj
206 then (force_newline(); print_string ")"; force_newline())
207 else print_string ")"
208
209let rec expression e =
210 match Ast.unwrap e with
211 Ast.Ident(id) -> ident id
212 | Ast.Constant(const) -> mcode constant const
213 | Ast.FunCall(fn,lp,args,rp) ->
214 expression fn; mcode print_string_box lp;
215 dots (function _ -> ()) expression args;
216 close_box(); mcode print_string rp
217 | Ast.Assignment(left,op,right,simple) ->
218 expression left; print_string " "; mcode assignOp op;
219 print_string " "; expression right
220 | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
221 expression exp1; print_string " "; mcode print_string why;
222 print_option (function e -> print_string " "; expression e) exp2;
223 print_string " "; mcode print_string colon; expression exp3
224 | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
225 | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
226 | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
227 | Ast.Binary(left,op,right) ->
228 expression left; print_string " "; mcode binaryOp op; print_string " ";
229 expression right
230 | Ast.Nested(left,op,right) ->
231 expression left; print_string " "; mcode binaryOp op; print_string " ";
232 expression right
233 | Ast.Paren(lp,exp,rp) ->
234 mcode print_string_box lp; expression exp; close_box();
235 mcode print_string rp
236 | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
237 expression exp1; mcode print_string_box lb; expression exp2; close_box();
238 mcode print_string rb
239 | Ast.RecordAccess(exp,pt,field) ->
240 expression exp; mcode print_string pt; ident field
241 | Ast.RecordPtAccess(exp,ar,field) ->
242 expression exp; mcode print_string ar; ident field
243 | Ast.Cast(lp,ty,rp,exp) ->
244 mcode print_string_box lp; fullType ty; close_box();
245 mcode print_string rp; expression exp
246 | Ast.SizeOfExpr(sizeof,exp) ->
247 mcode print_string sizeof; expression exp
248 | Ast.SizeOfType(sizeof,lp,ty,rp) ->
249 mcode print_string sizeof;
250 mcode print_string_box lp; fullType ty; close_box();
251 mcode print_string rp
252 | Ast.TypeExp(ty) -> fullType ty
253
254 | Ast.MetaErr(name,_,_,_) -> mcode print_meta name
255 | Ast.MetaExpr(name,_,keep,ty,form,inherited) ->
256 mcode print_meta name; print_type keep inherited ty
257 | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name
258 | Ast.EComma(cm) -> mcode print_string cm; print_space()
259 | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list
260 | Ast.NestExpr(expr_dots,Some whencode,multi) ->
261 nest_dots multi expression
262 (function _ -> print_string " when != "; expression whencode)
263 expr_dots
264 | Ast.NestExpr(expr_dots,None,multi) ->
265 nest_dots multi expression (function _ -> ()) expr_dots
266 | Ast.Edots(dots,Some whencode)
267 | Ast.Ecircles(dots,Some whencode)
268 | Ast.Estars(dots,Some whencode) ->
269 mcode print_string dots; print_string " when != "; expression whencode
270 | Ast.Edots(dots,None)
271 | Ast.Ecircles(dots,None)
272 | Ast.Estars(dots,None) -> mcode print_string dots
273 | Ast.OptExp(exp) -> print_string "?"; expression exp
274 | Ast.UniqueExp(exp) -> print_string "!"; expression exp
275
276and unaryOp = function
277 Ast.GetRef -> print_string "&"
278 | Ast.DeRef -> print_string "*"
279 | Ast.UnPlus -> print_string "+"
280 | Ast.UnMinus -> print_string "-"
281 | Ast.Tilde -> print_string "~"
282 | Ast.Not -> print_string "!"
283
284and assignOp = function
285 Ast.SimpleAssign -> print_string "="
286 | Ast.OpAssign(aop) -> arithOp aop; print_string "="
287
288and fixOp = function
289 Ast.Dec -> print_string "--"
290 | Ast.Inc -> print_string "++"
291
292and binaryOp = function
293 Ast.Arith(aop) -> arithOp aop
294 | Ast.Logical(lop) -> logicalOp lop
295
296and arithOp = function
297 Ast.Plus -> print_string "+"
298 | Ast.Minus -> print_string "-"
299 | Ast.Mul -> print_string "*"
300 | Ast.Div -> print_string "/"
301 | Ast.Mod -> print_string "%"
302 | Ast.DecLeft -> print_string "<<"
303 | Ast.DecRight -> print_string ">>"
304 | Ast.And -> print_string "&"
305 | Ast.Or -> print_string "|"
306 | Ast.Xor -> print_string "^"
307
308and logicalOp = function
309 Ast.Inf -> print_string "<"
310 | Ast.Sup -> print_string ">"
311 | Ast.InfEq -> print_string "<="
312 | Ast.SupEq -> print_string ">="
313 | Ast.Eq -> print_string "=="
314 | Ast.NotEq -> print_string "!="
315 | Ast.AndLog -> print_string "&&"
316 | Ast.OrLog -> print_string "||"
317
318and constant = function
319 Ast.String(s) -> print_string "\""; print_string s; print_string "\""
320 | Ast.Char(s) -> print_string "'"; print_string s; print_string "'"
321 | Ast.Int(s) -> print_string s
322 | Ast.Float(s) -> print_string s
323
324(* --------------------------------------------------------------------- *)
325(* Declarations *)
326
327and storage = function
328 Ast.Static -> print_string "static "
329 | Ast.Auto -> print_string "auto "
330 | Ast.Register -> print_string "register "
331 | Ast.Extern -> print_string "extern "
332
333(* --------------------------------------------------------------------- *)
334(* Types *)
335
336and fullType ft =
337 match Ast.unwrap ft with
338 Ast.Type(cv,ty) ->
339 print_option (function x -> mcode const_vol x; print_string " ") cv;
340 typeC ty
341 | Ast.DisjType(decls) -> print_disj_list fullType decls
342 | Ast.OptType(ty) -> print_string "?"; fullType ty
343 | Ast.UniqueType(ty) -> print_string "!"; fullType ty
344
345and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
346 fullType ty; mcode print_string lp1; mcode print_string star; fn();
347 mcode print_string rp1; mcode print_string lp1;
348 parameter_list params; mcode print_string rp2
349
350and print_function_type (ty,lp1,params,rp1) fn =
351 print_option fullType ty; fn(); mcode print_string lp1;
352 parameter_list params; mcode print_string rp1
353
354and print_fninfo = function
355 Ast.FStorage(stg) -> mcode storage stg
356 | Ast.FType(ty) -> fullType ty
357 | Ast.FInline(inline) -> mcode print_string inline; print_string " "
358 | Ast.FAttr(attr) -> mcode print_string attr; print_string " "
359
360and typeC ty =
361 match Ast.unwrap ty with
faf9a90c
C		 362 Ast.BaseType(ty,strings) ->
363 List.iter (function s -> mcode print_string s; print_string " ") strings
364 | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option typeC ty
34e49164
C		 365 | Ast.Pointer(ty,star) -> fullType ty; mcode print_string star
366 | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
367 print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
368 (function _ -> ())
369 | Ast.FunctionType (_,ty,lp1,params,rp1) ->
370 print_function_type (ty,lp1,params,rp1) (function _ -> ())
371 | Ast.Array(ty,lb,size,rb) ->
372 fullType ty; mcode print_string lb; print_option expression size;
373 mcode print_string rb
faf9a90c
C		 374 | Ast.EnumName(kind,name) -> mcode print_string kind; print_string " ";
375 ident name
34e49164
C		 376 | Ast.StructUnionName(kind,name) ->
377 mcode structUnion kind;
378 print_option (function x -> ident x; print_string " ") name
379 | Ast.StructUnionDef(ty,lb,decls,rb) ->
380 fullType ty; mcode print_string lb;
381 dots force_newline declaration decls;
382 mcode print_string rb
383 | Ast.TypeName(name) -> mcode print_string name; print_string " "
384 | Ast.MetaType(name,_,_) ->
385 mcode print_meta name; print_string " "
386
387and baseType = function
388 Ast.VoidType -> print_string "void "
389 | Ast.CharType -> print_string "char "
390 | Ast.ShortType -> print_string "short "
391 | Ast.IntType -> print_string "int "
392 | Ast.DoubleType -> print_string "double "
393 | Ast.FloatType -> print_string "float "
394 | Ast.LongType -> print_string "long "
faf9a90c 395 | Ast.LongLongType -> print_string "long long "
34e49164
C		 396
397and structUnion = function
398 Ast.Struct -> print_string "struct "
399 | Ast.Union -> print_string "union "
400
401and sign = function
402 Ast.Signed -> print_string "signed "
403 | Ast.Unsigned -> print_string "unsigned "
404
405and const_vol = function
406 Ast.Const -> print_string "const"
407 | Ast.Volatile -> print_string "volatile"
408
409(* --------------------------------------------------------------------- *)
410(* Variable declaration *)
411(* Even if the Cocci program specifies a list of declarations, they are
412 split out into multiple declarations of a single variable each. *)
413
414and print_named_type ty id =
415 match Ast.unwrap ty with
416 Ast.Type(None,ty1) ->
417 (match Ast.unwrap ty1 with
418 Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
419 print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
420 (function _ -> print_string " "; ident id)
421 | Ast.FunctionType(_,ty,lp1,params,rp1) ->
422 print_function_type (ty,lp1,params,rp1)
423 (function _ -> print_string " "; ident id)
424 | Ast.Array(ty,lb,size,rb) ->
425 let rec loop ty k =
426 match Ast.unwrap ty with
427 Ast.Array(ty,lb,size,rb) ->
428 (match Ast.unwrap ty with
429 Ast.Type(None,ty) ->
430 loop ty
431 (function _ ->
432 k ();
433 mcode print_string lb;
434 print_option expression size;
435 mcode print_string rb)
436 | _ -> failwith "complex array types not supported")
437 | _ -> typeC ty; ident id; k () in
438 loop ty1 (function _ -> ())
439 | _ -> fullType ty; ident id)
440 | _ -> fullType ty; ident id
441
442and declaration d =
443 match Ast.unwrap d with
444 Ast.Init(stg,ty,id,eq,ini,sem) ->
445 print_option (mcode storage) stg; print_named_type ty id;
446 print_string " "; mcode print_string eq;
447 print_string " "; initialiser ini; mcode print_string sem
448 | Ast.UnInit(stg,ty,id,sem) ->
449 print_option (mcode storage) stg; print_named_type ty id;
450 mcode print_string sem
451 | Ast.MacroDecl(name,lp,args,rp,sem) ->
452 ident name; mcode print_string_box lp;
453 dots (function _ -> ()) expression args;
454 close_box(); mcode print_string rp; mcode print_string sem
455 | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
456 | Ast.Typedef(stg,ty,id,sem) ->
457 mcode print_string stg; print_string " "; fullType ty; typeC id;
458 mcode print_string sem
459 | Ast.DisjDecl(decls) -> print_disj_list declaration decls
faf9a90c 460 | Ast.Ddots(dots,Some whencode) ->
34e49164
C		 461 mcode print_string dots; print_string " when != "; declaration whencode
462 | Ast.Ddots(dots,None) -> mcode print_string dots
463 | Ast.MetaDecl(name,_,_) -> mcode print_meta name
464 | Ast.OptDecl(decl) -> print_string "?"; declaration decl
465 | Ast.UniqueDecl(decl) -> print_string "!"; declaration decl
466
467(* --------------------------------------------------------------------- *)
468(* Initialiser *)
469
470and initialiser i =
471 match Ast.unwrap i with
113803cf
C		 472 Ast.MetaInit(name,_,_) ->
473 mcode print_meta name; print_string " "
474 | Ast.InitExpr(exp) -> expression exp
34e49164
C		 475 | Ast.InitList(lb,initlist,rb,whencode) ->
476 mcode print_string lb; open_box 0;
477 if not (whencode = [])
478 then
479 (print_string " WHEN != ";
480 print_between (function _ -> print_string " v ")
481 initialiser whencode;
482 force_newline());
483 List.iter initialiser initlist; close_box();
484 mcode print_string rb
113803cf
C		 485 | Ast.InitGccExt(designators,eq,ini) ->
486 List.iter designator designators; print_string " ";
34e49164
C		 487 mcode print_string eq; print_string " "; initialiser ini
488 | Ast.InitGccName(name,eq,ini) ->
489 ident name; mcode print_string eq; initialiser ini
34e49164
C		 490 | Ast.IComma(comma) -> mcode print_string comma; force_newline()
491 | Ast.OptIni(ini) -> print_string "?"; initialiser ini
492 | Ast.UniqueIni(ini) -> print_string "!"; initialiser ini
493
113803cf
C		 494and designator = function
495 Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id
496 | Ast.DesignatorIndex(lb,exp,rb) ->
497 mcode print_string lb; expression exp; mcode print_string rb
498 | Ast.DesignatorRange(lb,min,dots,max,rb) ->
499 mcode print_string lb; expression min; mcode print_string dots;
500 expression max; mcode print_string rb
501
34e49164
C		 502(* --------------------------------------------------------------------- *)
503(* Parameter *)
504
505and parameterTypeDef p =
506 match Ast.unwrap p with
507 Ast.VoidParam(ty) -> fullType ty
508 | Ast.Param(ty,Some id) -> print_named_type ty id
509 | Ast.Param(ty,None) -> fullType ty
510 | Ast.MetaParam(name,_,_) -> mcode print_meta name
511 | Ast.MetaParamList(name,_,_,_) -> mcode print_meta name
512 | Ast.PComma(cm) -> mcode print_string cm; print_space()
513 | Ast.Pdots(dots) -> mcode print_string dots
514 | Ast.Pcircles(dots) -> mcode print_string dots
515 | Ast.OptParam(param) -> print_string "?"; parameterTypeDef param
516 | Ast.UniqueParam(param) -> print_string "!"; parameterTypeDef param
517
518and parameter_list l = dots (function _ -> ()) parameterTypeDef l
519
520(* --------------------------------------------------------------------- *)
521(* Top-level code *)
522
523let rec rule_elem arity re =
524 match Ast.unwrap re with
525 Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
526 mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
527 print_string arity; List.iter print_fninfo fninfo;
528 ident name; mcode print_string_box lp;
529 parameter_list params; close_box(); mcode print_string rp;
530 print_string " "
531 | Ast.Decl(bef,allminus,decl) ->
532 mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
533 print_string arity;
534 declaration decl
535 | Ast.SeqStart(brace) ->
536 print_string arity; mcode print_string brace;
537 if !print_newlines_disj then start_block()
538 | Ast.SeqEnd(brace) ->
539 if !print_newlines_disj then end_block();
540 print_string arity; mcode print_string brace
541 | Ast.ExprStatement(exp,sem) ->
542 print_string arity; expression exp; mcode print_string sem
543 | Ast.IfHeader(iff,lp,exp,rp) ->
544 print_string arity;
545 mcode print_string iff; print_string " "; mcode print_string_box lp;
546 expression exp; close_box(); mcode print_string rp; print_string " "
547 | Ast.Else(els) ->
548 print_string arity; mcode print_string els; print_string " "
549 | Ast.WhileHeader(whl,lp,exp,rp) ->
550 print_string arity;
551 mcode print_string whl; print_string " "; mcode print_string_box lp;
552 expression exp; close_box(); mcode print_string rp; print_string " "
553 | Ast.DoHeader(d) ->
554 print_string arity; mcode print_string d; print_string " "
555 | Ast.WhileTail(whl,lp,exp,rp,sem) ->
556 print_string arity;
557 mcode print_string whl; print_string " "; mcode print_string_box lp;
558 expression exp; close_box(); mcode print_string rp;
559 mcode print_string sem
560 | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
561 print_string arity;
562 mcode print_string fr; mcode print_string_box lp;
563 print_option expression e1; mcode print_string sem1;
564 print_option expression e2; mcode print_string sem2;
565 print_option expression e3; close_box();
566 mcode print_string rp; print_string " "
567 | Ast.IteratorHeader(nm,lp,args,rp) ->
568 print_string arity;
569 ident nm; print_string " "; mcode print_string_box lp;
570 dots (function _ -> ()) expression args; close_box();
571 mcode print_string rp; print_string " "
572 | Ast.SwitchHeader(switch,lp,exp,rp) ->
573 print_string arity;
574 mcode print_string switch; print_string " "; mcode print_string_box lp;
575 expression exp; close_box(); mcode print_string rp; print_string " "
576 | Ast.Break(br,sem) ->
577 print_string arity; mcode print_string br; mcode print_string sem
578 | Ast.Continue(cont,sem) ->
579 print_string arity; mcode print_string cont; mcode print_string sem
580 | Ast.Label(l,dd) -> ident l; mcode print_string dd
581 | Ast.Goto(goto,l,sem) ->
582 mcode print_string goto; ident l; mcode print_string sem
583 | Ast.Return(ret,sem) ->
584 print_string arity; mcode print_string ret; mcode print_string sem
585 | Ast.ReturnExpr(ret,exp,sem) ->
586 print_string arity; mcode print_string ret; print_string " ";
587 expression exp; mcode print_string sem
588 | Ast.MetaRuleElem(name,_,_) ->
589 print_string arity; mcode print_meta name
590 | Ast.MetaStmt(name,_,_,_) ->
591 print_string arity; mcode print_meta name
592 | Ast.MetaStmtList(name,_,_) ->
593 print_string arity; mcode print_meta name
594 | Ast.Exp(exp) -> print_string arity; expression exp
595 | Ast.TopExp(exp) -> print_string arity; expression exp
596 | Ast.Ty(ty) -> print_string arity; fullType ty
1be43e12 597 | Ast.TopInit(init) -> initialiser init
34e49164
C		 598 | Ast.Include(inc,s) ->
599 mcode print_string inc; print_string " "; mcode inc_file s
600 | Ast.DefineHeader(def,id,params) ->
601 mcode print_string def; print_string " "; ident id;
602 print_define_parameters params
603 | Ast.Default(def,colon) ->
604 mcode print_string def; mcode print_string colon; print_string " "
605 | Ast.Case(case,exp,colon) ->
606 mcode print_string case; print_string " "; expression exp;
607 mcode print_string colon; print_string " "
608 | Ast.DisjRuleElem(res) ->
609 print_string arity;
610 force_newline(); print_string "("; force_newline();
611 print_between
612 (function _ -> force_newline();print_string "|"; force_newline())
613 (rule_elem arity)
614 res;
615 force_newline(); print_string ")"
616
617
618and print_define_parameters params =
619 match Ast.unwrap params with
620 Ast.NoParams -> ()
621 | Ast.DParams(lp,params,rp) ->
622 mcode print_string lp;
623 dots (function _ -> ()) print_define_param params; mcode print_string rp
624
625and print_define_param param =
626 match Ast.unwrap param with
627 Ast.DParam(id) -> ident id
628 | Ast.DPComma(comma) -> mcode print_string comma
629 | Ast.DPdots(dots) -> mcode print_string dots
630 | Ast.DPcircles(circles) -> mcode print_string circles
631 | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp
632 | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp
633
634and statement arity s =
635 match Ast.unwrap s with
708f4980 636 Ast.Seq(lbrace,body,rbrace) ->
34e49164 637 rule_elem arity lbrace;
34e49164
C		 638 dots force_newline (statement arity) body;
639 rule_elem arity rbrace
640 | Ast.IfThen(header,branch,(_,_,_,aft)) ->
641 rule_elem arity header; statement arity branch;
642 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
643 | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
644 rule_elem arity header; statement arity branch1; print_string " ";
645 rule_elem arity els; statement arity branch2;
646 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
647 | Ast.While(header,body,(_,_,_,aft)) ->
648 rule_elem arity header; statement arity body;
649 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
650 | Ast.Do(header,body,tail) ->
651 rule_elem arity header; statement arity body;
652 rule_elem arity tail
653 | Ast.For(header,body,(_,_,_,aft)) ->
654 rule_elem arity header; statement arity body;
655 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
656 | Ast.Iterator(header,body,(_,_,_,aft)) ->
657 rule_elem arity header; statement arity body;
658 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
fc1ad971 659 | Ast.Switch(header,lb,decls,cases,rb) ->
34e49164 660 rule_elem arity header; rule_elem arity lb;
fc1ad971 661 dots force_newline (statement arity) decls;
34e49164
C		 662 List.iter (function x -> case_line arity x; force_newline()) cases;
663 rule_elem arity rb
664 | Ast.Atomic(re) -> rule_elem arity re
708f4980 665 | Ast.FunDecl(header,lbrace,body,rbrace) ->
34e49164 666 rule_elem arity header; rule_elem arity lbrace;
34e49164
C		 667 dots force_newline (statement arity) body;
668 rule_elem arity rbrace
669 | Ast.Disj([stmt_dots]) ->
670 print_string arity;
671 dots (function _ -> if !print_newlines_disj then force_newline())
672 (statement arity) stmt_dots
673 | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
674 print_string arity;
675 force_newline(); print_string "("; force_newline();
676 print_between
677 (function _ -> force_newline();print_string "|"; force_newline())
678 (dots force_newline (statement arity))
679 stmt_dots_list;
680 force_newline(); print_string ")"
681 | Ast.Define(header,body) ->
682 rule_elem arity header; print_string " ";
683 dots force_newline (statement arity) body
684 | Ast.Nest(stmt_dots,whn,multi,_,_) ->
685 print_string arity;
686 nest_dots multi (statement arity)
687 (function _ ->
688 open_box 0;
689 print_between force_newline
690 (whencode (dots force_newline (statement "")) (statement "")) whn;
691 close_box(); force_newline())
692 stmt_dots
693 | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
694 print_string arity; mcode print_string d;
695 open_box 0;
696 print_between force_newline
697 (whencode (dots force_newline (statement "")) (statement "")) whn;
698 close_box(); force_newline()
699 | Ast.OptStm(s) -> statement "?" s
700 | Ast.UniqueStm(s) -> statement "!" s
701
702and print_statement_when whencode =
703 print_string " WHEN != ";
704 open_box 0;
705 print_between (function _ -> print_string " &"; force_newline())
706 (dots force_newline (statement "")) whencode;
707 close_box()
708
709
710and whencode notfn alwaysfn = function
711 Ast.WhenNot a ->
712 print_string " WHEN != "; open_box 0; notfn a; close_box()
713 | Ast.WhenAlways a ->
714 print_string " WHEN = "; open_box 0; alwaysfn a; close_box()
715 | Ast.WhenModifier x -> print_string " WHEN "; print_when_modif x
1be43e12
C		 716 | Ast.WhenNotTrue a ->
717 print_string " WHEN != TRUE "; open_box 0; rule_elem "" a; close_box()
718 | Ast.WhenNotFalse a ->
719 print_string " WHEN != FALSE "; open_box 0; rule_elem "" a; close_box()
34e49164
C		 720
721and print_when_modif = function
722 | Ast.WhenAny -> print_string "ANY"
723 | Ast.WhenStrict -> print_string "STRICT"
724 | Ast.WhenForall -> print_string "FORALL"
725 | Ast.WhenExists -> print_string "EXISTS"
726
727and case_line arity c =
728 match Ast.unwrap c with
729 Ast.CaseLine(header,code) ->
730 rule_elem arity header; print_string " ";
731 dots force_newline (statement arity) code
732 | Ast.OptCase(case) -> case_line "?" case
733
734(* --------------------------------------------------------------------- *)
735(* CPP code *)
736
737and inc_file = function
738 Ast.Local(elems) ->
739 print_string "\"";
740 print_between (function _ -> print_string "/") inc_elem elems;
741 print_string "\""
742 | Ast.NonLocal(elems) ->
743 print_string "<";
744 print_between (function _ -> print_string "/") inc_elem elems;
745 print_string ">"
746
747and inc_elem = function
748 Ast.IncPath s -> print_string s
749 | Ast.IncDots -> print_string "..."
750
751(* for export only *)
752let statement_dots l = dots force_newline (statement "") l
753
754let top_level t =
755 match Ast.unwrap t with
756 Ast.FILEINFO(old_file,new_file) ->
757 print_string "--- "; mcode print_string old_file; force_newline();
758 print_string "+++ "; mcode print_string new_file
759 | Ast.DECL(stmt) -> statement "" stmt
760 | Ast.CODE(stmt_dots) ->
761 dots force_newline (statement "") stmt_dots
762 | Ast.ERRORWORDS(exps) ->
763 print_string "error words = [";
764 print_between (function _ -> print_string ", ") expression exps;
765 print_string "]"
766
767let rule =
768 print_between (function _ -> force_newline(); force_newline()) top_level
769
770let pp_print_anything x = !anything x
771
772let _ =
773 anything := function
774 Ast.FullTypeTag(x) -> fullType x
775 | Ast.BaseTypeTag(x) -> baseType x
776 | Ast.StructUnionTag(x) -> structUnion x
777 | Ast.SignTag(x) -> sign x
778 | Ast.IdentTag(x) -> ident x
779 | Ast.ExpressionTag(x) -> expression x
780 | Ast.ConstantTag(x) -> constant x
781 | Ast.UnaryOpTag(x) -> unaryOp x
782 | Ast.AssignOpTag(x) -> assignOp x
783 | Ast.FixOpTag(x) -> fixOp x
784 | Ast.BinaryOpTag(x) -> binaryOp x
785 | Ast.ArithOpTag(x) -> arithOp x
786 | Ast.LogicalOpTag(x) -> logicalOp x
787 | Ast.InitTag(x) -> initialiser x
788 | Ast.DeclarationTag(x) -> declaration x
789 | Ast.StorageTag(x) -> storage x
790 | Ast.IncFileTag(x) -> inc_file x
791 | Ast.Rule_elemTag(x) -> rule_elem "" x
792 | Ast.StatementTag(x) -> statement "" x
793 | Ast.CaseLineTag(x) -> case_line "" x
794 | Ast.ConstVolTag(x) -> const_vol x
795 | Ast.Token(x,Some info) -> print_string_befaft print_string x info
796 | Ast.Token(x,None) -> print_string x
c3e37e97
C		 797 | Ast.Pragma(xs) ->
798 let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
799 print_between force_newline print xs
34e49164
C		 800 | Ast.Code(x) -> let _ = top_level x in ()
801 | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x
802 | Ast.ParamDotsTag(x) -> parameter_list x
803 | Ast.StmtDotsTag(x) -> dots (function _ -> ()) (statement "") x
804 | Ast.DeclDotsTag(x) -> dots (function _ -> ()) declaration x
805 | Ast.TypeCTag(x) -> typeC x
806 | Ast.ParamTag(x) -> parameterTypeDef x
807 | Ast.SgrepStartTag(x) -> print_string x
808 | Ast.SgrepEndTag(x) -> print_string x
809
810let rec dep in_and = function
811 Ast.Dep(s) -> print_string s
812 | Ast.AntiDep(s) -> print_string "!"; print_string s
813 | Ast.EverDep(s) -> print_string "ever "; print_string s
814 | Ast.NeverDep(s) -> print_string "never "; print_string s
815 | Ast.AndDep(s1,s2) ->
816 let print_and _ = dep true s1; print_string " && "; dep true s2 in
817 if in_and
818 then print_and ()
819 else (print_string "("; print_and(); print_string ")")
820 | Ast.OrDep(s1,s2) ->
821 let print_or _ = dep false s1; print_string " || "; dep false s2 in
822 if not in_and
823 then print_or ()
824 else (print_string "("; print_or(); print_string ")")
7f004419
C		 825 | Ast.NoDep -> print_string "no_dep"
826 | Ast.FailDep -> print_string "fail_dep"
34e49164 827
c3e37e97
C		 828let script_header str lang deps code =
829 print_string "@@";
830 force_newline();
831 print_string (str ^ ":" ^ lang);
832 (match deps with
833 Ast.NoDep -> ()
834 | _ -> print_string " depends on "; dep true deps);
835 force_newline();
836 print_string "@@";
837 force_newline();
838 print_string code;
839 force_newline()
840
34e49164
C		 841let unparse z =
842 match z with
c3e37e97
C		 843 Ast.InitialScriptRule (lang,deps,code) ->
844 script_header "initialize" lang deps code
845 | Ast.FinalScriptRule (lang,deps,code) ->
846 script_header "finalize" lang deps code
b1b2de81 847 | Ast.ScriptRule (lang,deps,bindings,code) ->
c3e37e97 848 script_header "script" lang deps code
faf9a90c 849 | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) ->
b1b2de81
C		 850 print_string "@@";
851 force_newline();
852 print_string nm;
853 (match deps with
854 Ast.NoDep -> ()
855 | _ -> print_string " depends on "; dep true deps);
34e49164
C		 856 (*
857 print_string "line ";
858 print_int (Ast.get_line (List.hd x));
859 *)
b1b2de81
C		 860 force_newline();
861 print_string "@@";
862 print_newlines_disj := true;
863 force_newline();
864 force_newline();
865 rule x;
866 force_newline()
34e49164
C		 867
868let rule_elem_to_string x =
869 print_newlines_disj := true;
870 Common.format_to_string (function _ -> rule_elem "" x)
871
872let ident_to_string x =
873 print_newlines_disj := true;
874 Common.format_to_string (function _ -> ident x)
875
876let unparse_to_string x =
877 print_newlines_disj := true;
878 Common.format_to_string (function _ -> unparse x)
879
880let print_rule_elem re =
881 let nl = !print_newlines_disj in
882 print_newlines_disj := false;
883 rule_elem "" re;
884 print_newlines_disj := nl
885
Unnamed repository; edit this file 'description' to name the repository.