1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
(*
* This file is part of Coccinelle, licensed under the terms of the GPL v2.
* See copyright.txt in the Coccinelle source code for more information.
* The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
*)
module Ast = Ast_cocci
module V = Visitor_ast
(* if a variable affected by a script constraint is always referenced only
with all the other local variables that are mentioned by that script
constraint, then we can push the script constraint down to the rule_element
level *)
(* Could be more optimal by checking that the params of the constraint
are not under a disj. Memoize to avoid rechecking for each constraint. *)
let disj_free_table = Hashtbl.create 101
let disj_free re =
let bind = (&&) in
let option_default = true in
let mcode _ _ = true in
let donothing r k e = k e in
(* case for anything with a disj *)
let ident r k e =
match Ast.unwrap e with Ast.DisjId _ -> false | _ -> k e in
let expr r k e =
match Ast.unwrap e with Ast.DisjExpr _ -> false | _ -> k e in
let ty r k e =
match Ast.unwrap e with Ast.DisjType _ -> false | _ -> k e in
let decl r k e =
match Ast.unwrap e with Ast.DisjDecl _ -> false | _ -> k e in
let field r k e =
match Ast.unwrap e with Ast.DisjField _ -> false | _ -> k e in
let rule_elem r k e =
match Ast.unwrap e with Ast.DisjRuleElem _ -> false | _ -> k e in
let statement r k e =
match Ast.unwrap e with Ast.Disj _ -> false | _ -> k e in
let v =
V.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
donothing donothing donothing donothing donothing donothing ident
expr donothing donothing donothing donothing ty donothing
donothing donothing donothing decl donothing field donothing
rule_elem statement donothing donothing donothing in
try Hashtbl.find disj_free_table re
with Not_found ->
let res = v.V.combiner_rule_elem re in
Hashtbl.add disj_free_table re res;
res
let ok_for_all_rule_elems cstr minirules =
let bind = (&&) in
let option_default = true in
let mcode _ _ = true in
let donothing r k e = k e in
let (self,(_key,_lang,params,_pos,_code)) = cstr in
let rule_elem r k re =
let available = Ast.get_minus_nc_fvs re in
if List.mem self available
then
let res =
(List.for_all (fun x -> List.mem x available) (List.map fst params)) &&
(disj_free re) in
if res
then res
else
failwith
(Printf.sprintf
"%s: constraint on variable %s cannot be evaluated in line %d. available: %s"
(fst self) (snd self) (Ast.get_line re) (Dumper.dump available))
else true (* not relevant to this rule_elem *) in
let v =
V.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
donothing donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing donothing donothing
rule_elem donothing donothing donothing donothing in
List.for_all v.V.combiner_top_level minirules
let update_for_all_rule_elems cstr minirules =
let mcode mc = mc in
let donothing r k e = k e in
let (self,((_key,_lang,params,_pos,_code) as sc)) = cstr in
let rule_elem r k re =
let re = k re in
let available = Ast.get_minus_nc_fvs re in
if List.mem self available
then Ast.add_constraint re (self,Ast.CstrScript(true,sc))
else re in
let v =
V.rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode mcode
donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing
donothing donothing donothing donothing
donothing rule_elem donothing donothing donothing donothing in
List.map v.V.rebuilder_top_level minirules
let remove rule_name ((nm,_) as x) =
let cell = Hashtbl.find Data.non_local_script_constraints (rule_name,nm) in
let rest = List.filter (function y -> not(x = y)) !cell in
cell := rest
let re_constraints rules =
let constraints_by_rules = Hashtbl.create 101 in
Hashtbl.iter
(fun (rl,_) cstr ->
List.iter (Common.hashadd constraints_by_rules rl) !cstr)
Data.non_local_script_constraints;
let rules =
List.map
(function rule ->
match rule with
Ast.CocciRule(rule_name,info,minirules,b,ty) ->
let constraints =
try !(Hashtbl.find constraints_by_rules rule_name)
with Not_found -> [] in
let minirules =
List.fold_left
(fun minirules cstr ->
if ok_for_all_rule_elems cstr minirules
then
begin
remove rule_name cstr;
update_for_all_rule_elems cstr minirules
end
else minirules)
minirules constraints in
Ast.CocciRule(rule_name,info,minirules,b,ty)
| Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ ->
rule)
rules in
Hashtbl.clear disj_free_table;
rules
|
