Coccinelle release-1.0.0-rc11
[bpt/coccinelle.git] / engine / pretty_print_engine.ml
1 (*
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
9 *
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
13 *
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
18 *
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
21 *
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
24 *)
25
26
27 open Common.Infix
28
29 open Lib_engine
30
31
32 let pp = Common.pp
33
34 let pp_meta (_,x) = pp x
35
36 let rec pp_binding_kind = function
37 | Ast_c.MetaIdVal (s,_) -> pp ("id " ^ s)
38 | Ast_c.MetaFuncVal s -> pp ("func " ^ s)
39 | Ast_c.MetaLocalFuncVal s -> pp ("localfunc " ^ s)
40 | Ast_c.MetaExprVal (expr,_) -> Pretty_print_c.pp_expression_simple expr
41 | Ast_c.MetaExprListVal expr_list -> pp "<<exprlist>>"
42 | Ast_c.MetaInitVal ini ->
43 Pretty_print_c.pp_init_simple ini
44 | Ast_c.MetaInitListVal ini -> pp "<<initlist>>"
45 | Ast_c.MetaTypeVal typ ->
46 Pretty_print_c.pp_type_simple typ
47 | Ast_c.MetaDeclVal decl ->
48 Pretty_print_c.pp_decl_simple decl
49 | Ast_c.MetaFieldVal decl ->
50 Pretty_print_c.pp_field_simple decl
51 | Ast_c.MetaFieldListVal decls ->
52 List.iter Pretty_print_c.pp_field_simple decls
53 | Ast_c.MetaStmtVal statement ->
54 Pretty_print_c.pp_statement_simple statement
55 | Ast_c.MetaParamVal params -> pp "<<param>>"
56 | Ast_c.MetaParamListVal params -> pp "<<paramlist>>"
57 | Ast_c.MetaListlenVal n -> pp (string_of_int n)
58 | Ast_c.MetaPosVal (pos1, pos2) ->
59 let print_pos = function
60 Ast_cocci.Real x -> string_of_int x
61 | Ast_cocci.Virt(x,off) -> Printf.sprintf "%d+%d" x off in
62 pp (Common.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2))
63 | Ast_c.MetaPosValList l ->
64 pp (Common.sprintf ("poss[%s]")
65 (String.concat ", "
66 (List.map
67 (function (fl,ce,(minl,minc),(maxl,maxc)) ->
68 Printf.sprintf "(%s,%s,(%d,%d),(%d,%d))"
69 fl ce minl minc maxl maxc)
70 l)))
71
72 and pp_binding subst =
73 begin
74 pp "[";
75 Common.print_between (fun () -> pp ";"; Format.print_cut() )
76 (fun ((r,s), kind) ->
77 pp r; pp "."; pp s; pp " --> "; pp_binding_kind kind)
78 subst;
79 pp "]";
80 end
81
82
83 let pp_binding_kind2 = function
84 | ParenVal s -> pp "pv("; pp_meta s; pp ")"
85 | NormalMetaVal x -> pp_binding_kind x
86 | LabelVal (Absolute xs) ->
87 begin
88 pp "labelval";
89 pp "(";
90 Common.print_between (fun () -> pp ",") Format.print_int xs;
91 pp ")";
92 end
93 | LabelVal (Prefix xs) ->
94 begin
95 pp "prefixlabelval";
96 pp "(";
97 Common.print_between (fun () -> pp ",") Format.print_int xs;
98 pp ")";
99 end
100 | GoodVal -> pp "goodval"
101 | BadVal -> pp "badval"
102
103
104 let rec pp_predicate = function
105 | InLoop -> pp "InLoop"
106 | TrueBranch -> pp "TrueBranch"
107 | FalseBranch -> pp "FalseBranch"
108 | After -> pp "After"
109 | FallThrough -> pp "FallThrough"
110 | LoopFallThrough -> pp "LoopFallThrough"
111 | Return -> pp "Return"
112 | UnsafeBrace -> pp "UnsafeBrace"
113 | FunHeader -> pp "FunHeader"
114 | Top -> pp "Top"
115 | ErrorExit -> pp "ErrorExit"
116 | Exit -> pp "Exit"
117 | Goto -> pp "Goto"
118 | Paren s -> pp "Paren("; pp_meta s; pp ")"
119 | Match (re) -> Pretty_print_cocci.print_rule_elem re
120 | Label s -> pp "Label("; pp_meta s; pp ")"
121 | BCLabel s -> pp "BreakContinueLabel("; pp_meta s; pp ")"
122 | PrefixLabel s -> pp "PrefixLabel("; pp_meta s; pp ")"
123 | BindGood s -> pp "BindGood("; pp_meta s; pp ")"
124 | BindBad s -> pp "BindBad("; pp_meta s; pp ")"
125 | FakeBrace -> pp "FakeBrace"
126
127 and pp_binding2 subst =
128 begin
129 pp "[";
130 Common.print_between (fun () -> pp ";";Format.print_cut(); )
131 (fun (s, kind) -> pp s; pp " --> "; pp_binding_kind2 kind)
132 subst;
133 pp "]";
134 end
135
136 and pp_binding2_ctlsubst subst =
137 begin
138 pp "[";
139 Common.print_between (fun () -> pp ";"; Format.print_cut(); )
140 (function
141 Ast_ctl.Subst (s, kind) ->
142 pp_meta s; pp " --> "; pp_binding_kind2 kind;
143 | Ast_ctl.NegSubst (s, kind) ->
144 pp_meta s; pp " -/-> "; pp_binding_kind2 kind;
145 )
146 subst;
147 pp "]";
148 end
149
150 let predicate_to_string pred =
151 Common.format_to_string (function _ -> pp_predicate pred)
152
153
154 let pp_pred_smodif = fun (pred, smodif) ->
155 begin
156 pp_predicate pred;
157 (*
158 (match smodif with
159 | Ast_ctl.Modif x | Ast_ctl.UnModif x -> pp " with <modifTODO>"
160 | Ast_ctl.Control -> ()
161 )
162 *)
163 end
164
165
166 let pp_ctlcocci show_plus inline_let_def ctl =
167 begin
168 if show_plus
169 then begin
170 Pretty_print_cocci.print_plus_flag := true;
171 Pretty_print_cocci.print_minus_flag := true;
172 end
173 else begin
174 Pretty_print_cocci.print_plus_flag := false;
175 Pretty_print_cocci.print_minus_flag := false;
176 end;
177 Common.pp_do_in_box (fun () ->
178 Pretty_print_ctl.pp_ctl (pp_pred_smodif,(fun s -> pp_meta s))
179 inline_let_def ctl;
180 );
181 end
182
183