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