Release coccinelle-0.2.0
[bpt/coccinelle.git] / engine / asttomember.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
23(* on the first pass, onlyModif is true, so we don't see all matched nodes,
24only modified ones *)
25
26module Ast = Ast_cocci
27module V = Visitor_ast
28module CTL = Ast_ctl
29
30let mcode r (_,_,kind,_) =
31 match kind with
708f4980 32 Ast.MINUS(_,_,_,_) -> true
951c7801 33 | Ast.PLUS _ -> failwith "not possible"
34e49164
C
34 | Ast.CONTEXT(_,info) -> not (info = Ast.NOTHING)
35
36let no_mcode _ _ = false
37
38let contains_modif used_after x =
39 if List.exists (function x -> List.mem x used_after) (Ast.get_fvs x)
40 then true
41 else
42 let bind x y = x or y in
43 let option_default = false in
44 let do_nothing r k e = k e in
45 let rule_elem r k re =
46 let res = k re in
47 match Ast.unwrap re with
48 Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) ->
49 bind (mcode r ((),(),bef,Ast.NoMetaPos)) res
50 | Ast.Decl(bef,_,decl) ->
51 bind (mcode r ((),(),bef,Ast.NoMetaPos)) res
52 | _ -> res in
53 let recursor =
54 V.combiner bind option_default
55 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
faf9a90c 56 mcode
34e49164
C
57 do_nothing do_nothing do_nothing do_nothing
58 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
59 do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in
60 recursor.V.combiner_rule_elem x
61
62(* contains an inherited metavariable or contains a constant *)
63let contains_constant x =
64 match Ast.get_inherited x with
65 [] ->
66 let bind x y = x or y in
67 let option_default = false in
68 let do_nothing r k e = k e in
69 let mcode _ _ = false in
70 let ident r k i =
71 match Ast.unwrap i with
72 Ast.Id(name) -> true
73 | _ -> k i in
74 let expr r k e =
75 match Ast.unwrap e with
76 Ast.Constant(const) -> true
77 | _ -> k e in
78 let recursor =
79 V.combiner bind option_default
80 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
faf9a90c 81 mcode
34e49164
C
82 do_nothing do_nothing do_nothing do_nothing
83 ident expr do_nothing do_nothing do_nothing do_nothing
84 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in
85 recursor.V.combiner_rule_elem x
86 | _ -> true
87
88(* --------------------------------------------------------------------- *)
89
90let print_info = function
91 [] -> Printf.printf "no information\n"
92 | l ->
93 List.iter
94 (function disj ->
95 Printf.printf "one set of required things %d:\n"
96 (List.length disj);
97 List.iter
98 (function (_,thing) ->
99 Printf.printf "%s\n"
100 (Pretty_print_cocci.rule_elem_to_string thing))
101 disj;)
102 l
103
104(* --------------------------------------------------------------------- *)
105
106(* drop all distinguishing information from a term *)
107let strip =
108 let do_nothing r k e = Ast.make_term (Ast.unwrap (k e)) in
109 let do_absolutely_nothing r k e = k e in
110 let mcode m = Ast.make_mcode(Ast.unwrap_mcode m) in
111 let rule_elem r k re =
112 let res = do_nothing r k re in
113 let no_mcode = Ast.CONTEXT(Ast.NoPos,Ast.NOTHING) in
114 match Ast.unwrap res with
115 Ast.FunHeader(bef,b,fninfo,name,lp,params,rp) ->
116 Ast.rewrap res
117 (Ast.FunHeader(no_mcode,b,fninfo,name,lp,params,rp))
118 | Ast.Decl(bef,b,decl) -> Ast.rewrap res (Ast.Decl(no_mcode,b,decl))
119 | _ -> res in
120 let recursor =
121 V.rebuilder
122 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
34e49164
C
123 do_nothing do_nothing do_nothing do_nothing
124 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
125 do_nothing rule_elem do_nothing do_nothing
126 do_nothing do_absolutely_nothing in
127 recursor.V.rebuilder_rule_elem
128
129(* --------------------------------------------------------------------- *)
130
131let disj l1 l2 = l1 l2
132
133let rec conj xs ys =
134 match (xs,ys) with
135 ([],_) -> ys
136 | (_,[]) -> xs
137 | _ ->
138 List.fold_left
139 (function prev ->
140 function x ->
141 List.fold_left
142 (function prev ->
143 function cur ->
144 let cur_res = (List.sort compare (Common.union_set x cur)) in
145 cur_res ::
146 (List.filter
147 (function x -> not (Common.include_set cur_res x))
148 prev))
149 prev ys)
150 [] xs
151
152let conj_wrapped x l = conj [List.map (function x -> (1,strip x)) x] l
153
154(* --------------------------------------------------------------------- *)
155(* the main translation loop *)
156
157let rule_elem re =
158 match Ast.unwrap re with
159 Ast.DisjRuleElem(res) -> [[(List.length res,strip re)]]
160 | _ -> [[(1,strip re)]]
161
162let conj_one testfn x l =
163 if testfn x
164 then conj (rule_elem x) l
165 else l
166
167let rec statement_list testfn mcode tail stmt_list : 'a list list =
168 match Ast.unwrap stmt_list with
169 Ast.DOTS(x) | Ast.CIRCLES(x) | Ast.STARS(x) ->
170 (match List.rev x with
171 [] -> []
172 | last::rest ->
173 List.fold_right
174 (function cur ->
175 function rest ->
176 conj (statement testfn mcode false cur) rest)
177 rest (statement testfn mcode tail last))
178
179and statement testfn mcode tail stmt : 'a list list =
180 match Ast.unwrap stmt with
181 Ast.Atomic(ast) ->
182 (match Ast.unwrap ast with
183 (* modifications on return are managed in some other way *)
184 Ast.Return(_,_) | Ast.ReturnExpr(_,_,_) when tail -> []
185 | _ -> if testfn ast then rule_elem ast else [])
708f4980
C
186 | Ast.Seq(lbrace,body,rbrace) ->
187 let body_info = statement_list testfn mcode tail body in
34e49164
C
188 if testfn lbrace or testfn rbrace
189 then conj_wrapped [lbrace;rbrace] body_info
190 else body_info
191
192 | Ast.IfThen(header,branch,(_,_,_,aft))
193 | Ast.While(header,branch,(_,_,_,aft))
194 | Ast.For(header,branch,(_,_,_,aft))
195 | Ast.Iterator(header,branch,(_,_,_,aft)) ->
196 if testfn header or mcode () ((),(),aft,Ast.NoMetaPos)
197 then conj (rule_elem header) (statement testfn mcode tail branch)
198 else statement testfn mcode tail branch
199
fc1ad971
C
200 | Ast.Switch(header,lb,decls,cases,rb) ->
201 let body_info =
202 conj
203 (statement_list testfn mcode false decls)
204 (case_lines testfn mcode tail cases) in
34e49164
C
205 if testfn header or testfn lb or testfn rb
206 then conj (rule_elem header) body_info
207 else body_info
208
209 | Ast.IfThenElse(ifheader,branch1,els,branch2,(_,_,_,aft)) ->
210 let branches =
211 conj
212 (statement testfn mcode tail branch1)
213 (statement testfn mcode tail branch2) in
214 if testfn ifheader or mcode () ((),(),aft,Ast.NoMetaPos)
215 then conj (rule_elem ifheader) branches
216 else branches
217
218 | Ast.Disj(stmt_dots_list) ->
219 let processed =
220 List.map (statement_list testfn mcode tail) stmt_dots_list in
221 (* if one branch gives no information, then we have to take anything *)
222 if List.exists (function [] -> true | _ -> false) processed
223 then []
224 else Common.union_all processed
225
226 | Ast.Nest(stmt_dots,whencode,true,_,_) ->
227 statement_list testfn mcode false stmt_dots
228
229 | Ast.Nest(stmt_dots,whencode,false,_,_) -> []
230
231 | Ast.Dots(_,whencodes,_,_) -> []
232
708f4980
C
233 | Ast.FunDecl(header,lbrace,body,rbrace) ->
234 let body_info = statement_list testfn mcode true body in
34e49164
C
235 if testfn header or testfn lbrace or testfn rbrace
236 then conj (rule_elem header) body_info
237 else body_info
238
239 | Ast.Define(header,body) ->
240 conj_one testfn header (statement_list testfn mcode tail body)
241
242 | Ast.OptStm(stm) -> []
243
244 | Ast.UniqueStm(stm) -> statement testfn mcode tail stm
245
246 | _ -> failwith "not supported"
247
248and case_lines testfn mcode tail cases =
249 match cases with
250 [] -> []
251 | last::rest ->
252 List.fold_right
253 (function cur ->
254 function rest ->
255 conj (case_line testfn mcode false cur) rest)
256 rest (case_line testfn mcode tail last)
257
258and case_line testfn mcode tail case =
259 match Ast.unwrap case with
260 Ast.CaseLine(header,code) ->
261 conj_one testfn header (statement_list testfn mcode tail code)
262
263 | Ast.OptCase(case) -> []
264
265(* --------------------------------------------------------------------- *)
266(* Function declaration *)
267
268let top_level testfn mcode t : 'a list list =
269 match Ast.unwrap t with
270 Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo"
271 | Ast.DECL(stmt) -> statement testfn mcode false stmt
272 | Ast.CODE(stmt_dots) -> statement_list testfn mcode false stmt_dots
273 | Ast.ERRORWORDS(exps) -> failwith "not supported errorwords"
274
275(* --------------------------------------------------------------------- *)
276(* Entry points *)
277
278let debug = false
279
280(* if we end up with nothing, we assume that this rule is only here because
281someone depends on it, and thus we try again with testfn as contains_modif.
282Alternatively, we could check that this rule is mentioned in some
283dependency, but that would be a little more work, and doesn't seem
284worthwhile. *)
285
286(* lists are sorted such that smaller DisjRuleElem are first, because they
287are cheaper to test *)
288
289let asttomemberz (_,_,l) used_after =
290 let process_one (l : (int * Ast_cocci.rule_elem) list list) =
291 if debug
292 then print_info l;
293 List.map
294 (function info ->
295 let info =
296 List.sort (function (n1,_) -> function (n2,_) -> compare n1 n2)
297 info in
298 List.map (function (_,x) -> (Lib_engine.Match(x),CTL.Control)) info)
299 l in
300 List.map2
301 (function min -> function (max,big_max) ->
302 match min with
303 [] ->
304 (match max() with
305 [] -> process_one (big_max())
306 | max -> process_one max)
307 | _ -> process_one min)
308 (List.map (top_level contains_constant no_mcode) l)
309 (List.combine
310 (List.map2
311 (function x -> function ua -> function _ ->
312 top_level (contains_modif ua) mcode x)
313 l used_after)
314 (List.map
315 (function x -> function _ ->
316 top_level (function _ -> true) no_mcode x)
317 l))
318
319let asttomember r used_after =
320 match r with
b1b2de81 321 Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ -> []
faf9a90c 322 | Ast.CocciRule (a,b,c,_,_) -> asttomemberz (a,b,c) used_after
34e49164 323