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