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