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