Release coccinelle-0.2.4
[bpt/coccinelle.git] / engine / transformation_c.ml
CommitLineData
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 491(* 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
64open Common
65
66module 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 73type 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
81module 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
603end
604
605(*****************************************************************************)
ae4735db 606(* Entry point *)
34e49164 607(*****************************************************************************)
485bce71 608module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS)
34e49164
C
609
610
ae4735db
C
611let 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 616let (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
666let transform a b c d e =
667 Common.profile_code "Transformation3.transform"
1be43e12 668 (fun () -> transform2 a b c d e)