(*
-* 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 2010, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, 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.
+ *)
(* For each rule return the list of variables that are used after it.
let astfvident recursor k i =
bind (k i)
(match Ast.unwrap i with
- Ast.MetaId(name,_,_,_) | Ast.MetaFunc(name,_,_,_)
- | Ast.MetaLocalFunc(name,_,_,_) -> [metaid name]
+ Ast.MetaId(name,idconstraint,_,_) | Ast.MetaFunc(name,idconstraint,_,_)
+ | Ast.MetaLocalFunc(name,idconstraint,_,_) ->
+ let metas =
+ if include_constraints
+ then
+ match idconstraint with
+ Ast.IdNegIdSet (_,metas) -> metas
+ | _ -> []
+ else [] in
+ bind (List.rev metas) [metaid name]
| _ -> option_default) in
let rec type_collect res = function
TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
| TC.Array(ty) -> type_collect res ty
- | TC.MetaType(tyname,_,_) -> bind [tyname] res
+ | TC.MetaType(tyname,_,_) ->
+ bind [tyname] res
| TC.SignedT(_,Some ty) -> type_collect res ty
| ty -> res in
let astfvexpr recursor k e =
bind (k e)
(match Ast.unwrap e with
- Ast.MetaExpr(name,_,_,Some type_list,_,_) ->
+ Ast.MetaExpr(name,constraints,_,Some type_list,_,_) ->
let types = List.fold_left type_collect option_default type_list in
- bind [metaid name] types
- | Ast.MetaErr(name,_,_,_) | Ast.MetaExpr(name,_,_,_,_,_) -> [metaid name]
+ let extra =
+ if include_constraints
+ then
+ match constraints with
+ Ast.SubExpCstrt l -> l
+ | _ -> []
+ else [] in
+ bind extra (bind [metaid name] types)
+ | Ast.MetaErr(name,constraints,_,_)
+ | Ast.MetaExpr(name,constraints,_,_,_,_) ->
+ let extra =
+ if include_constraints
+ then
+ match constraints with
+ Ast.SubExpCstrt l -> l
+ | _ -> []
+ else [] in
+ bind extra [metaid name]
| Ast.MetaExprList(name,None,_,_) -> [metaid name]
| Ast.MetaExprList(name,Some (lenname,_,_),_,_) ->
[metaid name;metaid lenname]
let astfvident recursor k i =
bind (k i)
(match Ast.unwrap i with
- Ast.MetaId(name,_,TC.Saved,_) | Ast.MetaFunc(name,_,TC.Saved,_)
- | Ast.MetaLocalFunc(name,_,TC.Saved,_) -> [metaid name]
+ Ast.MetaId(name,_,TC.Saved,_)
+ | Ast.MetaFunc(name,_,TC.Saved,_)
+ | Ast.MetaLocalFunc(name,_,TC.Saved,_) ->
+ [metaid name]
| _ -> option_default) in
let rec type_collect res = function
TC.ConstVol(_,ty) | TC.Pointer(ty) | TC.FunctionPointer(ty)
| TC.Array(ty) -> type_collect res ty
- | TC.MetaType(tyname,TC.Saved,_) -> bind [tyname] res
+ | TC.MetaType(tyname,TC.Saved,_) ->
+ bind [tyname] res
| TC.SignedT(_,Some ty) -> type_collect res ty
| ty -> res in
Ast.MINUS(_,_,_,anythings) -> process_anything_list_list anythings
| Ast.CONTEXT(_,befaft) ->
(match befaft with
- Ast.BEFORE(ll) -> process_anything_list_list ll
- | Ast.AFTER(ll) -> process_anything_list_list ll
- | Ast.BEFOREAFTER(llb,lla) ->
+ Ast.BEFORE(ll,_) -> process_anything_list_list ll
+ | Ast.AFTER(ll,_) -> process_anything_list_list ll
+ | Ast.BEFOREAFTER(llb,lla,_) ->
(process_anything_list_list lla) @
(process_anything_list_list llb)
| Ast.NOTHING -> [])
- | Ast.PLUS -> []
+ | Ast.PLUS _ -> []
let collect_fresh_seed_env metavars l =
match Ast.unwrap e with
Ast.MetaId(name,constraints,_,_) ->
let (unitary,inherited) = classify name in
- Ast.rewrap e (Ast.MetaId(name,constraints,unitary,inherited))
+ Ast.rewrap e
+ (Ast.MetaId(name,constraints,unitary,inherited))
| Ast.MetaFunc(name,constraints,_,_) ->
let (unitary,inherited) = classify name in
Ast.rewrap e (Ast.MetaFunc(name,constraints,unitary,inherited))
(List.rev matched, List.rev freshvars) in
(* cases for the elements of anything *)
- let astfvrule_elem recursor k re =
- let minus_free = nub (collect_all_refs.V.combiner_rule_elem re) in
+ let simple_setup getter k re =
+ let minus_free = nub (getter collect_all_refs re) in
let minus_nc_free =
- nub (collect_non_constraint_refs.V.combiner_rule_elem re) in
+ nub (getter collect_non_constraint_refs re) in
let plus_free =
- collect_fresh_seed metavars
- (collect_in_plus_term.V.combiner_rule_elem re) in
+ collect_fresh_seed metavars (getter collect_in_plus_term re) in
let free = Common.union_set minus_free plus_free in
let nc_free = Common.union_set minus_nc_free plus_free in
let unbound =
Ast.inherited = inherited;
Ast.saved_witness = []} in
+ let astfvrule_elem recursor k re =
+ simple_setup (function x -> x.V.combiner_rule_elem) k re in
+
let astfvstatement recursor k s =
let minus_free = nub (collect_all_refs.V.combiner_statement s) in
let minus_nc_free =
Ast.saved_witness = []} in
let astfvstatement_dots recursor k sd =
- let minus_free = nub (collect_all_refs.V.combiner_statement_dots sd) in
- let minus_nc_free =
- nub (collect_non_constraint_refs.V.combiner_statement_dots sd) in
- let plus_free =
- collect_fresh_seed metavars
- (collect_in_plus_term.V.combiner_statement_dots sd) in
- let free = Common.union_set minus_free plus_free in
- let nc_free = Common.union_set minus_nc_free plus_free in
- let unbound =
- List.filter (function x -> not(List.mem x bound)) free in
- let inherited =
- List.filter (function x -> List.mem x bound) nc_free in
- let munbound =
- List.filter (function x -> not(List.mem x bound)) minus_free in
- let (matched,fresh) = collect_fresh unbound in
- {(k sd) with
- Ast.free_vars = matched;
- Ast.minus_free_vars = munbound;
- Ast.fresh_vars = fresh;
- Ast.inherited = inherited;
- Ast.saved_witness = []} in
+ simple_setup (function x -> x.V.combiner_statement_dots) k sd in
+
+ let astfvcase_line recursor k cl =
+ simple_setup (function x -> x.V.combiner_case_line) k cl in
let astfvtoplevel recursor k tl =
let saved = collect_saved.V.combiner_top_level tl in
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
donothing donothing astfvstatement_dots donothing
donothing donothing donothing donothing donothing donothing donothing
- astfvrule_elem astfvstatement donothing astfvtoplevel donothing
+ astfvrule_elem astfvstatement astfvcase_line astfvtoplevel donothing
(*
let collect_astfvs rules =
[] -> []
| (metavars, rule)::rules ->
match rule with
- Ast.ScriptRule (_,_,_,_)
- | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
+ Ast.ScriptRule (_,_,_,_,_)
+ | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) ->
(* bound stays as is because script rules have no names, so no
inheritance is possible *)
rule::(loop bound rules)
let collect_top_level_used_after metavar_rule_list =
+ let drop_virt = List.filter (function ("virtual",_) -> false | _ -> true) in
let (used_after,used_after_lists) =
List.fold_right
(function (metavar_list,r) ->
used_after in
let free_vars =
match r with
- Ast.ScriptRule (_,_,mv,_) ->
- List.map (function (_,(r,v)) -> (r,v)) mv
- | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) -> []
+ Ast.ScriptRule (_,_,_,mv,_) ->
+ drop_virt(List.map (function (_,(r,v),_) -> (r,v)) mv)
+ | Ast.InitialScriptRule (_,_,_,_)
+ | Ast.FinalScriptRule (_,_,_,_) -> []
| Ast.CocciRule (_,_,rule,_,_) ->
- Common.union_set (nub (collect_all_rule_refs rule))
- (collect_in_plus metavar_list rule) in
+ drop_virt
+ (Common.union_set (nub (collect_all_rule_refs rule))
+ (collect_in_plus metavar_list rule)) in
let inherited =
List.filter (function x -> not (List.mem x locally_defined))
free_vars in
(function (metavars,r) ->
function used_after ->
match r with
- Ast.ScriptRule (_,_,_,_)
- | Ast.InitialScriptRule (_,_) | Ast.FinalScriptRule (_,_) ->
+ Ast.ScriptRule (_,_,_,_,_)
+ | Ast.InitialScriptRule (_,_,_,_) | Ast.FinalScriptRule (_,_,_,_) ->
([], [used_after], [], [])
| Ast.CocciRule (name, rule_info, minirules, _,_) ->
collect_local_used_after metavars minirules used_after
HCoop / bpt / coccinelle.git / blobdiff