(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+(*
+ * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * file license.txt for more details.
+ *
+ * This file was part of Coccinelle.
+ *)
open Common
module F = Control_flow_c
(*****************************************************************************)
-(* The functor argument *)
+(* The functor argument *)
(*****************************************************************************)
(* info passed recursively in monad in addition to binding *)
-type xinfo = {
+type xinfo = {
optional_storage_iso : bool;
optional_qualifier_iso : bool;
value_format_iso : bool;
current_rule_name : string; (* used for errors *)
+ index : int list (* witness tree indices *)
}
module XTRANS = struct
(* ------------------------------------------------------------------------*)
- (* Combinators history *)
+ (* Combinators history *)
(* ------------------------------------------------------------------------*)
(*
- * version0:
- * type ('a, 'b) transformer =
+ * version0:
+ * type ('a, 'b) transformer =
* 'a -> 'b -> Lib_engine.metavars_binding -> 'b
- * exception NoMatch
- *
+ * exception NoMatch
+ *
* version1:
- * type ('a, 'b) transformer =
+ * type ('a, 'b) transformer =
* 'a -> 'b -> Lib_engine.metavars_binding -> 'b option
- * use an exception monad
- *
+ * use an exception monad
+ *
* version2:
* type tin = Lib_engine.metavars_binding
*)
(* ------------------------------------------------------------------------*)
- (* Standard type and operators *)
+ (* Standard type and operators *)
(* ------------------------------------------------------------------------*)
- type tin = {
+ type tin = {
extra: xinfo;
binding: Lib_engine.metavars_binding;
binding0: Lib_engine.metavars_binding; (* inherited variable *)
type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout
- let (>>=) m f = fun tin ->
+ let (>>=) m f = fun tin ->
match m tin with
| None -> None
| Some (a,b) -> f a b tin
- let return = fun x -> fun tin ->
+ let return = fun x -> fun tin ->
Some x
(* can have fail in transform now that the process is deterministic ? *)
- let fail = fun tin ->
+ let fail = fun tin ->
None
- let (>||>) m1 m2 = fun tin ->
+ let (>||>) m1 m2 = fun tin ->
match m1 tin with
| None -> m2 tin
| Some x -> Some x (* stop as soon as have found something *)
let (>|+|>) m1 m2 = m1 >||> m2
- let (>&&>) f m = fun tin ->
+ let (>&&>) f m = fun tin ->
if f tin then m tin else fail tin
- let optional_storage_flag f = fun tin ->
+ let optional_storage_flag f = fun tin ->
f (tin.extra.optional_storage_iso) tin
- let optional_qualifier_flag f = fun tin ->
+ let optional_qualifier_flag f = fun tin ->
f (tin.extra.optional_qualifier_iso) tin
- let value_format_flag f = fun tin ->
+ let value_format_flag f = fun tin ->
f (tin.extra.value_format_iso) tin
let mode = Cocci_vs_c.TransformMode
(* ------------------------------------------------------------------------*)
- (* Exp *)
+ (* Exp *)
(* ------------------------------------------------------------------------*)
- let cocciExp = fun expf expa node -> fun tin ->
+ let cocciExp = fun expf expa node -> fun tin ->
- let bigf = {
- Visitor_c.default_visitor_c_s with
+ let bigf = {
+ Visitor_c.default_visitor_c_s with
Visitor_c.kexpr_s = (fun (k, bigf) expb ->
match expf expa expb tin with
| None -> (* failed *) k expb
(* same as cocciExp, but for expressions in an expression, not expressions
in a node *)
- let cocciExpExp = fun expf expa expb -> fun tin ->
+ let cocciExpExp = fun expf expa expb -> fun tin ->
- let bigf = {
- Visitor_c.default_visitor_c_s with
+ let bigf = {
+ Visitor_c.default_visitor_c_s with
Visitor_c.kexpr_s = (fun (k, bigf) expb ->
match expf expa expb tin with
| None -> (* failed *) k expb
Some (expa, Visitor_c.vk_expr_s bigf expb)
- let cocciTy = fun expf expa node -> fun tin ->
+ let cocciTy = fun expf expa node -> fun tin ->
- let bigf = {
- Visitor_c.default_visitor_c_s with
+ let bigf = {
+ Visitor_c.default_visitor_c_s with
Visitor_c.ktype_s = (fun (k, bigf) expb ->
match expf expa expb tin with
| None -> (* failed *) k expb
in
Some (expa, Visitor_c.vk_node_s bigf node)
- let cocciInit = fun expf expa node -> fun tin ->
+ let cocciInit = fun expf expa node -> fun tin ->
- let bigf = {
- Visitor_c.default_visitor_c_s with
+ let bigf = {
+ Visitor_c.default_visitor_c_s with
Visitor_c.kini_s = (fun (k, bigf) expb ->
match expf expa expb tin with
| None -> (* failed *) k expb
(* ------------------------------------------------------------------------*)
- (* Tokens *)
+ (* Tokens *)
(* ------------------------------------------------------------------------*)
- let check_pos info mck pos =
+ let check_pos info mck pos =
match mck with
- | Ast_cocci.PLUS -> raise Impossible
- | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
- | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_) ->
+ | Ast_cocci.PLUS _ -> raise Impossible
+ | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
+ | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) ->
pos <= i2 && pos >= i1
- | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
- | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_) ->
+ | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
+ | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) ->
true
| _ ->
match info with
Some info ->
failwith
(Printf.sprintf
- "wierd: dont have position info for the mcodekind in line %d column %d"
+ "weird: dont have position info for the mcodekind in line %d column %d"
info.Ast_cocci.line info.Ast_cocci.column)
| None ->
- failwith "wierd: dont have position info for the mcodekind"
+ failwith "weird: dont have position info for the mcodekind"
- let tag_with_mck mck ib = fun tin ->
+ let tag_with_mck mck ib = fun tin ->
let cocciinforef = ib.Ast_c.cocci_tag in
- let (oldmcode, oldenv) = !cocciinforef in
+ let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in
let mck =
- (* coccionly:
+ (* coccionly:
if !Flag_parsing_cocci.sgrep_mode
then Sgrep.process_sgrep ib mck
- else
+ else
*)
- mck
+ mck
in
(match mck, Ast_c.pinfo_of_info ib with
| _, Ast_c.AbstractLineTok _ -> raise Impossible
- | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
+ | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
failwith ("try to delete an expanded token: " ^ (Ast_c.str_of_info ib))
| _ -> ()
);
- match (oldmcode,mck) with
- | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _)
- | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING))
+ let many_count = function
+ Ast_cocci.BEFORE(_,Ast_cocci.MANY) | Ast_cocci.AFTER(_,Ast_cocci.MANY)
+ | Ast_cocci.BEFOREAFTER(_,_,Ast_cocci.MANY) -> true
+ | _ -> false in
+
+ (match (oldmcode,mck) with
+ | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING), _) ->
+ (* nothing there, so take the new stuff *)
+ let update_inst inst = function
+ Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
+ Ast_cocci.MINUS (pos,inst,adj,any_xxs)
+ | mck -> mck in
+ cocciinforef := Some (update_inst tin.extra.index mck, [tin.binding])
+ | (_, Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) ->
+ (* can this case occur? stay with the old stuff *)
+ ()
+ | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,[]),
+ Ast_cocci.MINUS(new_pos,new_inst,new_adj,[]))
+ when old_pos = new_pos &&
+ (List.mem tin.binding oldenvs or !Flag.sgrep_mode2)
+ (* no way to combine adjacency information, just drop one *)
->
- cocciinforef := (mck, tin.binding);
- ib
-
- | _ ->
- if (oldmcode, oldenv) = (mck, tin.binding)
- then begin
- if !Flag_matcher.show_misc
- then pr2 "already tagged but with same mcode, so safe";
- ib
- end
- else
- (* coccionly:
+ cocciinforef := Some
+ (Ast_cocci.MINUS
+ (old_pos,Common.union_set old_inst new_inst,old_adj,[]),
+ [tin.binding]);
+ (if !Flag_matcher.show_misc
+ then pr2 "already tagged but only removed, so safe")
+
+ | (Ast_cocci.CONTEXT(old_pos,old_modif),
+ Ast_cocci.CONTEXT(new_pos,new_modif))
+ when old_pos = new_pos &&
+ old_modif = new_modif && many_count old_modif ->
+ (* iteration only allowed on context; no way to replace something
+ more than once; now no need for iterable; just check a flag *)
+
+ cocciinforef :=
+ Some(Ast_cocci.CONTEXT(old_pos,old_modif),tin.binding::oldenvs)
+
+ | _ ->
+ (* coccionly:
if !Flag.sgrep_mode2
then ib (* safe *)
- else
+ else
*)
begin
(* coccionly:
- Format.set_formatter_out_channel stderr;
- Common.pr2 "SP mcode ";
- Pretty_print_cocci.print_mcodekind oldmcode;
- Format.print_newline();
- Common.pr2 "C code mcode ";
- Pretty_print_cocci.print_mcodekind mck;
- Format.print_newline();
- Format.print_flush();
- *)
- failwith
- (Common.sprintf "%s: already tagged token:\n%s"
- tin.extra.current_rule_name
- (Common.error_message (Ast_c.file_of_info ib)
- (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
- end
-
- let tokenf ia ib = fun tin ->
+ pad: if dont want cocci write:
+ failwith
+ (match Ast_c.pinfo_of_info ib with
+ Ast_c.FakeTok _ -> "already tagged fake token"
+ *)
+ let pm str mcode env =
+ Printf.sprintf
+ "%s modification:\n%s\nAccording to environment %d:\n%s\n"
+ str
+ (Common.format_to_string
+ (function _ ->
+ Pretty_print_cocci.print_mcodekind mcode))
+ (List.length env)
+ (String.concat "\n"
+ (List.map
+ (function ((r,vr),vl) ->
+ Printf.sprintf " %s.%s -> %s" r vr
+ (Common.format_to_string
+ (function _ ->
+ Pretty_print_engine.pp_binding_kind vl)))
+ env)) in
+ flush stdout; flush stderr;
+ Common.pr2
+ ("\n"^ (String.concat "\n"
+ (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n"
+ ^ (pm "current" mck tin.binding));
+ failwith
+ (match Ast_c.pinfo_of_info ib with
+ Ast_c.FakeTok _ ->
+ Common.sprintf "%s: already tagged fake token\n"
+ tin.extra.current_rule_name
+ | _ ->
+ Printf.sprintf
+ "%s: already tagged token:\nC code context\n%s"
+ tin.extra.current_rule_name
+ (Common.error_message (Ast_c.file_of_info ib)
+ (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
+ end);
+ ib
+
+ let tokenf ia ib = fun tin ->
let (_,i,mck,_) = ia in
let pos = Ast_c.info_to_fixpos ib in
- if check_pos (Some i) mck pos
+ if check_pos (Some i) mck pos
then return (ia, tag_with_mck mck ib tin) tin
else fail tin
- let tokenf_mck mck ib = fun tin ->
+ let tokenf_mck mck ib = fun tin ->
let pos = Ast_c.info_to_fixpos ib in
- if check_pos None mck pos
+ if check_pos None mck pos
then return (mck, tag_with_mck mck ib tin) tin
else fail tin
(* ------------------------------------------------------------------------*)
- (* Distribute mcode *)
+ (* Distribute mcode *)
(* ------------------------------------------------------------------------*)
(* When in the SP we attach something to a metavariable, or delete it, as in
* - S
* + foo();
- * we have to minusize all the token that compose S in the C code, and
- * attach the 'foo();' to the right token, the one at the very right.
+ * we have to minusize all the token that compose S in the C code, and
+ * attach the 'foo();' to the right token, the one at the very right.
*)
- type 'a distributer =
+ type 'a distributer =
(Ast_c.info -> Ast_c.info) * (* what to do on left *)
(Ast_c.info -> Ast_c.info) * (* what to do on middle *)
(Ast_c.info -> Ast_c.info) * (* what to do on right *)
let distribute_mck mcodekind distributef expr tin =
match mcodekind with
- | Ast_cocci.MINUS (pos,any_xxs) ->
+ | Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
+ let inst = tin.extra.index in
distributef (
- (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin),
- (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
- (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,[])) ib tin),
- (fun ib -> tag_with_mck (Ast_cocci.MINUS (pos,any_xxs)) ib tin)
+ (fun ib ->
+ tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin),
+ (fun ib ->
+ tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin),
+ (fun ib ->
+ tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,[])) ib tin),
+ (fun ib ->
+ tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin)
) expr
- | Ast_cocci.CONTEXT (pos,any_befaft) ->
+ | Ast_cocci.CONTEXT (pos,any_befaft) ->
(match any_befaft with
| Ast_cocci.NOTHING -> expr
-
- | Ast_cocci.BEFORE xxs ->
+
+ | Ast_cocci.BEFORE (xxs,c) ->
distributef (
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin),
- (fun x -> x),
- (fun x -> x),
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin)
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
+ (fun x -> x),
+ (fun x -> x),
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin)
) expr
- | Ast_cocci.AFTER xxs ->
+ | Ast_cocci.AFTER (xxs,c) ->
distributef (
- (fun x -> x),
- (fun x -> x),
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER xxs)) ib tin),
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER xxs)) ib tin)
+ (fun x -> x),
+ (fun x -> x),
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin),
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin)
) expr
- | Ast_cocci.BEFOREAFTER (xxs, yys) ->
+ | Ast_cocci.BEFOREAFTER (xxs, yys, c) ->
distributef (
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE xxs)) ib tin),
- (fun x -> x),
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER yys)) ib tin),
- (fun ib -> tag_with_mck
- (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys)))
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
+ (fun x -> x),
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin),
+ (fun ib -> tag_with_mck
+ (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c)))
ib tin)
) expr
)
- | Ast_cocci.PLUS -> raise Impossible
+ | Ast_cocci.PLUS _ -> raise Impossible
(* use new strategy, collect ii, sort, recollect and tag *)
- let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
- let bigf = {
+ let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
+ let bigf = {
Visitor_c.default_visitor_c_s with
- Visitor_c.kinfo_s = (fun (k,bigf) i ->
+ Visitor_c.kinfo_s = (fun (k,bigf) i ->
let pos = Ast_c.info_to_fixpos i in
match () with
| _ when Ast_cocci.equal_pos pos maxpos &&
Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
x
- let distribute_mck_struct_fields (maxpos, minpos) =
+ let distribute_mck_struct_fields (maxpos, minpos) =
fun (lop,mop,rop,bop) ->fun x ->
Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
x
- let distribute_mck_cst (maxpos, minpos) =
+ let distribute_mck_cst (maxpos, minpos) =
fun (lop,mop,rop,bop) ->fun x ->
Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
x
- let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
+ let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
fun x ->
- Visitor_c.vk_define_params_splitted_s
+ Visitor_c.vk_define_params_splitted_s
(mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
x
- let get_pos mck =
+ let get_pos mck =
match mck with
- | Ast_cocci.PLUS -> raise Impossible
- | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
- | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_) ->
+ | Ast_cocci.PLUS _ -> raise Impossible
+ | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
+ | Ast_cocci.MINUS (Ast_cocci.FixPos (i1,i2),_,_,_) ->
Ast_cocci.FixPos (i1,i2)
- | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
- | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_) ->
+ | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
+ | Ast_cocci.MINUS (Ast_cocci.DontCarePos,_,_,_) ->
Ast_cocci.DontCarePos
- | _ -> failwith "wierd: dont have position info for the mcodekind"
-
- let distrf (ii_of_x_f, distribute_mck_x_f) =
- fun ia x -> fun tin ->
+ | _ -> failwith "weird: dont have position info for the mcodekind"
+
+ let distrf (ii_of_x_f, distribute_mck_x_f) =
+ fun ia x -> fun tin ->
let mck = Ast_cocci.get_mcodekind ia in
let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x)
in
- if
+ if
(* bug: check_pos mck max && check_pos mck min
- *
+ *
* if do that then if have - f(...); and in C f(1,2); then we
* would get a "already tagged" because the '...' would sucess in
* transformaing both '1' and '1,2'. So being in the range is not
- * enough. We must be equal exactly to the range!
+ * enough. We must be equal exactly to the range!
*)
- (match get_pos mck with
+ (match get_pos mck with
| Ast_cocci.DontCarePos -> true
- | Ast_cocci.FixPos (i1, i2) ->
- i1 = min && i2 = max
+ | Ast_cocci.FixPos (i1, i2) ->
+ i1 =*= min && i2 =*= max
| _ -> raise Impossible
)
- then
+ then
return (
- ia,
+ ia,
distribute_mck mck (distribute_mck_x_f (max,min)) x tin
) tin
else fail tin
let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params)
let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini)
let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node)
- let distrf_struct_fields =
+ let distrf_struct_fields =
distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields)
- let distrf_cst =
+ let distrf_cst =
distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst)
- let distrf_define_params =
+ let distrf_define_params =
distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params)
(* ------------------------------------------------------------------------*)
- (* Environment *)
+ (* Environment *)
(* ------------------------------------------------------------------------*)
- let meta_name_to_str (s1, s2) =
- s1 ^ "." ^ s2
+ let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2
- let envf keep _inherited = fun (s, value, _) f tin ->
+ let envf keep inherited = fun (s, value, _) f tin ->
let s = Ast_cocci.unwrap_mcode s in
- let v =
- if keep = Type_cocci.Saved
+ let v =
+ if keep =*= Type_cocci.Saved
then (
try Some (List.assoc s tin.binding)
- with Not_found ->
+ with Not_found ->
pr2(sprintf
"Don't find value for metavariable %s in the environment"
(meta_name_to_str s));
| Some (value') ->
(* Ex: in cocci_vs_c someone wants to add a binding. Here in
- * transformation3 the value for this var may be already in the
+ * transformation3 the value for this var may be already in the
* env, because for instance its value were fixed in a previous
* SmPL rule. So here we want to check that this is the same value.
* If forget to do the check, what can happen ? Because of Exp
- * and other disjunctive feature of cocci_vs_c (>||>), we
+ * and other disjunctive feature of cocci_vs_c (>||>), we
* may accept a match at a wrong position. Maybe later this
* will be detected via the pos system on tokens, but maybe
* not. So safer to keep the check.
*)
(*f () tin*)
- if Cocci_vs_c.equal_metavarval value value'
+ let equal =
+ if inherited
+ then Cocci_vs_c.equal_inh_metavarval
+ else Cocci_vs_c.equal_metavarval in
+ if equal value value'
then f () tin
else fail tin
-
- let check_constraints matcher constraints exp = fun f tin -> f () tin
+
+ let check_idconstraint matcher c id = fun f tin -> f () tin
+ let check_constraints_ne matcher constraints exp = fun f tin -> f () tin
(* ------------------------------------------------------------------------*)
- (* Environment, allbounds *)
+ (* Environment, allbounds *)
(* ------------------------------------------------------------------------*)
let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin ->
true (* in transform we don't care ? *)
end
(*****************************************************************************)
-(* Entry point *)
+(* Entry point *)
(*****************************************************************************)
module TRANS = Cocci_vs_c.COCCI_VS_C (XTRANS)
-let transform_re_node a b tin =
- match TRANS.rule_elem_node a b tin with
+let transform_re_node a b tin =
+ match TRANS.rule_elem_node a b tin with
| None -> raise Impossible
| Some (_sp, b') -> b'
let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
Lib_engine.metavars_binding (* inherited bindings *) ->
- Lib_engine.transformation_info -> F.cflow -> F.cflow) =
- fun rule_name dropped_isos binding0 xs cflow ->
+ Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) =
+ fun rule_name dropped_isos binding0 xs cflow ->
- let extra = {
+ let extra = {
optional_storage_iso = not(List.mem "optional_storage" dropped_isos);
optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
value_format_iso = not(List.mem "value_format" dropped_isos);
current_rule_name = rule_name;
+ index = [];
} in
(* find the node, transform, update the node, and iter for all elements *)
- xs +> List.fold_left (fun acc (nodei, binding, rule_elem) ->
+ xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) ->
(* subtil: not cflow#nodes but acc#nodes *)
- let node = acc#nodes#assoc nodei in
+ let node = acc#nodes#assoc nodei in
if !Flag.show_transinfo
then pr2 "transform one node";
-
+
let tin = {
- XTRANS.extra = extra;
+ XTRANS.extra = {extra with index = index};
XTRANS.binding = binding0@binding;
XTRANS.binding0 = []; (* not used - everything constant for trans *)
} in
let node' = transform_re_node rule_elem node tin in
- (* assert that have done something. But with metaruleElem sometimes
+ (* assert that have done something. But with metaruleElem sometimes
dont modify fake nodes. So special case before on Fake nodes. *)
(match F.unwrap node with
| F.Enter | F.Exit | F.ErrorExit
- | F.EndStatement _ | F.CaseNode _
+ | F.EndStatement _ | F.CaseNode _
| F.Fake
- | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
+ | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
-> ()
| _ -> () (* assert (not (node =*= node')); *)
);
(* useless, we dont go back from flow to ast now *)
(* let node' = lastfix_comma_struct node' in *)
-
+
acc#replace_node (nodei, node');
acc
) cflow
-let transform a b c d e =
- Common.profile_code "Transformation3.transform"
+let transform a b c d e =
+ Common.profile_code "Transformation3.transform"
(fun () -> transform2 a b c d e)
HCoop / bpt / coccinelle.git / blobdiff