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