permit multiline comments and strings in macros
[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
feec80c3 27# 0 "./transformation_c.ml"
34e49164
C
28open Common
29
30module F = Control_flow_c
31
32(*****************************************************************************)
ae4735db 33(* The functor argument *)
34e49164
C
34(*****************************************************************************)
35
36(* info passed recursively in monad in addition to binding *)
ae4735db 37type xinfo = {
34e49164
C
38 optional_storage_iso : bool;
39 optional_qualifier_iso : bool;
40 value_format_iso : bool;
5427db06 41 optional_declarer_semicolon_iso : bool;
34e49164 42 current_rule_name : string; (* used for errors *)
708f4980 43 index : int list (* witness tree indices *)
34e49164
C
44}
45
46module XTRANS = struct
47
48 (* ------------------------------------------------------------------------*)
ae4735db 49 (* Combinators history *)
34e49164
C
50 (* ------------------------------------------------------------------------*)
51 (*
ae4735db
C
52 * version0:
53 * type ('a, 'b) transformer =
34e49164 54 * 'a -> 'b -> Lib_engine.metavars_binding -> 'b
ae4735db
C
55 * exception NoMatch
56 *
34e49164 57 * version1:
ae4735db 58 * type ('a, 'b) transformer =
34e49164 59 * 'a -> 'b -> Lib_engine.metavars_binding -> 'b option
ae4735db
C
60 * use an exception monad
61 *
34e49164
C
62 * version2:
63 * type tin = Lib_engine.metavars_binding
64 *)
65
66 (* ------------------------------------------------------------------------*)
ae4735db 67 (* Standard type and operators *)
34e49164
C
68 (* ------------------------------------------------------------------------*)
69
ae4735db 70 type tin = {
34e49164
C
71 extra: xinfo;
72 binding: Lib_engine.metavars_binding;
1be43e12 73 binding0: Lib_engine.metavars_binding; (* inherited variable *)
34e49164
C
74 }
75 type 'x tout = 'x option
76
77 type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout
78
ae4735db 79 let (>>=) m f = fun tin ->
34e49164
C
80 match m tin with
81 | None -> None
82 | Some (a,b) -> f a b tin
83
ae4735db 84 let return = fun x -> fun tin ->
34e49164
C
85 Some x
86
87 (* can have fail in transform now that the process is deterministic ? *)
ae4735db 88 let fail = fun tin ->
34e49164
C
89 None
90
ae4735db 91 let (>||>) m1 m2 = fun tin ->
34e49164
C
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
ae4735db 98 let (>&&>) f m = fun tin ->
34e49164
C
99 if f tin then m tin else fail tin
100
ae4735db 101 let optional_storage_flag f = fun tin ->
34e49164
C
102 f (tin.extra.optional_storage_iso) tin
103
ae4735db 104 let optional_qualifier_flag f = fun tin ->
34e49164
C
105 f (tin.extra.optional_qualifier_iso) tin
106
ae4735db 107 let value_format_flag f = fun tin ->
34e49164
C
108 f (tin.extra.value_format_iso) tin
109
5427db06
C
110 let optional_declarer_semicolon_flag f = fun tin ->
111 f (tin.extra.optional_declarer_semicolon_iso) tin
112
485bce71 113 let mode = Cocci_vs_c.TransformMode
34e49164 114
993936c0
C
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
34e49164 144 (* ------------------------------------------------------------------------*)
ae4735db 145 (* Exp *)
34e49164 146 (* ------------------------------------------------------------------------*)
ae4735db 147 let cocciExp = fun expf expa node -> fun tin ->
34e49164 148
ae4735db
C
149 let bigf = {
150 Visitor_c.default_visitor_c_s with
34e49164
C
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 *)
abad11c5
C
162 let cocciExpExp = fun mc expf expa expb -> fun tin ->
163 match mc with
164 Ast_cocci.MINUS _ -> Some (expa,expb) (* do nothing *)
165 | _ ->
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
abad11c5 208 | Ast_cocci.PLUS _ -> raise (Impossible 51)
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 224
97111a47
C
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)
34e49164 279
ae4735db 280 let tag_with_mck mck ib = fun tin ->
34e49164
C
281
282 let cocciinforef = ib.Ast_c.cocci_tag in
951c7801 283 let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in
34e49164
C
284
285 let mck =
ae4735db 286 (* coccionly:
34e49164
C
287 if !Flag_parsing_cocci.sgrep_mode
288 then Sgrep.process_sgrep ib mck
ae4735db 289 else
485bce71 290 *)
ae4735db 291 mck
34e49164
C
292 in
293 (match mck, Ast_c.pinfo_of_info ib with
abad11c5 294 | _, Ast_c.AbstractLineTok _ -> raise (Impossible 52)
ae4735db 295 | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
6756e19d
C
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))
34e49164
C
301 | _ -> ()
302 );
303
8babbc8f 304 let many_context_count = function
951c7801
C
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
8babbc8f
C
309 let many_minus_count = function
310 Ast_cocci.REPLACEMENT(_,Ast_cocci.MANY) -> true
311 | _ -> false in
312
951c7801
C
313 (match (oldmcode,mck) with
314 | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _) ->
315 (* nothing there, so take the new stuff *)
708f4980
C
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
97111a47 320 let mck = strip_mck_code (update_inst tin.extra.index mck) in
993936c0
C
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 :=
97111a47 324 Some (mck, [clean_env tin.binding])
951c7801
C
325 | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) ->
326 (* can this case occur? stay with the old stuff *)
327 ()
8babbc8f
C
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) *)
708f4980
C
336 (* no way to combine adjacency information, just drop one *)
337 ->
338 cocciinforef := Some
339 (Ast_cocci.MINUS
8babbc8f
C
340 (old_pos,Common.union_set old_inst new_inst,old_adj,
341 Ast_cocci.NOREPLACEMENT),
951c7801 342 [tin.binding]);
708f4980 343 (if !Flag_matcher.show_misc
8babbc8f
C
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 &&
97111a47
C
350 old_modif = strip_minus_code new_modif &&
351 many_minus_count old_modif ->
8babbc8f
C
352
353 cocciinforef :=
354 Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst,
355 old_adj,old_modif),
993936c0 356 (clean_env tin.binding)::oldenvs)
951c7801
C
357
358 | (Ast_cocci.CONTEXT(old_pos,old_modif),
359 Ast_cocci.CONTEXT(new_pos,new_modif))
360 when old_pos = new_pos &&
97111a47
C
361 old_modif = strip_context_code new_modif &&
362 many_context_count old_modif ->
951c7801
C
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 :=
993936c0
C
367 Some(Ast_cocci.CONTEXT(old_pos,old_modif),
368 (clean_env tin.binding)::oldenvs)
708f4980 369
ae4735db
C
370 | _ ->
371 (* coccionly:
34e49164
C
372 if !Flag.sgrep_mode2
373 then ib (* safe *)
ae4735db 374 else
485bce71
C
375 *)
376 begin
ae4735db 377 (* coccionly:
708f4980
C
378 pad: if dont want cocci write:
379 failwith
b1b2de81
C
380 (match Ast_c.pinfo_of_info ib with
381 Ast_c.FakeTok _ -> "already tagged fake token"
708f4980
C
382 *)
383 let pm str mcode env =
384 Printf.sprintf
951c7801 385 "%s modification:\n%s\nAccording to environment %d:\n%s\n"
708f4980
C
386 str
387 (Common.format_to_string
388 (function _ ->
389 Pretty_print_cocci.print_mcodekind mcode))
951c7801 390 (List.length env)
708f4980
C
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
951c7801
C
401 ("\n"^ (String.concat "\n"
402 (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n"
403 ^ (pm "current" mck tin.binding));
708f4980
C
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
b1b2de81 409 | _ ->
708f4980
C
410 Printf.sprintf
411 "%s: already tagged token:\nC code context\n%s"
b1b2de81
C
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)))
951c7801
C
415 end);
416 ib
34e49164 417
ae4735db 418 let tokenf ia ib = fun tin ->
34e49164
C
419 let (_,i,mck,_) = ia in
420 let pos = Ast_c.info_to_fixpos ib in
ae4735db 421 if check_pos (Some i) mck pos
34e49164
C
422 then return (ia, tag_with_mck mck ib tin) tin
423 else fail tin
424
ae4735db 425 let tokenf_mck mck ib = fun tin ->
34e49164 426 let pos = Ast_c.info_to_fixpos ib in
ae4735db 427 if check_pos None mck pos
34e49164
C
428 then return (mck, tag_with_mck mck ib tin) tin
429 else fail tin
430
431
432 (* ------------------------------------------------------------------------*)
ae4735db 433 (* Distribute mcode *)
34e49164
C
434 (* ------------------------------------------------------------------------*)
435
436 (* When in the SP we attach something to a metavariable, or delete it, as in
437 * - S
438 * + foo();
ae4735db
C
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.
34e49164
C
441 *)
442
ae4735db 443 type 'a distributer =
34e49164
C
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
ae4735db 452 | Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
708f4980 453 let inst = tin.extra.index in
34e49164 454 distributef (
708f4980
C
455 (fun ib ->
456 tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin),
457 (fun ib ->
8babbc8f
C
458 tag_with_mck
459 (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
708f4980 460 (fun ib ->
8babbc8f
C
461 tag_with_mck
462 (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
708f4980
C
463 (fun ib ->
464 tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin)
34e49164 465 ) expr
ae4735db 466 | Ast_cocci.CONTEXT (pos,any_befaft) ->
34e49164
C
467 (match any_befaft with
468 | Ast_cocci.NOTHING -> expr
ae4735db
C
469
470 | Ast_cocci.BEFORE (xxs,c) ->
34e49164 471 distributef (
ae4735db 472 (fun ib -> tag_with_mck
951c7801 473 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
ae4735db
C
474 (fun x -> x),
475 (fun x -> x),
476 (fun ib -> tag_with_mck
951c7801 477 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin)
34e49164 478 ) expr
ae4735db 479 | Ast_cocci.AFTER (xxs,c) ->
34e49164 480 distributef (
ae4735db
C
481 (fun x -> x),
482 (fun x -> x),
483 (fun ib -> tag_with_mck
951c7801 484 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin),
ae4735db 485 (fun ib -> tag_with_mck
951c7801 486 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin)
34e49164
C
487 ) expr
488
ae4735db 489 | Ast_cocci.BEFOREAFTER (xxs, yys, c) ->
34e49164 490 distributef (
ae4735db 491 (fun ib -> tag_with_mck
951c7801 492 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
ae4735db
C
493 (fun x -> x),
494 (fun ib -> tag_with_mck
951c7801 495 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin),
ae4735db 496 (fun ib -> tag_with_mck
951c7801 497 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c)))
34e49164
C
498 ib tin)
499 ) expr
500
501 )
abad11c5 502 | Ast_cocci.PLUS _ -> raise (Impossible 53)
34e49164
C
503
504
505 (* use new strategy, collect ii, sort, recollect and tag *)
506
ae4735db
C
507 let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
508 let bigf = {
34e49164 509 Visitor_c.default_visitor_c_s with
ae4735db 510 Visitor_c.kinfo_s = (fun (k,bigf) i ->
34e49164
C
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
413ffc02
C
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
34e49164
C
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
c491d8ee
C
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
34e49164
C
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
c491d8ee
C
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
ae4735db 560 let distribute_mck_struct_fields (maxpos, minpos) =
34e49164
C
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
ae4735db 565 let distribute_mck_cst (maxpos, minpos) =
34e49164
C
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
ae4735db 571 let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
34e49164 572 fun x ->
ae4735db 573 Visitor_c.vk_define_params_splitted_s
34e49164
C
574 (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
575 x
576
ae4735db 577 let get_pos mck =
34e49164 578 match mck with
abad11c5 579 | Ast_cocci.PLUS _ -> raise (Impossible 54)
708f4980 580 | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
ae4735db 581 | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) ->
34e49164 582 Ast_cocci.FixPos (i1,i2)
708f4980 583 | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
ae4735db 584 | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) ->
34e49164 585 Ast_cocci.DontCarePos
90aeb998 586 | _ -> failwith "weird: dont have position info for the mcodekind 2"
ae4735db
C
587
588 let distrf (ii_of_x_f, distribute_mck_x_f) =
589 fun ia x -> fun tin ->
34e49164
C
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
ae4735db 593 if
34e49164 594 (* bug: check_pos mck max && check_pos mck min
ae4735db 595 *
34e49164
C
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
ae4735db 599 * enough. We must be equal exactly to the range!
34e49164 600 *)
ae4735db 601 (match get_pos mck with
34e49164 602 | Ast_cocci.DontCarePos -> true
ae4735db 603 | Ast_cocci.FixPos (i1, i2) ->
b1b2de81 604 i1 =*= min && i2 =*= max
abad11c5 605 | _ -> raise (Impossible 55)
34e49164
C
606 )
607
ae4735db 608 then
34e49164 609 return (
ae4735db 610 ia,
34e49164
C
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)
c491d8ee 622 let distrf_inis = distrf (Lib_parsing_c.ii_of_inis,distribute_mck_inis)
413ffc02
C
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)
34e49164 625 let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node)
c491d8ee
C
626 let distrf_enum_fields =
627 distrf (Lib_parsing_c.ii_of_enum_fields, distribute_mck_enum_fields)
ae4735db 628 let distrf_struct_fields =
34e49164 629 distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields)
ae4735db 630 let distrf_cst =
34e49164 631 distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst)
ae4735db 632 let distrf_define_params =
34e49164
C
633 distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params)
634
635
636 (* ------------------------------------------------------------------------*)
ae4735db 637 (* Environment *)
34e49164 638 (* ------------------------------------------------------------------------*)
ae4735db 639 let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2
34e49164 640
ae4735db 641 let envf keep inherited = fun (s, value, _) f tin ->
34e49164 642 let s = Ast_cocci.unwrap_mcode s in
ae4735db 643 let v =
b1b2de81 644 if keep =*= Type_cocci.Saved
34e49164
C
645 then (
646 try Some (List.assoc s tin.binding)
ae4735db 647 with Not_found ->
34e49164
C
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
ae4735db 661 * transformation3 the value for this var may be already in the
34e49164
C
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
ae4735db 665 * and other disjunctive feature of cocci_vs_c (>||>), we
34e49164
C
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*)
978fd7e5
C
672 let equal =
673 if inherited
674 then Cocci_vs_c.equal_inh_metavarval
675 else Cocci_vs_c.equal_metavarval in
ae4735db 676 if equal value value'
34e49164
C
677 then f () tin
678 else fail tin
679
ae4735db 680
951c7801
C
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
34e49164
C
683
684 (* ------------------------------------------------------------------------*)
ae4735db 685 (* Environment, allbounds *)
34e49164
C
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(*****************************************************************************)
ae4735db 693(* Entry point *)
34e49164 694(*****************************************************************************)
485bce71 695module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS)
34e49164
C
696
697
ae4735db
C
698let transform_re_node a b tin =
699 match TRANS.rule_elem_node a b tin with
abad11c5 700 | None -> raise (Impossible 56)
34e49164
C
701 | Some (_sp, b') -> b'
702
34e49164 703let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
1be43e12 704 Lib_engine.metavars_binding (* inherited bindings *) ->
ae4735db
C
705 Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) =
706 fun rule_name dropped_isos binding0 xs cflow ->
ae4735db 707 let extra = {
34e49164
C
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);
5427db06
C
711 optional_declarer_semicolon_iso =
712 not(List.mem "optional_declarer_semicolon" dropped_isos);
34e49164 713 current_rule_name = rule_name;
708f4980 714 index = [];
34e49164
C
715 } in
716
717 (* find the node, transform, update the node, and iter for all elements *)
718
ae4735db 719 xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) ->
34e49164 720 (* subtil: not cflow#nodes but acc#nodes *)
ae4735db 721 let node = acc#nodes#assoc nodei in
34e49164 722
faf9a90c 723 if !Flag.show_transinfo
993936c0 724 then pr2 (Printf.sprintf "transform one node: %d" nodei);
708f4980 725
34e49164 726 let tin = {
708f4980 727 XTRANS.extra = {extra with index = index};
1be43e12
C
728 XTRANS.binding = binding0@binding;
729 XTRANS.binding0 = []; (* not used - everything constant for trans *)
34e49164
C
730 } in
731
732 let node' = transform_re_node rule_elem node tin in
733
ae4735db 734 (* assert that have done something. But with metaruleElem sometimes
34e49164
C
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
ae4735db 738 | F.EndStatement _ | F.CaseNode _
34e49164 739 | F.Fake
ae4735db 740 | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
34e49164
C
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 *)
ae4735db 747
34e49164
C
748 acc#replace_node (nodei, node');
749 acc
750 ) cflow
751
752
753
ae4735db
C
754let transform a b c d e =
755 Common.profile_code "Transformation3.transform"
1be43e12 756 (fun () -> transform2 a b c d e)