Commit | Line | Data |
---|---|---|
9bc82bae C |
1 | (* |
2 | * Copyright 2010, INRIA, University of Copenhagen | |
3 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
4 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
5 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
6 | * This file is part of Coccinelle. | |
7 | * | |
8 | * Coccinelle is free software: you can redistribute it and/or modify | |
9 | * it under the terms of the GNU General Public License as published by | |
10 | * the Free Software Foundation, according to version 2 of the License. | |
11 | * | |
12 | * Coccinelle is distributed in the hope that it will be useful, | |
13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | * GNU General Public License for more details. | |
16 | * | |
17 | * You should have received a copy of the GNU General Public License | |
18 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
19 | * | |
20 | * The authors reserve the right to distribute this or future versions of | |
21 | * Coccinelle under other licenses. | |
22 | *) | |
23 | ||
24 | ||
c491d8ee C |
25 | (* |
26 | * Copyright 2010, INRIA, University of Copenhagen | |
27 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
28 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
29 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
30 | * This file is part of Coccinelle. | |
31 | * | |
32 | * Coccinelle is free software: you can redistribute it and/or modify | |
33 | * it under the terms of the GNU General Public License as published by | |
34 | * the Free Software Foundation, according to version 2 of the License. | |
35 | * | |
36 | * Coccinelle is distributed in the hope that it will be useful, | |
37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
39 | * GNU General Public License for more details. | |
40 | * | |
41 | * You should have received a copy of the GNU General Public License | |
42 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
43 | * | |
44 | * The authors reserve the right to distribute this or future versions of | |
45 | * Coccinelle under other licenses. | |
46 | *) | |
47 | ||
48 | ||
785a3008 | 49 | 1(* Yoann Padioleau |
951c7801 C |
50 | * |
51 | * Copyright (C) 2006, 2007 Ecole des Mines de Nantes | |
52 | * | |
53 | * This program is free software; you can redistribute it and/or | |
54 | * modify it under the terms of the GNU General Public License (GPL) | |
55 | * version 2 as published by the Free Software Foundation. | |
ae4735db | 56 | * |
951c7801 C |
57 | * This program is distributed in the hope that it will be useful, |
58 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
59 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
60 | * file license.txt for more details. | |
ae4735db | 61 | * |
951c7801 C |
62 | * This file was part of Coccinelle. |
63 | *) | |
34e49164 C |
64 | open Common |
65 | ||
66 | module F = Control_flow_c | |
67 | ||
68 | (*****************************************************************************) | |
ae4735db | 69 | (* The functor argument *) |
34e49164 C |
70 | (*****************************************************************************) |
71 | ||
72 | (* info passed recursively in monad in addition to binding *) | |
ae4735db | 73 | type xinfo = { |
34e49164 C |
74 | optional_storage_iso : bool; |
75 | optional_qualifier_iso : bool; | |
76 | value_format_iso : bool; | |
77 | current_rule_name : string; (* used for errors *) | |
708f4980 | 78 | index : int list (* witness tree indices *) |
34e49164 C |
79 | } |
80 | ||
81 | module XTRANS = struct | |
82 | ||
83 | (* ------------------------------------------------------------------------*) | |
ae4735db | 84 | (* Combinators history *) |
34e49164 C |
85 | (* ------------------------------------------------------------------------*) |
86 | (* | |
ae4735db C |
87 | * version0: |
88 | * type ('a, 'b) transformer = | |
34e49164 | 89 | * 'a -> 'b -> Lib_engine.metavars_binding -> 'b |
ae4735db C |
90 | * exception NoMatch |
91 | * | |
34e49164 | 92 | * version1: |
ae4735db | 93 | * type ('a, 'b) transformer = |
34e49164 | 94 | * 'a -> 'b -> Lib_engine.metavars_binding -> 'b option |
ae4735db C |
95 | * use an exception monad |
96 | * | |
34e49164 C |
97 | * version2: |
98 | * type tin = Lib_engine.metavars_binding | |
99 | *) | |
100 | ||
101 | (* ------------------------------------------------------------------------*) | |
ae4735db | 102 | (* Standard type and operators *) |
34e49164 C |
103 | (* ------------------------------------------------------------------------*) |
104 | ||
ae4735db | 105 | type tin = { |
34e49164 C |
106 | extra: xinfo; |
107 | binding: Lib_engine.metavars_binding; | |
1be43e12 | 108 | binding0: Lib_engine.metavars_binding; (* inherited variable *) |
34e49164 C |
109 | } |
110 | type 'x tout = 'x option | |
111 | ||
112 | type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout | |
113 | ||
ae4735db | 114 | let (>>=) m f = fun tin -> |
34e49164 C |
115 | match m tin with |
116 | | None -> None | |
117 | | Some (a,b) -> f a b tin | |
118 | ||
ae4735db | 119 | let return = fun x -> fun tin -> |
34e49164 C |
120 | Some x |
121 | ||
122 | (* can have fail in transform now that the process is deterministic ? *) | |
ae4735db | 123 | let fail = fun tin -> |
34e49164 C |
124 | None |
125 | ||
ae4735db | 126 | let (>||>) m1 m2 = fun tin -> |
34e49164 C |
127 | match m1 tin with |
128 | | None -> m2 tin | |
129 | | Some x -> Some x (* stop as soon as have found something *) | |
130 | ||
131 | let (>|+|>) m1 m2 = m1 >||> m2 | |
132 | ||
ae4735db | 133 | let (>&&>) f m = fun tin -> |
34e49164 C |
134 | if f tin then m tin else fail tin |
135 | ||
ae4735db | 136 | let optional_storage_flag f = fun tin -> |
34e49164 C |
137 | f (tin.extra.optional_storage_iso) tin |
138 | ||
ae4735db | 139 | let optional_qualifier_flag f = fun tin -> |
34e49164 C |
140 | f (tin.extra.optional_qualifier_iso) tin |
141 | ||
ae4735db | 142 | let value_format_flag f = fun tin -> |
34e49164 C |
143 | f (tin.extra.value_format_iso) tin |
144 | ||
485bce71 | 145 | let mode = Cocci_vs_c.TransformMode |
34e49164 C |
146 | |
147 | (* ------------------------------------------------------------------------*) | |
ae4735db | 148 | (* Exp *) |
34e49164 | 149 | (* ------------------------------------------------------------------------*) |
ae4735db | 150 | let cocciExp = fun expf expa node -> fun tin -> |
34e49164 | 151 | |
ae4735db C |
152 | let bigf = { |
153 | Visitor_c.default_visitor_c_s with | |
34e49164 C |
154 | Visitor_c.kexpr_s = (fun (k, bigf) expb -> |
155 | match expf expa expb tin with | |
156 | | None -> (* failed *) k expb | |
157 | | Some (x, expb) -> expb); | |
158 | } | |
159 | in | |
160 | Some (expa, Visitor_c.vk_node_s bigf node) | |
161 | ||
162 | ||
163 | (* same as cocciExp, but for expressions in an expression, not expressions | |
164 | in a node *) | |
ae4735db | 165 | let cocciExpExp = fun expf expa expb -> fun tin -> |
34e49164 | 166 | |
ae4735db C |
167 | let bigf = { |
168 | Visitor_c.default_visitor_c_s with | |
34e49164 C |
169 | Visitor_c.kexpr_s = (fun (k, bigf) expb -> |
170 | match expf expa expb tin with | |
171 | | None -> (* failed *) k expb | |
172 | | Some (x, expb) -> expb); | |
173 | } | |
174 | in | |
175 | Some (expa, Visitor_c.vk_expr_s bigf expb) | |
176 | ||
177 | ||
ae4735db | 178 | let cocciTy = fun expf expa node -> fun tin -> |
34e49164 | 179 | |
ae4735db C |
180 | let bigf = { |
181 | Visitor_c.default_visitor_c_s with | |
34e49164 C |
182 | Visitor_c.ktype_s = (fun (k, bigf) expb -> |
183 | match expf expa expb tin with | |
184 | | None -> (* failed *) k expb | |
185 | | Some (x, expb) -> expb); | |
186 | } | |
187 | in | |
188 | Some (expa, Visitor_c.vk_node_s bigf node) | |
189 | ||
ae4735db | 190 | let cocciInit = fun expf expa node -> fun tin -> |
1be43e12 | 191 | |
ae4735db C |
192 | let bigf = { |
193 | Visitor_c.default_visitor_c_s with | |
1be43e12 C |
194 | Visitor_c.kini_s = (fun (k, bigf) expb -> |
195 | match expf expa expb tin with | |
196 | | None -> (* failed *) k expb | |
197 | | Some (x, expb) -> expb); | |
198 | } | |
199 | in | |
200 | Some (expa, Visitor_c.vk_node_s bigf node) | |
201 | ||
34e49164 C |
202 | |
203 | (* ------------------------------------------------------------------------*) | |
ae4735db | 204 | (* Tokens *) |
34e49164 | 205 | (* ------------------------------------------------------------------------*) |
ae4735db | 206 | let check_pos info mck pos = |
34e49164 | 207 | match mck with |
951c7801 | 208 | | Ast_cocci.PLUS _ -> raise Impossible |
708f4980 | 209 | | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) |
ae4735db | 210 | | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) -> |
34e49164 | 211 | pos <= i2 && pos >= i1 |
708f4980 | 212 | | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) |
ae4735db | 213 | | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) -> |
34e49164 C |
214 | true |
215 | | _ -> | |
216 | match info with | |
217 | Some info -> | |
218 | failwith | |
219 | (Printf.sprintf | |
0708f913 | 220 | "weird: dont have position info for the mcodekind in line %d column %d" |
34e49164 C |
221 | info.Ast_cocci.line info.Ast_cocci.column) |
222 | | None -> | |
0708f913 | 223 | failwith "weird: dont have position info for the mcodekind" |
34e49164 C |
224 | |
225 | ||
ae4735db | 226 | let tag_with_mck mck ib = fun tin -> |
34e49164 C |
227 | |
228 | let cocciinforef = ib.Ast_c.cocci_tag in | |
951c7801 | 229 | let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in |
34e49164 C |
230 | |
231 | let mck = | |
ae4735db | 232 | (* coccionly: |
34e49164 C |
233 | if !Flag_parsing_cocci.sgrep_mode |
234 | then Sgrep.process_sgrep ib mck | |
ae4735db | 235 | else |
485bce71 | 236 | *) |
ae4735db | 237 | mck |
34e49164 C |
238 | in |
239 | (match mck, Ast_c.pinfo_of_info ib with | |
240 | | _, Ast_c.AbstractLineTok _ -> raise Impossible | |
ae4735db | 241 | | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ -> |
34e49164 C |
242 | failwith ("try to delete an expanded token: " ^ (Ast_c.str_of_info ib)) |
243 | | _ -> () | |
244 | ); | |
245 | ||
951c7801 C |
246 | let many_count = function |
247 | Ast_cocci.BEFORE(_,Ast_cocci.MANY) | Ast_cocci.AFTER(_,Ast_cocci.MANY) | |
248 | | Ast_cocci.BEFOREAFTER(_,_,Ast_cocci.MANY) -> true | |
249 | | _ -> false in | |
250 | ||
251 | (match (oldmcode,mck) with | |
252 | | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _) -> | |
253 | (* nothing there, so take the new stuff *) | |
708f4980 C |
254 | let update_inst inst = function |
255 | Ast_cocci.MINUS (pos,_,adj,any_xxs) -> | |
256 | Ast_cocci.MINUS (pos,inst,adj,any_xxs) | |
257 | | mck -> mck in | |
951c7801 C |
258 | cocciinforef := Some (update_inst tin.extra.index mck, [tin.binding]) |
259 | | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) -> | |
260 | (* can this case occur? stay with the old stuff *) | |
261 | () | |
708f4980 C |
262 | | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,[]), |
263 | Ast_cocci.MINUS(new_pos,new_inst,new_adj,[])) | |
951c7801 C |
264 | when old_pos = new_pos && |
265 | (List.mem tin.binding oldenvs or !Flag.sgrep_mode2) | |
708f4980 C |
266 | (* no way to combine adjacency information, just drop one *) |
267 | -> | |
268 | cocciinforef := Some | |
269 | (Ast_cocci.MINUS | |
270 | (old_pos,Common.union_set old_inst new_inst,old_adj,[]), | |
951c7801 | 271 | [tin.binding]); |
708f4980 | 272 | (if !Flag_matcher.show_misc |
951c7801 C |
273 | then pr2 "already tagged but only removed, so safe") |
274 | ||
275 | | (Ast_cocci.CONTEXT(old_pos,old_modif), | |
276 | Ast_cocci.CONTEXT(new_pos,new_modif)) | |
277 | when old_pos = new_pos && | |
278 | old_modif = new_modif && many_count old_modif -> | |
279 | (* iteration only allowed on context; no way to replace something | |
280 | more than once; now no need for iterable; just check a flag *) | |
281 | ||
282 | cocciinforef := | |
283 | Some(Ast_cocci.CONTEXT(old_pos,old_modif),tin.binding::oldenvs) | |
708f4980 | 284 | |
ae4735db C |
285 | | _ -> |
286 | (* coccionly: | |
34e49164 C |
287 | if !Flag.sgrep_mode2 |
288 | then ib (* safe *) | |
ae4735db | 289 | else |
485bce71 C |
290 | *) |
291 | begin | |
ae4735db | 292 | (* coccionly: |
708f4980 C |
293 | pad: if dont want cocci write: |
294 | failwith | |
b1b2de81 C |
295 | (match Ast_c.pinfo_of_info ib with |
296 | Ast_c.FakeTok _ -> "already tagged fake token" | |
708f4980 C |
297 | *) |
298 | let pm str mcode env = | |
299 | Printf.sprintf | |
951c7801 | 300 | "%s modification:\n%s\nAccording to environment %d:\n%s\n" |
708f4980 C |
301 | str |
302 | (Common.format_to_string | |
303 | (function _ -> | |
304 | Pretty_print_cocci.print_mcodekind mcode)) | |
951c7801 | 305 | (List.length env) |
708f4980 C |
306 | (String.concat "\n" |
307 | (List.map | |
308 | (function ((r,vr),vl) -> | |
309 | Printf.sprintf " %s.%s -> %s" r vr | |
310 | (Common.format_to_string | |
311 | (function _ -> | |
312 | Pretty_print_engine.pp_binding_kind vl))) | |
313 | env)) in | |
314 | flush stdout; flush stderr; | |
315 | Common.pr2 | |
951c7801 C |
316 | ("\n"^ (String.concat "\n" |
317 | (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n" | |
318 | ^ (pm "current" mck tin.binding)); | |
708f4980 C |
319 | failwith |
320 | (match Ast_c.pinfo_of_info ib with | |
321 | Ast_c.FakeTok _ -> | |
322 | Common.sprintf "%s: already tagged fake token\n" | |
323 | tin.extra.current_rule_name | |
b1b2de81 | 324 | | _ -> |
708f4980 C |
325 | Printf.sprintf |
326 | "%s: already tagged token:\nC code context\n%s" | |
b1b2de81 C |
327 | tin.extra.current_rule_name |
328 | (Common.error_message (Ast_c.file_of_info ib) | |
329 | (Ast_c.str_of_info ib, Ast_c.opos_of_info ib))) | |
951c7801 C |
330 | end); |
331 | ib | |
34e49164 | 332 | |
ae4735db | 333 | let tokenf ia ib = fun tin -> |
34e49164 C |
334 | let (_,i,mck,_) = ia in |
335 | let pos = Ast_c.info_to_fixpos ib in | |
ae4735db | 336 | if check_pos (Some i) mck pos |
34e49164 C |
337 | then return (ia, tag_with_mck mck ib tin) tin |
338 | else fail tin | |
339 | ||
ae4735db | 340 | let tokenf_mck mck ib = fun tin -> |
34e49164 | 341 | let pos = Ast_c.info_to_fixpos ib in |
ae4735db | 342 | if check_pos None mck pos |
34e49164 C |
343 | then return (mck, tag_with_mck mck ib tin) tin |
344 | else fail tin | |
345 | ||
346 | ||
347 | (* ------------------------------------------------------------------------*) | |
ae4735db | 348 | (* Distribute mcode *) |
34e49164 C |
349 | (* ------------------------------------------------------------------------*) |
350 | ||
351 | (* When in the SP we attach something to a metavariable, or delete it, as in | |
352 | * - S | |
353 | * + foo(); | |
ae4735db C |
354 | * we have to minusize all the token that compose S in the C code, and |
355 | * attach the 'foo();' to the right token, the one at the very right. | |
34e49164 C |
356 | *) |
357 | ||
ae4735db | 358 | type 'a distributer = |
34e49164 C |
359 | (Ast_c.info -> Ast_c.info) * (* what to do on left *) |
360 | (Ast_c.info -> Ast_c.info) * (* what to do on middle *) | |
361 | (Ast_c.info -> Ast_c.info) * (* what to do on right *) | |
362 | (Ast_c.info -> Ast_c.info) -> (* what to do on both *) | |
363 | 'a -> 'a | |
364 | ||
365 | let distribute_mck mcodekind distributef expr tin = | |
366 | match mcodekind with | |
ae4735db | 367 | | Ast_cocci.MINUS (pos,_,adj,any_xxs) -> |
708f4980 | 368 | let inst = tin.extra.index in |
34e49164 | 369 | distributef ( |
708f4980 C |
370 | (fun ib -> |
371 | tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin), | |
372 | (fun ib -> | |
373 | tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin), | |
374 | (fun ib -> | |
375 | tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin), | |
376 | (fun ib -> | |
377 | tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin) | |
34e49164 | 378 | ) expr |
ae4735db | 379 | | Ast_cocci.CONTEXT (pos,any_befaft) -> |
34e49164 C |
380 | (match any_befaft with |
381 | | Ast_cocci.NOTHING -> expr | |
ae4735db C |
382 | |
383 | | Ast_cocci.BEFORE (xxs,c) -> | |
34e49164 | 384 | distributef ( |
ae4735db | 385 | (fun ib -> tag_with_mck |
951c7801 | 386 | (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin), |
ae4735db C |
387 | (fun x -> x), |
388 | (fun x -> x), | |
389 | (fun ib -> tag_with_mck | |
951c7801 | 390 | (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin) |
34e49164 | 391 | ) expr |
ae4735db | 392 | | Ast_cocci.AFTER (xxs,c) -> |
34e49164 | 393 | distributef ( |
ae4735db C |
394 | (fun x -> x), |
395 | (fun x -> x), | |
396 | (fun ib -> tag_with_mck | |
951c7801 | 397 | (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin), |
ae4735db | 398 | (fun ib -> tag_with_mck |
951c7801 | 399 | (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin) |
34e49164 C |
400 | ) expr |
401 | ||
ae4735db | 402 | | Ast_cocci.BEFOREAFTER (xxs, yys, c) -> |
34e49164 | 403 | distributef ( |
ae4735db | 404 | (fun ib -> tag_with_mck |
951c7801 | 405 | (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin), |
ae4735db C |
406 | (fun x -> x), |
407 | (fun ib -> tag_with_mck | |
951c7801 | 408 | (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin), |
ae4735db | 409 | (fun ib -> tag_with_mck |
951c7801 | 410 | (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c))) |
34e49164 C |
411 | ib tin) |
412 | ) expr | |
413 | ||
414 | ) | |
951c7801 | 415 | | Ast_cocci.PLUS _ -> raise Impossible |
34e49164 C |
416 | |
417 | ||
418 | (* use new strategy, collect ii, sort, recollect and tag *) | |
419 | ||
ae4735db C |
420 | let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) = |
421 | let bigf = { | |
34e49164 | 422 | Visitor_c.default_visitor_c_s with |
ae4735db | 423 | Visitor_c.kinfo_s = (fun (k,bigf) i -> |
34e49164 C |
424 | let pos = Ast_c.info_to_fixpos i in |
425 | match () with | |
426 | | _ when Ast_cocci.equal_pos pos maxpos && | |
427 | Ast_cocci.equal_pos pos minpos -> bop i | |
428 | | _ when Ast_cocci.equal_pos pos maxpos -> rop i | |
429 | | _ when Ast_cocci.equal_pos pos minpos -> lop i | |
430 | | _ -> mop i | |
431 | ) | |
432 | } in | |
433 | bigf | |
434 | ||
435 | let distribute_mck_expr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> | |
436 | Visitor_c.vk_expr_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
437 | ||
438 | let distribute_mck_args (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> | |
439 | Visitor_c.vk_args_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
440 | ||
441 | let distribute_mck_type (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> | |
442 | Visitor_c.vk_type_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
443 | ||
413ffc02 C |
444 | let distribute_mck_decl (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> |
445 | Visitor_c.vk_decl_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
446 | ||
447 | let distribute_mck_field (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> | |
448 | Visitor_c.vk_struct_field_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
449 | ||
34e49164 C |
450 | let distribute_mck_ini (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> |
451 | Visitor_c.vk_ini_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
452 | ||
c491d8ee C |
453 | let distribute_mck_inis (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> |
454 | Visitor_c.vk_inis_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
455 | ||
34e49164 C |
456 | let distribute_mck_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x -> |
457 | Visitor_c.vk_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x | |
458 | ||
459 | let distribute_mck_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> | |
460 | Visitor_c.vk_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) | |
461 | x | |
462 | ||
463 | let distribute_mck_node (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x -> | |
464 | Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) | |
465 | x | |
466 | ||
c491d8ee C |
467 | let distribute_mck_enum_fields (maxpos, minpos) = |
468 | fun (lop,mop,rop,bop) ->fun x -> | |
469 | Visitor_c.vk_enum_fields_splitted_s | |
470 | (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) | |
471 | x | |
472 | ||
ae4735db | 473 | let distribute_mck_struct_fields (maxpos, minpos) = |
34e49164 C |
474 | fun (lop,mop,rop,bop) ->fun x -> |
475 | Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) | |
476 | x | |
477 | ||
ae4735db | 478 | let distribute_mck_cst (maxpos, minpos) = |
34e49164 C |
479 | fun (lop,mop,rop,bop) ->fun x -> |
480 | Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) | |
481 | x | |
482 | ||
483 | ||
ae4735db | 484 | let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) -> |
34e49164 | 485 | fun x -> |
ae4735db | 486 | Visitor_c.vk_define_params_splitted_s |
34e49164 C |
487 | (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) |
488 | x | |
489 | ||
ae4735db | 490 | let get_pos mck = |
34e49164 | 491 | match mck with |
951c7801 | 492 | | Ast_cocci.PLUS _ -> raise Impossible |
708f4980 | 493 | | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_) |
ae4735db | 494 | | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) -> |
34e49164 | 495 | Ast_cocci.FixPos (i1,i2) |
708f4980 | 496 | | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_) |
ae4735db | 497 | | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) -> |
34e49164 | 498 | Ast_cocci.DontCarePos |
90aeb998 | 499 | | _ -> failwith "weird: dont have position info for the mcodekind 2" |
ae4735db C |
500 | |
501 | let distrf (ii_of_x_f, distribute_mck_x_f) = | |
502 | fun ia x -> fun tin -> | |
34e49164 C |
503 | let mck = Ast_cocci.get_mcodekind ia in |
504 | let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x) | |
505 | in | |
ae4735db | 506 | if |
34e49164 | 507 | (* bug: check_pos mck max && check_pos mck min |
ae4735db | 508 | * |
34e49164 C |
509 | * if do that then if have - f(...); and in C f(1,2); then we |
510 | * would get a "already tagged" because the '...' would sucess in | |
511 | * transformaing both '1' and '1,2'. So being in the range is not | |
ae4735db | 512 | * enough. We must be equal exactly to the range! |
34e49164 | 513 | *) |
ae4735db | 514 | (match get_pos mck with |
34e49164 | 515 | | Ast_cocci.DontCarePos -> true |
ae4735db | 516 | | Ast_cocci.FixPos (i1, i2) -> |
b1b2de81 | 517 | i1 =*= min && i2 =*= max |
34e49164 C |
518 | | _ -> raise Impossible |
519 | ) | |
520 | ||
ae4735db | 521 | then |
34e49164 | 522 | return ( |
ae4735db | 523 | ia, |
34e49164 C |
524 | distribute_mck mck (distribute_mck_x_f (max,min)) x tin |
525 | ) tin | |
526 | else fail tin | |
527 | ||
528 | ||
529 | let distrf_e = distrf (Lib_parsing_c.ii_of_expr, distribute_mck_expr) | |
530 | let distrf_args = distrf (Lib_parsing_c.ii_of_args, distribute_mck_args) | |
531 | let distrf_type = distrf (Lib_parsing_c.ii_of_type, distribute_mck_type) | |
532 | let distrf_param = distrf (Lib_parsing_c.ii_of_param, distribute_mck_param) | |
533 | let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params) | |
534 | let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini) | |
c491d8ee | 535 | let distrf_inis = distrf (Lib_parsing_c.ii_of_inis,distribute_mck_inis) |
413ffc02 C |
536 | let distrf_decl = distrf (Lib_parsing_c.ii_of_decl,distribute_mck_decl) |
537 | let distrf_field = distrf (Lib_parsing_c.ii_of_field,distribute_mck_field) | |
34e49164 | 538 | let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node) |
c491d8ee C |
539 | let distrf_enum_fields = |
540 | distrf (Lib_parsing_c.ii_of_enum_fields, distribute_mck_enum_fields) | |
ae4735db | 541 | let distrf_struct_fields = |
34e49164 | 542 | distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields) |
ae4735db | 543 | let distrf_cst = |
34e49164 | 544 | distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst) |
ae4735db | 545 | let distrf_define_params = |
34e49164 C |
546 | distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params) |
547 | ||
548 | ||
549 | (* ------------------------------------------------------------------------*) | |
ae4735db | 550 | (* Environment *) |
34e49164 | 551 | (* ------------------------------------------------------------------------*) |
ae4735db | 552 | let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2 |
34e49164 | 553 | |
ae4735db | 554 | let envf keep inherited = fun (s, value, _) f tin -> |
34e49164 | 555 | let s = Ast_cocci.unwrap_mcode s in |
ae4735db | 556 | let v = |
b1b2de81 | 557 | if keep =*= Type_cocci.Saved |
34e49164 C |
558 | then ( |
559 | try Some (List.assoc s tin.binding) | |
ae4735db | 560 | with Not_found -> |
34e49164 C |
561 | pr2(sprintf |
562 | "Don't find value for metavariable %s in the environment" | |
563 | (meta_name_to_str s)); | |
564 | None) | |
565 | else | |
566 | (* not raise Impossible! *) | |
567 | Some (value) | |
568 | in | |
569 | match v with | |
570 | | None -> fail tin | |
571 | | Some (value') -> | |
572 | ||
573 | (* Ex: in cocci_vs_c someone wants to add a binding. Here in | |
ae4735db | 574 | * transformation3 the value for this var may be already in the |
34e49164 C |
575 | * env, because for instance its value were fixed in a previous |
576 | * SmPL rule. So here we want to check that this is the same value. | |
577 | * If forget to do the check, what can happen ? Because of Exp | |
ae4735db | 578 | * and other disjunctive feature of cocci_vs_c (>||>), we |
34e49164 C |
579 | * may accept a match at a wrong position. Maybe later this |
580 | * will be detected via the pos system on tokens, but maybe | |
581 | * not. So safer to keep the check. | |
582 | *) | |
583 | ||
584 | (*f () tin*) | |
978fd7e5 C |
585 | let equal = |
586 | if inherited | |
587 | then Cocci_vs_c.equal_inh_metavarval | |
588 | else Cocci_vs_c.equal_metavarval in | |
ae4735db | 589 | if equal value value' |
34e49164 C |
590 | then f () tin |
591 | else fail tin | |
592 | ||
ae4735db | 593 | |
951c7801 C |
594 | let check_idconstraint matcher c id = fun f tin -> f () tin |
595 | let check_constraints_ne matcher constraints exp = fun f tin -> f () tin | |
34e49164 C |
596 | |
597 | (* ------------------------------------------------------------------------*) | |
ae4735db | 598 | (* Environment, allbounds *) |
34e49164 C |
599 | (* ------------------------------------------------------------------------*) |
600 | let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin -> | |
601 | true (* in transform we don't care ? *) | |
602 | ||
603 | end | |
604 | ||
605 | (*****************************************************************************) | |
ae4735db | 606 | (* Entry point *) |
34e49164 | 607 | (*****************************************************************************) |
485bce71 | 608 | module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS) |
34e49164 C |
609 | |
610 | ||
ae4735db C |
611 | let transform_re_node a b tin = |
612 | match TRANS.rule_elem_node a b tin with | |
34e49164 C |
613 | | None -> raise Impossible |
614 | | Some (_sp, b') -> b' | |
615 | ||
34e49164 | 616 | let (transform2: string (* rule name *) -> string list (* dropped_isos *) -> |
1be43e12 | 617 | Lib_engine.metavars_binding (* inherited bindings *) -> |
ae4735db C |
618 | Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) = |
619 | fun rule_name dropped_isos binding0 xs cflow -> | |
34e49164 | 620 | |
ae4735db | 621 | let extra = { |
34e49164 C |
622 | optional_storage_iso = not(List.mem "optional_storage" dropped_isos); |
623 | optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos); | |
624 | value_format_iso = not(List.mem "value_format" dropped_isos); | |
625 | current_rule_name = rule_name; | |
708f4980 | 626 | index = []; |
34e49164 C |
627 | } in |
628 | ||
629 | (* find the node, transform, update the node, and iter for all elements *) | |
630 | ||
ae4735db | 631 | xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) -> |
34e49164 | 632 | (* subtil: not cflow#nodes but acc#nodes *) |
ae4735db | 633 | let node = acc#nodes#assoc nodei in |
34e49164 | 634 | |
faf9a90c | 635 | if !Flag.show_transinfo |
34e49164 | 636 | then pr2 "transform one node"; |
708f4980 | 637 | |
34e49164 | 638 | let tin = { |
708f4980 | 639 | XTRANS.extra = {extra with index = index}; |
1be43e12 C |
640 | XTRANS.binding = binding0@binding; |
641 | XTRANS.binding0 = []; (* not used - everything constant for trans *) | |
34e49164 C |
642 | } in |
643 | ||
644 | let node' = transform_re_node rule_elem node tin in | |
645 | ||
ae4735db | 646 | (* assert that have done something. But with metaruleElem sometimes |
34e49164 C |
647 | dont modify fake nodes. So special case before on Fake nodes. *) |
648 | (match F.unwrap node with | |
649 | | F.Enter | F.Exit | F.ErrorExit | |
ae4735db | 650 | | F.EndStatement _ | F.CaseNode _ |
34e49164 | 651 | | F.Fake |
ae4735db | 652 | | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode |
34e49164 C |
653 | -> () |
654 | | _ -> () (* assert (not (node =*= node')); *) | |
655 | ); | |
656 | ||
657 | (* useless, we dont go back from flow to ast now *) | |
658 | (* let node' = lastfix_comma_struct node' in *) | |
ae4735db | 659 | |
34e49164 C |
660 | acc#replace_node (nodei, node'); |
661 | acc | |
662 | ) cflow | |
663 | ||
664 | ||
665 | ||
ae4735db C |
666 | let transform a b c d e = |
667 | Common.profile_code "Transformation3.transform" | |
1be43e12 | 668 | (fun () -> transform2 a b c d e) |