2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
25 module F = Control_flow_c
27 (*****************************************************************************)
28 (* The functor argument *)
29 (*****************************************************************************)
31 (* info passed recursively in monad in addition to binding *)
33 optional_storage_iso : bool;
34 optional_qualifier_iso : bool;
35 value_format_iso : bool;
36 current_rule_name : string; (* used for errors *)
39 module XTRANS = struct
41 (* ------------------------------------------------------------------------*)
42 (* Combinators history *)
43 (* ------------------------------------------------------------------------*)
46 * type ('a, 'b) transformer =
47 * 'a -> 'b -> Lib_engine.metavars_binding -> 'b
51 * type ('a, 'b) transformer =
52 * 'a -> 'b -> Lib_engine.metavars_binding -> 'b option
53 * use an exception monad
56 * type tin = Lib_engine.metavars_binding
59 (* ------------------------------------------------------------------------*)
60 (* Standard type and operators *)
61 (* ------------------------------------------------------------------------*)
65 binding: Lib_engine.metavars_binding;
66 binding0: Lib_engine.metavars_binding; (* inherited variable *)
68 type 'x tout = 'x option
70 type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout
72 let (>>=) m f = fun tin ->
75 | Some (a,b) -> f a b tin
77 let return = fun x -> fun tin ->
80 (* can have fail in transform now that the process is deterministic ? *)
84 let (>||>) m1 m2 = fun tin ->
87 | Some x -> Some x (* stop as soon as have found something *)
89 let (>|+|>) m1 m2 = m1 >||> m2
91 let (>&&>) f m = fun tin ->
92 if f tin then m tin else fail tin
94 let optional_storage_flag f = fun tin ->
95 f (tin.extra.optional_storage_iso) tin
97 let optional_qualifier_flag f = fun tin ->
98 f (tin.extra.optional_qualifier_iso) tin
100 let value_format_flag f = fun tin ->
101 f (tin.extra.value_format_iso) tin
103 let mode = Cocci_vs_c.TransformMode
105 (* ------------------------------------------------------------------------*)
107 (* ------------------------------------------------------------------------*)
108 let cocciExp = fun expf expa node -> fun tin ->
111 Visitor_c.default_visitor_c_s with
112 Visitor_c.kexpr_s = (fun (k, bigf) expb ->
113 match expf expa expb tin with
114 | None -> (* failed *) k expb
115 | Some (x, expb) -> expb);
118 Some (expa, Visitor_c.vk_node_s bigf node)
121 (* same as cocciExp, but for expressions in an expression, not expressions
123 let cocciExpExp = fun expf expa expb -> fun tin ->
126 Visitor_c.default_visitor_c_s with
127 Visitor_c.kexpr_s = (fun (k, bigf) expb ->
128 match expf expa expb tin with
129 | None -> (* failed *) k expb
130 | Some (x, expb) -> expb);
133 Some (expa, Visitor_c.vk_expr_s bigf expb)
136 let cocciTy = fun expf expa node -> fun tin ->
139 Visitor_c.default_visitor_c_s with
140 Visitor_c.ktype_s = (fun (k, bigf) expb ->
141 match expf expa expb tin with
142 | None -> (* failed *) k expb
143 | Some (x, expb) -> expb);
146 Some (expa, Visitor_c.vk_node_s bigf node)
148 let cocciInit = fun expf expa node -> fun tin ->
151 Visitor_c.default_visitor_c_s with
152 Visitor_c.kini_s = (fun (k, bigf) expb ->
153 match expf expa expb tin with
154 | None -> (* failed *) k expb
155 | Some (x, expb) -> expb);
158 Some (expa, Visitor_c.vk_node_s bigf node)
161 (* ------------------------------------------------------------------------*)
163 (* ------------------------------------------------------------------------*)
164 let check_pos info mck pos =
166 | Ast_cocci.PLUS -> raise Impossible
167 | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
168 | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_) ->
169 pos <= i2 && pos >= i1
170 | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
171 | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_) ->
178 "wierd: dont have position info for the mcodekind in line %d column %d"
179 info.Ast_cocci.line info.Ast_cocci.column)
181 failwith "wierd: dont have position info for the mcodekind"
184 let tag_with_mck mck ib = fun tin ->
186 let cocciinforef = ib.Ast_c.cocci_tag in
187 let (oldmcode, oldenv) = !cocciinforef in
191 if !Flag_parsing_cocci.sgrep_mode
192 then Sgrep.process_sgrep ib mck
197 (match mck, Ast_c.pinfo_of_info ib with
198 | _, Ast_c.AbstractLineTok _ -> raise Impossible
199 | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
200 failwith ("try to delete an expanded token: " ^ (Ast_c.str_of_info ib))
204 match (oldmcode,mck) with
205 | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _)
206 | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING))
208 cocciinforef := (mck, tin.binding);
212 if (oldmcode, oldenv) = (mck, tin.binding)
214 if !Flag_matcher.show_misc
215 then pr2 "already tagged but with same mcode, so safe";
226 Format.set_formatter_out_channel stderr;
227 Common.pr2 "SP mcode ";
228 Pretty_print_cocci.print_mcodekind oldmcode;
229 Format.print_newline();
230 Common.pr2 "C code mcode ";
231 Pretty_print_cocci.print_mcodekind mck;
232 Format.print_newline();
233 Format.print_flush();
236 (Common.sprintf "%s: already tagged token:\n%s"
237 tin.extra.current_rule_name
238 (Common.error_message (Ast_c.file_of_info ib)
239 (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
242 let tokenf ia ib = fun tin ->
243 let (_,i,mck,_) = ia in
244 let pos = Ast_c.info_to_fixpos ib in
245 if check_pos (Some i) mck pos
246 then return (ia, tag_with_mck mck ib tin) tin
249 let tokenf_mck mck ib = fun tin ->
250 let pos = Ast_c.info_to_fixpos ib in
251 if check_pos None mck pos
252 then return (mck, tag_with_mck mck ib tin) tin
256 (* ------------------------------------------------------------------------*)
257 (* Distribute mcode *)
258 (* ------------------------------------------------------------------------*)
260 (* When in the SP we attach something to a metavariable, or delete it, as in
263 * we have to minusize all the token that compose S in the C code, and
264 * attach the 'foo();' to the right token, the one at the very right.
267 type 'a distributer =
268 (Ast_c.info -> Ast_c.info) * (* what to do on left *)
269 (Ast_c.info -> Ast_c.info) * (* what to do on middle *)
270 (Ast_c.info -> Ast_c.info) * (* what to do on right *)
271 (Ast_c.info -> Ast_c.info) -> (* what to do on both *)
274 let distribute_mck mcodekind distributef expr tin =
276 | Ast_cocci.MINUS (pos,any_xxs) ->
278 (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin),
279 (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
280 (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
281 (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin)
283 | Ast_cocci.CONTEXT (pos,any_befaft) ->
284 (match any_befaft with
285 | Ast_cocci.NOTHING -> expr
287 | Ast_cocci.BEFORE xxs ->
289 (fun ib -> tag_with_mck
290 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin),
293 (fun ib -> tag_with_mck
294 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin)
296 | Ast_cocci.AFTER xxs ->
300 (fun ib -> tag_with_mck
301 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER xxs)) ib tin),
302 (fun ib -> tag_with_mck
303 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER xxs)) ib tin)
306 | Ast_cocci.BEFOREAFTER (xxs, yys) ->
308 (fun ib -> tag_with_mck
309 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin),
311 (fun ib -> tag_with_mck
312 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER yys)) ib tin),
313 (fun ib -> tag_with_mck
314 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys)))
319 | Ast_cocci.PLUS -> raise Impossible
322 (* use new strategy, collect ii, sort, recollect and tag *)
324 let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
326 Visitor_c.default_visitor_c_s with
327 Visitor_c.kinfo_s = (fun (k,bigf) i ->
328 let pos = Ast_c.info_to_fixpos i in
330 | _ when Ast_cocci.equal_pos pos maxpos &&
331 Ast_cocci.equal_pos pos minpos -> bop i
332 | _ when Ast_cocci.equal_pos pos maxpos -> rop i
333 | _ when Ast_cocci.equal_pos pos minpos -> lop i
339 let distribute_mck_expr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
340 Visitor_c.vk_expr_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
342 let distribute_mck_args (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
343 Visitor_c.vk_args_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
345 let distribute_mck_type (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
346 Visitor_c.vk_type_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
348 let distribute_mck_ini (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
349 Visitor_c.vk_ini_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
351 let distribute_mck_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
352 Visitor_c.vk_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
354 let distribute_mck_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
355 Visitor_c.vk_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
358 let distribute_mck_node (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
359 Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
362 let distribute_mck_struct_fields (maxpos, minpos) =
363 fun (lop,mop,rop,bop) ->fun x ->
364 Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
367 let distribute_mck_cst (maxpos, minpos) =
368 fun (lop,mop,rop,bop) ->fun x ->
369 Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
373 let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
375 Visitor_c.vk_define_params_splitted_s
376 (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
381 | Ast_cocci.PLUS -> raise Impossible
382 | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
383 | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_) ->
384 Ast_cocci.FixPos (i1,i2)
385 | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
386 | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_) ->
387 Ast_cocci.DontCarePos
388 | _ -> failwith "wierd: dont have position info for the mcodekind"
390 let distrf (ii_of_x_f, distribute_mck_x_f) =
391 fun ia x -> fun tin ->
392 let mck = Ast_cocci.get_mcodekind ia in
393 let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x)
396 (* bug: check_pos mck max && check_pos mck min
398 * if do that then if have - f(...); and in C f(1,2); then we
399 * would get a "already tagged" because the '...' would sucess in
400 * transformaing both '1' and '1,2'. So being in the range is not
401 * enough. We must be equal exactly to the range!
403 (match get_pos mck with
404 | Ast_cocci.DontCarePos -> true
405 | Ast_cocci.FixPos (i1, i2) ->
407 | _ -> raise Impossible
413 distribute_mck mck (distribute_mck_x_f (max,min)) x tin
418 let distrf_e = distrf (Lib_parsing_c.ii_of_expr, distribute_mck_expr)
419 let distrf_args = distrf (Lib_parsing_c.ii_of_args, distribute_mck_args)
420 let distrf_type = distrf (Lib_parsing_c.ii_of_type, distribute_mck_type)
421 let distrf_param = distrf (Lib_parsing_c.ii_of_param, distribute_mck_param)
422 let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params)
423 let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini)
424 let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node)
425 let distrf_struct_fields =
426 distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields)
428 distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst)
429 let distrf_define_params =
430 distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params)
433 (* ------------------------------------------------------------------------*)
435 (* ------------------------------------------------------------------------*)
436 let meta_name_to_str (s1, s2) =
439 let envf keep _inherited = fun (s, value, _) f tin ->
440 let s = Ast_cocci.unwrap_mcode s in
442 if keep = Type_cocci.Saved
444 try Some (List.assoc s tin.binding)
447 "Don't find value for metavariable %s in the environment"
448 (meta_name_to_str s));
451 (* not raise Impossible! *)
458 (* Ex: in cocci_vs_c someone wants to add a binding. Here in
459 * transformation3 the value for this var may be already in the
460 * env, because for instance its value were fixed in a previous
461 * SmPL rule. So here we want to check that this is the same value.
462 * If forget to do the check, what can happen ? Because of Exp
463 * and other disjunctive feature of cocci_vs_c (>||>), we
464 * may accept a match at a wrong position. Maybe later this
465 * will be detected via the pos system on tokens, but maybe
466 * not. So safer to keep the check.
470 if Cocci_vs_c.equal_metavarval value value'
475 let check_constraints matcher constraints exp = fun f tin -> f () tin
477 (* ------------------------------------------------------------------------*)
478 (* Environment, allbounds *)
479 (* ------------------------------------------------------------------------*)
480 let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin ->
481 true (* in transform we don't care ? *)
485 (*****************************************************************************)
487 (*****************************************************************************)
488 module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS)
491 let transform_re_node a b tin =
492 match TRANS.rule_elem_node a b tin with
493 | None -> raise Impossible
494 | Some (_sp, b') -> b'
496 let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
497 Lib_engine.metavars_binding (* inherited bindings *) ->
498 Lib_engine.transformation_info -> F.cflow -> F.cflow) =
499 fun rule_name dropped_isos binding0 xs cflow ->
502 optional_storage_iso = not(List.mem "optional_storage" dropped_isos);
503 optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
504 value_format_iso = not(List.mem "value_format" dropped_isos);
505 current_rule_name = rule_name;
508 (* find the node, transform, update the node, and iter for all elements *)
510 xs +> List.fold_left (fun acc (nodei, binding, rule_elem) ->
511 (* subtil: not cflow#nodes but acc#nodes *)
512 let node = acc#nodes#assoc nodei in
514 if !Flag.show_transinfo
515 then pr2 "transform one node";
518 XTRANS.extra = extra;
519 XTRANS.binding = binding0@binding;
520 XTRANS.binding0 = []; (* not used - everything constant for trans *)
523 let node' = transform_re_node rule_elem node tin in
525 (* assert that have done something. But with metaruleElem sometimes
526 dont modify fake nodes. So special case before on Fake nodes. *)
527 (match F.unwrap node with
528 | F.Enter | F.Exit | F.ErrorExit
529 | F.EndStatement _ | F.CaseNode _
531 | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
533 | _ -> () (* assert (not (node =*= node')); *)
536 (* useless, we dont go back from flow to ast now *)
537 (* let node' = lastfix_comma_struct node' in *)
539 acc#replace_node (nodei, node');
545 let transform a b c d e =
546 Common.profile_code "Transformation3.transform"
547 (fun () -> transform2 a b c d e)