2 * Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 module Ast = Ast_cocci
26 let print_plus_flag = ref true
27 let print_minus_flag = ref true
28 let print_newlines_disj = ref true
31 force_newline(); print_string " "; open_box 0
34 close_box(); force_newline ()
36 let print_string_box s = print_string s; open_box 0
39 let print_option = Common.do_option
40 let print_between = Common.print_between
42 (* --------------------------------------------------------------------- *)
45 (* avoid polyvariance problems *)
46 let anything : (Ast.anything -> unit) ref = ref (function _ -> ())
48 let rec print_anything str = function
52 print_between force_newline
54 print_string str; open_box 0; print_anything_list x; close_box())
58 and print_anything_list = function
61 | bef::((aft::_) as rest) ->
65 Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
66 | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_)
67 | Ast.Token("if",_) | Ast.Token("while",_) -> true | _ -> false) or
69 Ast.Rule_elemTag(_) | Ast.AssignOpTag(_) | Ast.BinaryOpTag(_)
70 | Ast.ArithOpTag(_) | Ast.LogicalOpTag(_) | Ast.Token("{",_) -> true
72 if space then print_string " ";
73 print_anything_list rest
75 let print_around printer term = function
76 Ast.NOTHING -> printer term
77 | Ast.BEFORE(bef) -> print_anything "<<< " bef; printer term
78 | Ast.AFTER(aft) -> printer term; print_anything ">>> " aft
79 | Ast.BEFOREAFTER(bef,aft) ->
80 print_anything "<<< " bef; printer term; print_anything ">>> " aft
82 let print_string_befaft fn x info =
83 List.iter (function s -> print_string s; force_newline())
86 List.iter (function s -> force_newline(); print_string s)
89 let print_meta (r,x) = print_string r; print_string ":"; print_string x
91 let print_pos = function
92 Ast.MetaPos(name,_,_,_,_) ->
93 let name = Ast.unwrap_mcode name in
94 print_string "@"; print_meta name
97 let mcode fn = function
98 (x, _, Ast.MINUS(_,plus_stream), pos) ->
100 then print_string (if !Flag.sgrep_mode2 then "*" else "-");
103 then print_anything ">>> " plus_stream
104 | (x, _, Ast.CONTEXT(_,plus_streams), pos) ->
107 let fn x = fn x; print_pos pos in
108 print_around fn x plus_streams
109 else (fn x; print_pos pos)
110 | (x, info, Ast.PLUS, pos) ->
111 let fn x = fn x; print_pos pos in
112 print_string_befaft fn x info
114 let print_mcodekind = function
115 Ast.MINUS(_,plus_stream) ->
116 print_string "MINUS";
117 print_anything ">>> " plus_stream
118 | Ast.CONTEXT(_,plus_streams) ->
119 print_around (function _ -> print_string "CONTEXT") () plus_streams
120 | Ast.PLUS -> print_string "PLUS"
122 (* --------------------------------------------------------------------- *)
123 (* --------------------------------------------------------------------- *)
126 let 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
132 let 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
137 print_string (mo "..."); f(); start_block();
138 print_between force_newline fn l;
139 end_block(); print_string (mc "...")
141 print_string (mo "ooo"); f(); start_block();
142 print_between force_newline fn l;
143 end_block(); print_string (mc "ooo")
145 print_string (mo "***"); f(); start_block();
146 print_between force_newline fn l;
147 end_block(); print_string (mc "***")
149 (* --------------------------------------------------------------------- *)
151 let print_type keep info = function
153 (* print_string "/* ";
154 print_string "keep:"; print_unitary keep;
155 print_string " inherited:"; print_bool inherited;
160 print_between (function _ -> print_string ", ") Type_cocci.typeC ty;(*
161 print_string "keep:"; print_unitary keep;
162 print_string " inherited:"; print_bool inherited;*)
165 (* --------------------------------------------------------------------- *)
169 match Ast.unwrap i with
170 Ast.Id(name) -> mcode print_string name
171 | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name
172 | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name
173 | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name
174 | Ast.OptIdent(id) -> print_string "?"; ident id
175 | Ast.UniqueIdent(id) -> print_string "!"; ident id
177 and print_unitary = function
178 Type_cocci.Unitary -> print_string "unitary"
179 | Type_cocci.Nonunitary -> print_string "nonunitary"
180 | Type_cocci.Saved -> print_string "saved"
182 (* --------------------------------------------------------------------- *)
185 let print_disj_list fn l =
186 if !print_newlines_disj
187 then (force_newline(); print_string "("; force_newline())
188 else print_string "(";
191 if !print_newlines_disj
192 then (force_newline(); print_string "|"; force_newline())
193 else print_string " | ")
195 if !print_newlines_disj
196 then (force_newline(); print_string ")"; force_newline())
197 else print_string ")"
199 let rec expression e =
200 match Ast.unwrap e with
201 Ast.Ident(id) -> ident id
202 | Ast.Constant(const) -> mcode constant const
203 | Ast.FunCall(fn,lp,args,rp) ->
204 expression fn; mcode print_string_box lp;
205 dots (function _ -> ()) expression args;
206 close_box(); mcode print_string rp
207 | Ast.Assignment(left,op,right,simple) ->
208 expression left; print_string " "; mcode assignOp op;
209 print_string " "; expression right
210 | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
211 expression exp1; print_string " "; mcode print_string why;
212 print_option (function e -> print_string " "; expression e) exp2;
213 print_string " "; mcode print_string colon; expression exp3
214 | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
215 | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
216 | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
217 | Ast.Binary(left,op,right) ->
218 expression left; print_string " "; mcode binaryOp op; print_string " ";
220 | Ast.Nested(left,op,right) ->
221 expression left; print_string " "; mcode binaryOp op; print_string " ";
223 | Ast.Paren(lp,exp,rp) ->
224 mcode print_string_box lp; expression exp; close_box();
225 mcode print_string rp
226 | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
227 expression exp1; mcode print_string_box lb; expression exp2; close_box();
228 mcode print_string rb
229 | Ast.RecordAccess(exp,pt,field) ->
230 expression exp; mcode print_string pt; ident field
231 | Ast.RecordPtAccess(exp,ar,field) ->
232 expression exp; mcode print_string ar; ident field
233 | Ast.Cast(lp,ty,rp,exp) ->
234 mcode print_string_box lp; fullType ty; close_box();
235 mcode print_string rp; expression exp
236 | Ast.SizeOfExpr(sizeof,exp) ->
237 mcode print_string sizeof; expression exp
238 | Ast.SizeOfType(sizeof,lp,ty,rp) ->
239 mcode print_string sizeof;
240 mcode print_string_box lp; fullType ty; close_box();
241 mcode print_string rp
242 | Ast.TypeExp(ty) -> fullType ty
244 | Ast.MetaErr(name,_,_,_) -> mcode print_meta name
245 | Ast.MetaExpr(name,_,keep,ty,form,inherited) ->
246 mcode print_meta name; print_type keep inherited ty
247 | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name
248 | Ast.EComma(cm) -> mcode print_string cm; print_space()
249 | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list
250 | Ast.NestExpr(expr_dots,Some whencode,multi) ->
251 nest_dots multi expression
252 (function _ -> print_string " when != "; expression whencode)
254 | Ast.NestExpr(expr_dots,None,multi) ->
255 nest_dots multi expression (function _ -> ()) expr_dots
256 | Ast.Edots(dots,Some whencode)
257 | Ast.Ecircles(dots,Some whencode)
258 | Ast.Estars(dots,Some whencode) ->
259 mcode print_string dots; print_string " when != "; expression whencode
260 | Ast.Edots(dots,None)
261 | Ast.Ecircles(dots,None)
262 | Ast.Estars(dots,None) -> mcode print_string dots
263 | Ast.OptExp(exp) -> print_string "?"; expression exp
264 | Ast.UniqueExp(exp) -> print_string "!"; expression exp
266 and unaryOp = function
267 Ast.GetRef -> print_string "&"
268 | Ast.DeRef -> print_string "*"
269 | Ast.UnPlus -> print_string "+"
270 | Ast.UnMinus -> print_string "-"
271 | Ast.Tilde -> print_string "~"
272 | Ast.Not -> print_string "!"
274 and assignOp = function
275 Ast.SimpleAssign -> print_string "="
276 | Ast.OpAssign(aop) -> arithOp aop; print_string "="
279 Ast.Dec -> print_string "--"
280 | Ast.Inc -> print_string "++"
282 and binaryOp = function
283 Ast.Arith(aop) -> arithOp aop
284 | Ast.Logical(lop) -> logicalOp lop
286 and arithOp = function
287 Ast.Plus -> print_string "+"
288 | Ast.Minus -> print_string "-"
289 | Ast.Mul -> print_string "*"
290 | Ast.Div -> print_string "/"
291 | Ast.Mod -> print_string "%"
292 | Ast.DecLeft -> print_string "<<"
293 | Ast.DecRight -> print_string ">>"
294 | Ast.And -> print_string "&"
295 | Ast.Or -> print_string "|"
296 | Ast.Xor -> print_string "^"
298 and logicalOp = function
299 Ast.Inf -> print_string "<"
300 | Ast.Sup -> print_string ">"
301 | Ast.InfEq -> print_string "<="
302 | Ast.SupEq -> print_string ">="
303 | Ast.Eq -> print_string "=="
304 | Ast.NotEq -> print_string "!="
305 | Ast.AndLog -> print_string "&&"
306 | Ast.OrLog -> print_string "||"
308 and constant = function
309 Ast.String(s) -> print_string "\""; print_string s; print_string "\""
310 | Ast.Char(s) -> print_string "'"; print_string s; print_string "'"
311 | Ast.Int(s) -> print_string s
312 | Ast.Float(s) -> print_string s
314 (* --------------------------------------------------------------------- *)
317 and storage = function
318 Ast.Static -> print_string "static "
319 | Ast.Auto -> print_string "auto "
320 | Ast.Register -> print_string "register "
321 | Ast.Extern -> print_string "extern "
323 (* --------------------------------------------------------------------- *)
327 match Ast.unwrap ft with
329 print_option (function x -> mcode const_vol x; print_string " ") cv;
331 | Ast.DisjType(decls) -> print_disj_list fullType decls
332 | Ast.OptType(ty) -> print_string "?"; fullType ty
333 | Ast.UniqueType(ty) -> print_string "!"; fullType ty
335 and print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) fn =
336 fullType ty; mcode print_string lp1; mcode print_string star; fn();
337 mcode print_string rp1; mcode print_string lp1;
338 parameter_list params; mcode print_string rp2
340 and print_function_type (ty,lp1,params,rp1) fn =
341 print_option fullType ty; fn(); mcode print_string lp1;
342 parameter_list params; mcode print_string rp1
344 and print_fninfo = function
345 Ast.FStorage(stg) -> mcode storage stg
346 | Ast.FType(ty) -> fullType ty
347 | Ast.FInline(inline) -> mcode print_string inline; print_string " "
348 | Ast.FAttr(attr) -> mcode print_string attr; print_string " "
351 match Ast.unwrap ty with
352 Ast.BaseType(ty,sgn) -> print_option (mcode sign) sgn; mcode baseType ty
353 | Ast.ImplicitInt(sgn) -> mcode sign sgn
354 | Ast.Pointer(ty,star) -> fullType ty; mcode print_string star
355 | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
356 print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
358 | Ast.FunctionType (_,ty,lp1,params,rp1) ->
359 print_function_type (ty,lp1,params,rp1) (function _ -> ())
360 | Ast.Array(ty,lb,size,rb) ->
361 fullType ty; mcode print_string lb; print_option expression size;
362 mcode print_string rb
363 | Ast.StructUnionName(kind,name) ->
364 mcode structUnion kind;
365 print_option (function x -> ident x; print_string " ") name
366 | Ast.StructUnionDef(ty,lb,decls,rb) ->
367 fullType ty; mcode print_string lb;
368 dots force_newline declaration decls;
369 mcode print_string rb
370 | Ast.TypeName(name) -> mcode print_string name; print_string " "
371 | Ast.MetaType(name,_,_) ->
372 mcode print_meta name; print_string " "
374 and baseType = function
375 Ast.VoidType -> print_string "void "
376 | Ast.CharType -> print_string "char "
377 | Ast.ShortType -> print_string "short "
378 | Ast.IntType -> print_string "int "
379 | Ast.DoubleType -> print_string "double "
380 | Ast.FloatType -> print_string "float "
381 | Ast.LongType -> print_string "long "
383 and structUnion = function
384 Ast.Struct -> print_string "struct "
385 | Ast.Union -> print_string "union "
388 Ast.Signed -> print_string "signed "
389 | Ast.Unsigned -> print_string "unsigned "
391 and const_vol = function
392 Ast.Const -> print_string "const"
393 | Ast.Volatile -> print_string "volatile"
395 (* --------------------------------------------------------------------- *)
396 (* Variable declaration *)
397 (* Even if the Cocci program specifies a list of declarations, they are
398 split out into multiple declarations of a single variable each. *)
400 and print_named_type ty id =
401 match Ast.unwrap ty with
402 Ast.Type(None,ty1) ->
403 (match Ast.unwrap ty1 with
404 Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
405 print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
406 (function _ -> print_string " "; ident id)
407 | Ast.FunctionType(_,ty,lp1,params,rp1) ->
408 print_function_type (ty,lp1,params,rp1)
409 (function _ -> print_string " "; ident id)
410 | Ast.Array(ty,lb,size,rb) ->
412 match Ast.unwrap ty with
413 Ast.Array(ty,lb,size,rb) ->
414 (match Ast.unwrap ty with
419 mcode print_string lb;
420 print_option expression size;
421 mcode print_string rb)
422 | _ -> failwith "complex array types not supported")
423 | _ -> typeC ty; ident id; k () in
424 loop ty1 (function _ -> ())
425 | _ -> fullType ty; ident id)
426 | _ -> fullType ty; ident id
429 match Ast.unwrap d with
430 Ast.Init(stg,ty,id,eq,ini,sem) ->
431 print_option (mcode storage) stg; print_named_type ty id;
432 print_string " "; mcode print_string eq;
433 print_string " "; initialiser ini; mcode print_string sem
434 | Ast.UnInit(stg,ty,id,sem) ->
435 print_option (mcode storage) stg; print_named_type ty id;
436 mcode print_string sem
437 | Ast.MacroDecl(name,lp,args,rp,sem) ->
438 ident name; mcode print_string_box lp;
439 dots (function _ -> ()) expression args;
440 close_box(); mcode print_string rp; mcode print_string sem
441 | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
442 | Ast.Typedef(stg,ty,id,sem) ->
443 mcode print_string stg; print_string " "; fullType ty; typeC id;
444 mcode print_string sem
445 | Ast.DisjDecl(decls) -> print_disj_list declaration decls
446 | Ast.Ddots(dots,Some whencode) ->
447 mcode print_string dots; print_string " when != "; declaration whencode
448 | Ast.Ddots(dots,None) -> mcode print_string dots
449 | Ast.MetaDecl(name,_,_) -> mcode print_meta name
450 | Ast.OptDecl(decl) -> print_string "?"; declaration decl
451 | Ast.UniqueDecl(decl) -> print_string "!"; declaration decl
453 (* --------------------------------------------------------------------- *)
457 match Ast.unwrap i with
458 Ast.InitExpr(exp) -> expression exp
459 | Ast.InitList(lb,initlist,rb,whencode) ->
460 mcode print_string lb; open_box 0;
461 if not (whencode = [])
463 (print_string " WHEN != ";
464 print_between (function _ -> print_string " v ")
465 initialiser whencode;
467 List.iter initialiser initlist; close_box();
468 mcode print_string rb
469 | Ast.InitGccDotName(dot,name,eq,ini) ->
470 mcode print_string dot; ident name; print_string " ";
471 mcode print_string eq; print_string " "; initialiser ini
472 | Ast.InitGccName(name,eq,ini) ->
473 ident name; mcode print_string eq; initialiser ini
474 | Ast.InitGccIndex(lb,exp,rb,eq,ini) ->
475 mcode print_string lb; expression exp; mcode print_string rb;
476 print_string " "; mcode print_string eq; print_string " ";
478 | Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
479 mcode print_string lb; expression exp1; mcode print_string dots;
480 expression exp2; mcode print_string rb;
481 print_string " "; mcode print_string eq; print_string " ";
483 | Ast.IComma(comma) -> mcode print_string comma; force_newline()
484 | Ast.OptIni(ini) -> print_string "?"; initialiser ini
485 | Ast.UniqueIni(ini) -> print_string "!"; initialiser ini
487 (* --------------------------------------------------------------------- *)
490 and parameterTypeDef p =
491 match Ast.unwrap p with
492 Ast.VoidParam(ty) -> fullType ty
493 | Ast.Param(ty,Some id) -> print_named_type ty id
494 | Ast.Param(ty,None) -> fullType ty
495 | Ast.MetaParam(name,_,_) -> mcode print_meta name
496 | Ast.MetaParamList(name,_,_,_) -> mcode print_meta name
497 | Ast.PComma(cm) -> mcode print_string cm; print_space()
498 | Ast.Pdots(dots) -> mcode print_string dots
499 | Ast.Pcircles(dots) -> mcode print_string dots
500 | Ast.OptParam(param) -> print_string "?"; parameterTypeDef param
501 | Ast.UniqueParam(param) -> print_string "!"; parameterTypeDef param
503 and parameter_list l = dots (function _ -> ()) parameterTypeDef l
505 (* --------------------------------------------------------------------- *)
508 let rec rule_elem arity re =
509 match Ast.unwrap re with
510 Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) ->
511 mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
512 print_string arity; List.iter print_fninfo fninfo;
513 ident name; mcode print_string_box lp;
514 parameter_list params; close_box(); mcode print_string rp;
516 | Ast.Decl(bef,allminus,decl) ->
517 mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos);
520 | Ast.SeqStart(brace) ->
521 print_string arity; mcode print_string brace;
522 if !print_newlines_disj then start_block()
523 | Ast.SeqEnd(brace) ->
524 if !print_newlines_disj then end_block();
525 print_string arity; mcode print_string brace
526 | Ast.ExprStatement(exp,sem) ->
527 print_string arity; expression exp; mcode print_string sem
528 | Ast.IfHeader(iff,lp,exp,rp) ->
530 mcode print_string iff; print_string " "; mcode print_string_box lp;
531 expression exp; close_box(); mcode print_string rp; print_string " "
533 print_string arity; mcode print_string els; print_string " "
534 | Ast.WhileHeader(whl,lp,exp,rp) ->
536 mcode print_string whl; print_string " "; mcode print_string_box lp;
537 expression exp; close_box(); mcode print_string rp; print_string " "
539 print_string arity; mcode print_string d; print_string " "
540 | Ast.WhileTail(whl,lp,exp,rp,sem) ->
542 mcode print_string whl; print_string " "; mcode print_string_box lp;
543 expression exp; close_box(); mcode print_string rp;
544 mcode print_string sem
545 | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
547 mcode print_string fr; mcode print_string_box lp;
548 print_option expression e1; mcode print_string sem1;
549 print_option expression e2; mcode print_string sem2;
550 print_option expression e3; close_box();
551 mcode print_string rp; print_string " "
552 | Ast.IteratorHeader(nm,lp,args,rp) ->
554 ident nm; print_string " "; mcode print_string_box lp;
555 dots (function _ -> ()) expression args; close_box();
556 mcode print_string rp; print_string " "
557 | Ast.SwitchHeader(switch,lp,exp,rp) ->
559 mcode print_string switch; print_string " "; mcode print_string_box lp;
560 expression exp; close_box(); mcode print_string rp; print_string " "
561 | Ast.Break(br,sem) ->
562 print_string arity; mcode print_string br; mcode print_string sem
563 | Ast.Continue(cont,sem) ->
564 print_string arity; mcode print_string cont; mcode print_string sem
565 | Ast.Label(l,dd) -> ident l; mcode print_string dd
566 | Ast.Goto(goto,l,sem) ->
567 mcode print_string goto; ident l; mcode print_string sem
568 | Ast.Return(ret,sem) ->
569 print_string arity; mcode print_string ret; mcode print_string sem
570 | Ast.ReturnExpr(ret,exp,sem) ->
571 print_string arity; mcode print_string ret; print_string " ";
572 expression exp; mcode print_string sem
573 | Ast.MetaRuleElem(name,_,_) ->
574 print_string arity; mcode print_meta name
575 | Ast.MetaStmt(name,_,_,_) ->
576 print_string arity; mcode print_meta name
577 | Ast.MetaStmtList(name,_,_) ->
578 print_string arity; mcode print_meta name
579 | Ast.Exp(exp) -> print_string arity; expression exp
580 | Ast.TopExp(exp) -> print_string arity; expression exp
581 | Ast.Ty(ty) -> print_string arity; fullType ty
582 | Ast.Include(inc,s) ->
583 mcode print_string inc; print_string " "; mcode inc_file s
584 | Ast.DefineHeader(def,id,params) ->
585 mcode print_string def; print_string " "; ident id;
586 print_define_parameters params
587 | Ast.Default(def,colon) ->
588 mcode print_string def; mcode print_string colon; print_string " "
589 | Ast.Case(case,exp,colon) ->
590 mcode print_string case; print_string " "; expression exp;
591 mcode print_string colon; print_string " "
592 | Ast.DisjRuleElem(res) ->
594 force_newline(); print_string "("; force_newline();
596 (function _ -> force_newline();print_string "|"; force_newline())
599 force_newline(); print_string ")"
602 and print_define_parameters params =
603 match Ast.unwrap params with
605 | Ast.DParams(lp,params,rp) ->
606 mcode print_string lp;
607 dots (function _ -> ()) print_define_param params; mcode print_string rp
609 and print_define_param param =
610 match Ast.unwrap param with
611 Ast.DParam(id) -> ident id
612 | Ast.DPComma(comma) -> mcode print_string comma
613 | Ast.DPdots(dots) -> mcode print_string dots
614 | Ast.DPcircles(circles) -> mcode print_string circles
615 | Ast.OptDParam(dp) -> print_string "?"; print_define_param dp
616 | Ast.UniqueDParam(dp) -> print_string "!"; print_define_param dp
618 and statement arity s =
619 match Ast.unwrap s with
620 Ast.Seq(lbrace,decls,body,rbrace) ->
621 rule_elem arity lbrace;
622 dots force_newline (statement arity) decls;
623 dots force_newline (statement arity) body;
624 rule_elem arity rbrace
625 | Ast.IfThen(header,branch,(_,_,_,aft)) ->
626 rule_elem arity header; statement arity branch;
627 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
628 | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) ->
629 rule_elem arity header; statement arity branch1; print_string " ";
630 rule_elem arity els; statement arity branch2;
631 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
632 | Ast.While(header,body,(_,_,_,aft)) ->
633 rule_elem arity header; statement arity body;
634 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
635 | Ast.Do(header,body,tail) ->
636 rule_elem arity header; statement arity body;
638 | Ast.For(header,body,(_,_,_,aft)) ->
639 rule_elem arity header; statement arity body;
640 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
641 | Ast.Iterator(header,body,(_,_,_,aft)) ->
642 rule_elem arity header; statement arity body;
643 mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos)
644 | Ast.Switch(header,lb,cases,rb) ->
645 rule_elem arity header; rule_elem arity lb;
646 List.iter (function x -> case_line arity x; force_newline()) cases;
648 | Ast.Atomic(re) -> rule_elem arity re
649 | Ast.FunDecl(header,lbrace,decls,body,rbrace) ->
650 rule_elem arity header; rule_elem arity lbrace;
651 dots force_newline (statement arity) decls;
652 dots force_newline (statement arity) body;
653 rule_elem arity rbrace
654 | Ast.Disj([stmt_dots]) ->
656 dots (function _ -> if !print_newlines_disj then force_newline())
657 (statement arity) stmt_dots
658 | Ast.Disj(stmt_dots_list) -> (* ignores newline directive for readability *)
660 force_newline(); print_string "("; force_newline();
662 (function _ -> force_newline();print_string "|"; force_newline())
663 (dots force_newline (statement arity))
665 force_newline(); print_string ")"
666 | Ast.Define(header,body) ->
667 rule_elem arity header; print_string " ";
668 dots force_newline (statement arity) body
669 | Ast.Nest(stmt_dots,whn,multi,_,_) ->
671 nest_dots multi (statement arity)
674 print_between force_newline
675 (whencode (dots force_newline (statement "")) (statement "")) whn;
676 close_box(); force_newline())
678 | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
679 print_string arity; mcode print_string d;
681 print_between force_newline
682 (whencode (dots force_newline (statement "")) (statement "")) whn;
683 close_box(); force_newline()
684 | Ast.OptStm(s) -> statement "?" s
685 | Ast.UniqueStm(s) -> statement "!" s
687 and print_statement_when whencode =
688 print_string " WHEN != ";
690 print_between (function _ -> print_string " &"; force_newline())
691 (dots force_newline (statement "")) whencode;
695 and whencode notfn alwaysfn = function
697 print_string " WHEN != "; open_box 0; notfn a; close_box()
698 | Ast.WhenAlways a ->
699 print_string " WHEN = "; open_box 0; alwaysfn a; close_box()
700 | Ast.WhenModifier x -> print_string " WHEN "; print_when_modif x
701 | Ast.WhenNotTrue a ->
702 print_string " WHEN != TRUE "; open_box 0; rule_elem "" a; close_box()
703 | Ast.WhenNotFalse a ->
704 print_string " WHEN != FALSE "; open_box 0; rule_elem "" a; close_box()
706 and print_when_modif = function
707 | Ast.WhenAny -> print_string "ANY"
708 | Ast.WhenStrict -> print_string "STRICT"
709 | Ast.WhenForall -> print_string "FORALL"
710 | Ast.WhenExists -> print_string "EXISTS"
712 and case_line arity c =
713 match Ast.unwrap c with
714 Ast.CaseLine(header,code) ->
715 rule_elem arity header; print_string " ";
716 dots force_newline (statement arity) code
717 | Ast.OptCase(case) -> case_line "?" case
719 (* --------------------------------------------------------------------- *)
722 and inc_file = function
725 print_between (function _ -> print_string "/") inc_elem elems;
727 | Ast.NonLocal(elems) ->
729 print_between (function _ -> print_string "/") inc_elem elems;
732 and inc_elem = function
733 Ast.IncPath s -> print_string s
734 | Ast.IncDots -> print_string "..."
736 (* for export only *)
737 let statement_dots l = dots force_newline (statement "") l
740 match Ast.unwrap t with
741 Ast.FILEINFO(old_file,new_file) ->
742 print_string "--- "; mcode print_string old_file; force_newline();
743 print_string "+++ "; mcode print_string new_file
744 | Ast.DECL(stmt) -> statement "" stmt
745 | Ast.CODE(stmt_dots) ->
746 dots force_newline (statement "") stmt_dots
747 | Ast.ERRORWORDS(exps) ->
748 print_string "error words = [";
749 print_between (function _ -> print_string ", ") expression exps;
753 print_between (function _ -> force_newline(); force_newline()) top_level
755 let pp_print_anything x = !anything x
759 Ast.FullTypeTag(x) -> fullType x
760 | Ast.BaseTypeTag(x) -> baseType x
761 | Ast.StructUnionTag(x) -> structUnion x
762 | Ast.SignTag(x) -> sign x
763 | Ast.IdentTag(x) -> ident x
764 | Ast.ExpressionTag(x) -> expression x
765 | Ast.ConstantTag(x) -> constant x
766 | Ast.UnaryOpTag(x) -> unaryOp x
767 | Ast.AssignOpTag(x) -> assignOp x
768 | Ast.FixOpTag(x) -> fixOp x
769 | Ast.BinaryOpTag(x) -> binaryOp x
770 | Ast.ArithOpTag(x) -> arithOp x
771 | Ast.LogicalOpTag(x) -> logicalOp x
772 | Ast.InitTag(x) -> initialiser x
773 | Ast.DeclarationTag(x) -> declaration x
774 | Ast.StorageTag(x) -> storage x
775 | Ast.IncFileTag(x) -> inc_file x
776 | Ast.Rule_elemTag(x) -> rule_elem "" x
777 | Ast.StatementTag(x) -> statement "" x
778 | Ast.CaseLineTag(x) -> case_line "" x
779 | Ast.ConstVolTag(x) -> const_vol x
780 | Ast.Token(x,Some info) -> print_string_befaft print_string x info
781 | Ast.Token(x,None) -> print_string x
782 | Ast.Code(x) -> let _ = top_level x in ()
783 | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x
784 | Ast.ParamDotsTag(x) -> parameter_list x
785 | Ast.StmtDotsTag(x) -> dots (function _ -> ()) (statement "") x
786 | Ast.DeclDotsTag(x) -> dots (function _ -> ()) declaration x
787 | Ast.TypeCTag(x) -> typeC x
788 | Ast.ParamTag(x) -> parameterTypeDef x
789 | Ast.SgrepStartTag(x) -> print_string x
790 | Ast.SgrepEndTag(x) -> print_string x
792 let rec dep in_and = function
793 Ast.Dep(s) -> print_string s
794 | Ast.AntiDep(s) -> print_string "!"; print_string s
795 | Ast.EverDep(s) -> print_string "ever "; print_string s
796 | Ast.NeverDep(s) -> print_string "never "; print_string s
797 | Ast.AndDep(s1,s2) ->
798 let print_and _ = dep true s1; print_string " && "; dep true s2 in
801 else (print_string "("; print_and(); print_string ")")
802 | Ast.OrDep(s1,s2) ->
803 let print_or _ = dep false s1; print_string " || "; dep false s2 in
806 else (print_string "("; print_or(); print_string ")")
807 | Ast.NoDep -> failwith "not possible"
811 Ast.ScriptRule (lang,deps,bindings,code) ->
814 print_string ("script:" ^ lang);
817 | _ -> print_string " depends on "; dep true deps);
823 | Ast.CocciRule (nm, (deps, drops, exists), x, _) ->
829 | _ -> print_string " depends on "; dep true deps);
831 print_string "line ";
832 print_int (Ast.get_line (List.hd x));
836 print_newlines_disj := true;
842 let rule_elem_to_string x =
843 print_newlines_disj := true;
844 Common.format_to_string (function _ -> rule_elem "" x)
846 let ident_to_string x =
847 print_newlines_disj := true;
848 Common.format_to_string (function _ -> ident x)
850 let unparse_to_string x =
851 print_newlines_disj := true;
852 Common.format_to_string (function _ -> unparse x)
854 let print_rule_elem re =
855 let nl = !print_newlines_disj in
856 print_newlines_disj := false;
858 print_newlines_disj := nl