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