(*
-* Copyright 2005-2008, 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.
+ *)
(* find unitary metavariables *)
module Ast0 = Ast0_cocci
module Ast = Ast_cocci
module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
let set_minus s minus = List.filter (function n -> not (List.mem n minus)) s
let minus_checker name = let id = Ast0.unwrap_mcode name in [id]
(* take only what is in the plus code *)
-let plus_checker (nm,_,_,mc,_) =
- match mc with Ast0.PLUS -> [nm] | _ -> []
-
+let plus_checker (nm,_,_,mc,_,_) =
+ match mc with Ast0.PLUS _ -> [nm] | _ -> []
+
let get_free checker t =
let bind x y = x @ y in
let option_default = [] in
- let donothing r k e = k e in
- let mcode _ = option_default in
-
+
(* considers a single list *)
let collect_unitary_nonunitary free_usage =
let free_usage = List.sort compare free_usage in
let (unitary,non_unitary) = loop2 (y::xs) in
(x::unitary,non_unitary) in
loop2 free_usage in
-
+
(* considers a list of lists *)
let detect_unitary_frees l =
let (unitary,nonunitary) =
List.filter (function x -> not (List.mem x nonunitary)) unitary in
unitary@nonunitary@nonunitary in
- let whencode afn bfn = function
+ let whencode afn bfn expression = function
Ast0.WhenNot(a) -> afn a
| Ast0.WhenAlways(b) -> bfn b
- | Ast0.WhenModifier(_) -> option_default in
-
+ | Ast0.WhenModifier(_) -> option_default
+ | Ast0.WhenNotTrue(a) -> expression a
+ | Ast0.WhenNotFalse(a) -> expression a in
+
let ident r k i =
match Ast0.unwrap i with
Ast0.MetaId(name,_,_) | Ast0.MetaFunc(name,_,_)
| Ast0.MetaLocalFunc(name,_,_) -> checker name
| _ -> k i in
-
+
let expression r k e =
match Ast0.unwrap e with
Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
| Ast0.MetaExprList(name,_,_) -> checker name
| Ast0.DisjExpr(starter,expr_list,mids,ender) ->
- detect_unitary_frees(List.map r.V0.combiner_expression expr_list)
+ detect_unitary_frees(List.map r.VT0.combiner_rec_expression expr_list)
| _ -> k e in
-
+
let typeC r k t =
match Ast0.unwrap t with
Ast0.MetaType(name,_) -> checker name
| Ast0.DisjType(starter,types,mids,ender) ->
- detect_unitary_frees(List.map r.V0.combiner_typeC types)
+ detect_unitary_frees(List.map r.VT0.combiner_rec_typeC types)
| _ -> k t in
-
+
let parameter r k p =
match Ast0.unwrap p with
Ast0.MetaParam(name,_) | Ast0.MetaParamList(name,_,_) -> checker name
| _ -> k p in
-
+
let declaration r k d =
match Ast0.unwrap d with
Ast0.DisjDecl(starter,decls,mids,ender) ->
- detect_unitary_frees(List.map r.V0.combiner_declaration decls)
+ detect_unitary_frees(List.map r.VT0.combiner_rec_declaration decls)
| _ -> k d in
+ let case_line r k c =
+ match Ast0.unwrap c with
+ Ast0.DisjCase(starter,case_lines,mids,ender) ->
+ detect_unitary_frees(List.map r.VT0.combiner_rec_case_line case_lines)
+ | _ -> k c in
+
let statement r k s =
match Ast0.unwrap s with
Ast0.MetaStmt(name,_) | Ast0.MetaStmtList(name,_) -> checker name
| Ast0.Disj(starter,stmt_list,mids,ender) ->
- detect_unitary_frees(List.map r.V0.combiner_statement_dots stmt_list)
+ detect_unitary_frees
+ (List.map r.VT0.combiner_rec_statement_dots stmt_list)
| Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
- bind (r.V0.combiner_statement_dots stmt_dots)
- (detect_unitary_frees
+ bind (r.VT0.combiner_rec_statement_dots stmt_dots)
+ (detect_unitary_frees
(List.map
- (whencode r.V0.combiner_statement_dots r.V0.combiner_statement)
+ (whencode
+ r.VT0.combiner_rec_statement_dots
+ r.VT0.combiner_rec_statement
+ r.VT0.combiner_rec_expression)
whn))
| Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) ->
detect_unitary_frees
(List.map
- (whencode r.V0.combiner_statement_dots r.V0.combiner_statement)
+ (whencode
+ r.VT0.combiner_rec_statement_dots r.VT0.combiner_rec_statement
+ r.VT0.combiner_rec_expression)
whn)
| _ -> k s in
-
- let res = V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
- donothing donothing donothing donothing donothing donothing
- ident expression typeC donothing parameter declaration statement
- donothing donothing in
-
+
+ let res = V0.combiner bind option_default
+ {V0.combiner_functions with
+ VT0.combiner_identfn = ident;
+ VT0.combiner_exprfn = expression;
+ VT0.combiner_tyfn = typeC;
+ VT0.combiner_paramfn = parameter;
+ VT0.combiner_declfn = declaration;
+ VT0.combiner_stmtfn = statement;
+ VT0.combiner_casefn = case_line} in
+
collect_unitary_nonunitary
- (List.concat (List.map res.V0.combiner_top_level t))
-
+ (List.concat (List.map res.VT0.combiner_rec_top_level t))
+
(* ----------------------------------------------------------------------- *)
(* update the variables that are unitary *)
-
+
let update_unitary unitary =
- let donothing r k e = k e in
- let mcode x = x in
-
let is_unitary name =
match (List.mem (Ast0.unwrap_mcode name) unitary,
- Ast0.get_mcode_mcodekind name) with
- (true,Ast0.CONTEXT(mc)) -> Ast0.PureContext
- | (true,_) -> Ast0.Pure
- | (false,Ast0.CONTEXT(mc)) -> Ast0.Context
- | (false,_) -> Ast0.Impure in
+ !Flag.sgrep_mode2, Ast0.get_mcode_mcodekind name) with
+ (true,true,_) | (true,_,Ast0.CONTEXT(_)) -> Ast0.PureContext
+ | (true,_,_) -> Ast0.Pure
+ | (false,true,_) | (false,_,Ast0.CONTEXT(_)) -> Ast0.Context
+ | (false,_,_) -> Ast0.Impure in
let ident r k i =
match Ast0.unwrap i with
| Ast0.MetaExprList(name,lenname,_) ->
Ast0.rewrap e (Ast0.MetaExprList(name,lenname,is_unitary name))
| _ -> k e in
-
+
let typeC r k t =
match Ast0.unwrap t with
Ast0.MetaType(name,_) ->
Ast0.rewrap t (Ast0.MetaType(name,is_unitary name))
| _ -> k t in
-
+
let parameter r k p =
match Ast0.unwrap p with
Ast0.MetaParam(name,_) ->
| Ast0.MetaParamList(name,lenname,_) ->
Ast0.rewrap p (Ast0.MetaParamList(name,lenname,is_unitary name))
| _ -> k p in
-
+
let statement r k s =
match Ast0.unwrap s with
Ast0.MetaStmt(name,_) ->
| Ast0.MetaStmtList(name,_) ->
Ast0.rewrap s (Ast0.MetaStmtList(name,is_unitary name))
| _ -> k s in
-
+
let res = V0.rebuilder
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
- donothing donothing donothing donothing donothing donothing
- ident expression typeC donothing parameter donothing statement
- donothing donothing in
+ {V0.rebuilder_functions with
+ VT0.rebuilder_identfn = ident;
+ VT0.rebuilder_exprfn = expression;
+ VT0.rebuilder_tyfn = typeC;
+ VT0.rebuilder_paramfn = parameter;
+ VT0.rebuilder_stmtfn = statement} in
- List.map res.V0.rebuilder_top_level
+ List.map res.VT0.rebuilder_rec_top_level
(* ----------------------------------------------------------------------- *)
[] -> ([],[])
| (r::rules) ->
match r with
- Ast0.ScriptRule (a,b,c,d) ->
+ Ast0.ScriptRule (_,_,_,_)
+ | Ast0.InitialScriptRule (_,_,_) | Ast0.FinalScriptRule (_,_,_) ->
let (x,rules) = loop rules in
(x, r::rules)
- | Ast0.CocciRule ((minus,metavars,chosen_isos),((plus,_) as plusz)) ->
+ | Ast0.CocciRule ((minus,metavars,chosen_isos),((plus,_) as plusz),rt) ->
let mm1 = List.map Ast.get_meta_name metavars in
let (used_after, rest) = loop rules in
let (m_unitary, m_nonunitary) = get_free minus_checker minus in
let (p_unitary, p_nonunitary) = get_free plus_checker plus in
- let p_free =
+ let p_free =
if !Flag.sgrep_mode2 then []
else p_unitary @ p_nonunitary in
let (in_p, m_unitary) =
let rebuilt = update_unitary m_unitary minus in
(set_minus (m_nonunitary @ used_after) mm1,
(Ast0.CocciRule
- ((rebuilt, metavars, chosen_isos),plusz))::rest) in
+ ((rebuilt, metavars, chosen_isos),plusz,rt))::rest) in
let (_,rules) = loop rules in
rules