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