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