2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
25 (* get a list of all of the constants in the - slice of a SmPL file, to be
26 used to select which files to process *)
28 (* This could be made more efficient, by finding only the important things.
29 eg, if we have a function and its arguments, we could just pick the function.
30 And we could try to pick only the things annotated with -, and only pick
31 something else if there is no -. In general, we only want the most important
32 constant, not all the constants. *)
34 module Ast
= Ast_cocci
35 module V
= Visitor_ast
36 module TC
= Type_cocci
38 let keep_some_bind x y
= match x
with [] -> y
| _
-> x
39 let or_bind x y
= match x
with [] -> [] | _
-> x
40 let keep_all_bind = Common.union_set
42 let get_minus_constants bind orbind
=
43 let donothing r k e
= k e
in
44 let option_default = [] in
45 let mcode _ _
= option_default in
47 (* if one branch gives no information, then we have to take anything *)
48 let disj_union_all l
=
49 if List.exists
(function [] -> true | _
-> false) l
50 then orbind
[] (Common.union_all l
)
51 else Common.union_all l
in
53 (* need special cases for everything with a disj, because the bind above
54 would throw away all but the first disj *)
57 match Ast.unwrap e
with
59 (match Ast.unwrap_mcode name
with
60 "NULL" -> [] (* special case, because this is too generic *)
64 let expression r k e
=
65 match Ast.unwrap e
with
66 Ast.RecordAccess
(exp
,_
,fld
) | Ast.RecordPtAccess
(exp
,_
,fld
) ->
69 (List.map
(function id
-> ["."^id
;"->"^id
])
70 (r
.V.combiner_ident fld
)))
71 (r
.V.combiner_expression exp
)
72 | Ast.SizeOfExpr
(sizeof
,_
) | Ast.SizeOfType
(sizeof
,_
,_
,_
) ->
73 bind
(k e
) [Ast.unwrap_mcode sizeof
]
74 | Ast.DisjExpr
(exps
) ->
75 disj_union_all (List.map r
.V.combiner_expression exps
)
76 | Ast.Edots
(_
,_
) | Ast.Ecircles
(_
,_
) | Ast.Estars
(_
,_
) -> []
77 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,false) -> []
78 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,true) ->
79 r
.V.combiner_expression_dots expr_dots
83 match Ast.unwrap e
with
88 (_
,_
,Ast.MINUS
(_
,_
,_
,_
),_
) -> [Ast.unwrap_mcode ty
]
90 else [Ast.unwrap_mcode ty
]
94 match Ast.unwrap e
with
95 Ast.DisjType
(types
) ->
96 disj_union_all (List.map r
.V.combiner_fullType types
)
99 let declaration r k e
=
100 match Ast.unwrap e
with
101 Ast.DisjDecl
(decls
) ->
102 disj_union_all (List.map r
.V.combiner_declaration decls
)
103 | Ast.Ddots
(dots
,whencode
) -> []
106 let rule_elem r k e
=
107 match Ast.unwrap e
with
108 Ast.DisjRuleElem
(res
) ->
109 disj_union_all (List.map r
.V.combiner_rule_elem res
)
112 let statement r k e
=
113 match Ast.unwrap e
with
114 Ast.Disj
(stmt_dots
) ->
115 disj_union_all (List.map r
.V.combiner_statement_dots stmt_dots
)
116 | Ast.Dots
(d
,whn
,_
,_
) | Ast.Circles
(d
,whn
,_
,_
) | Ast.Stars
(d
,whn
,_
,_
) -> []
117 | Ast.Nest
(starter
,stmt_dots
,ender
,whn
,false,_
,_
) -> []
118 | Ast.Nest
(starter
,stmt_dots
,ender
,whn
,true,_
,_
) ->
119 r
.V.combiner_statement_dots stmt_dots
122 V.combiner bind
option_default
123 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
124 donothing donothing donothing donothing
125 ident expression fullType typeC donothing donothing declaration
126 rule_elem statement donothing donothing donothing
128 (* ------------------------------------------------------------------------ *)
130 let get_all_minus_constants =
131 let donothing r k e
= k e
in
132 let bind = Common.union_set
in
133 let option_default = [] in
134 let mcode r
(x
,_
,mcodekind
,_
) =
136 Ast.MINUS
(_
,_
,_
,_
) -> [x
]
138 let other r
(x
,_
,mcodekind
,_
) = [] in
140 V.combiner
bind option_default
141 other mcode other other other other other other other other other other
143 donothing donothing donothing donothing
144 donothing donothing donothing donothing donothing donothing donothing
145 donothing donothing donothing donothing donothing
146 (* ------------------------------------------------------------------------ *)
148 let get_plus_constants =
149 let donothing r k e
= k e
in
150 let bind = Common.union_set
in
151 let option_default = [] in
152 let mcode r
(_
,_
,mcodekind
,_
) =
158 let fn = get_minus_constants keep_all_bind keep_all_bind in
159 bind (fn.V.combiner_anything cur
) prev
))
162 Ast.MINUS
(_
,_
,_
,anythings
) -> recurse anythings
163 | Ast.CONTEXT
(_
,Ast.BEFORE
(a
,_
)) -> recurse a
164 | Ast.CONTEXT
(_
,Ast.AFTER
(a
,_
)) -> recurse a
165 | Ast.CONTEXT
(_
,Ast.BEFOREAFTER
(a1
,a2
,_
)) ->
166 Common.union_set
(recurse a1
) (recurse a2
)
169 V.combiner
bind option_default
170 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
171 donothing donothing donothing donothing
172 donothing donothing donothing donothing donothing donothing donothing
173 donothing donothing donothing donothing donothing
175 (* ------------------------------------------------------------------------ *)
176 (* see if there are any inherited variables that must be bound for this rule
179 let check_inherited nm
=
180 let donothing r k e
= k e
in
181 let option_default = false in
182 let bind x y
= x
or y
in
183 let inherited (nm1
,_
) = not
(nm
= nm1
) in
184 let minherited mc
= inherited (Ast.unwrap_mcode mc
) in
186 match Ast.get_pos_var x
with
187 Ast.MetaPos
(name
,constraints
,_
,keep
,inh
) -> minherited name
188 | _
-> option_default in
190 (* a case for everything for there is a metavariable, also disjunctions
191 or optional things *)
193 let strictident recursor k i
=
194 match Ast.unwrap i
with
195 Ast.MetaId
(name
,_
,_
,_
) | Ast.MetaFunc
(name
,_
,_
,_
)
196 | Ast.MetaLocalFunc
(name
,_
,_
,_
) -> bind (k i
) (minherited name
)
199 let rec type_collect res
= function
200 TC.ConstVol
(_
,ty
) | TC.Pointer
(ty
) | TC.FunctionPointer
(ty
)
201 | TC.Array
(ty
) -> type_collect res ty
202 | TC.MetaType
(tyname
,_
,_
) ->
206 let strictexpr recursor k e
=
207 match Ast.unwrap e
with
208 Ast.MetaExpr
(name
,_
,_
,Some type_list
,_
,_
) ->
209 let types = List.fold_left
type_collect option_default type_list
in
210 bind (minherited name
) types
211 | Ast.MetaErr
(name
,_
,_
,_
) | Ast.MetaExpr
(name
,_
,_
,_
,_
,_
) ->
212 bind (k e
) (minherited name
)
213 | Ast.MetaExprList
(name
,None
,_
,_
) -> bind (k e
) (minherited name
)
214 | Ast.MetaExprList
(name
,Some
(lenname
,_
,_
),_
,_
) ->
215 bind (k e
) (bind (minherited name
) (minherited lenname
))
216 | Ast.DisjExpr
(exps
) ->
217 (* could see if there are any variables that appear in all branches,
218 but perhaps not worth it *)
222 let strictdecls recursor k d
=
223 match Ast.unwrap d
with
224 Ast.DisjDecl
(decls
) -> option_default
227 let strictfullType recursor k ty
=
228 match Ast.unwrap ty
with
229 Ast.DisjType
(types) -> option_default
232 let stricttypeC recursor k ty
=
233 match Ast.unwrap ty
with
234 Ast.MetaType
(name
,_
,_
) -> bind (k ty
) (minherited name
)
237 let strictparam recursor k p
=
238 match Ast.unwrap p
with
239 Ast.MetaParam
(name
,_
,_
) -> bind (k p
) (minherited name
)
240 | Ast.MetaParamList
(name
,None
,_
,_
) -> bind (k p
) (minherited name
)
241 | Ast.MetaParamList
(name
,Some
(lenname
,_
,_
),_
,_
) ->
242 bind (k p
) (bind (minherited name
) (minherited lenname
))
245 let strictrule_elem recursor k re
=
246 (*within a rule_elem, pattern3 manages the coherence of the bindings*)
247 match Ast.unwrap re
with
248 Ast.MetaRuleElem
(name
,_
,_
) | Ast.MetaStmt
(name
,_
,_
,_
)
249 | Ast.MetaStmtList
(name
,_
,_
) -> bind (k re
) (minherited name
)
252 let strictstatement recursor k s
=
253 match Ast.unwrap s
with
254 Ast.Disj
(stms
) -> option_default
257 V.combiner
bind option_default
258 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
259 donothing donothing donothing donothing
260 strictident strictexpr strictfullType stricttypeC donothing strictparam
261 strictdecls strictrule_elem strictstatement donothing donothing donothing
263 (* ------------------------------------------------------------------------ *)
265 let rec dependent = function
267 | Ast.AntiDep s
-> false
268 | Ast.EverDep s
-> true
269 | Ast.NeverDep s
-> false
270 | Ast.AndDep
(d1
,d2
) -> dependent d1
or dependent d2
271 | Ast.OrDep
(d1
,d2
) -> dependent d1
&& dependent d2
273 | Ast.FailDep
-> true
275 (* ------------------------------------------------------------------------ *)
277 let rule_fn tls in_plus
=
279 (function (rest_info
,in_plus
) ->
281 let mfn = get_minus_constants keep_some_bind or_bind in
282 let minuses = mfn.V.combiner_top_level cur
in
285 then [] (* nothing removed for sgrep *)
286 else get_all_minus_constants.V.combiner_top_level cur
in
287 let plusses = get_plus_constants.V.combiner_top_level cur
in
288 (* the following is for eg -foo(2) +foo(x) then in another rule
289 -foo(10); don't want to consider that foo is guaranteed to be
290 created by the rule. not sure this works completely: what if foo is
291 in both - and +, but in an or, so the cases aren't related?
292 not sure this whole thing is a good idea. how do we know that
293 something that is only in plus is really freshly created? *)
294 let plusses = Common.minus_set
plusses all_minuses in
295 let new_minuses = Common.minus_set
minuses in_plus
in
296 let new_plusses = Common.union_set
plusses in_plus
in
297 (Common.union_set
new_minuses rest_info
, new_plusses))
302 let get_constants rules
=
306 (function (rest_info
,in_plus
) ->
309 Ast.ScriptRule
(_
,_
,_
,_
)
310 | Ast.InitialScriptRule
(_
,_
,_
) | Ast.FinalScriptRule
(_
,_
,_
) ->
312 | Ast.CocciRule
(nm
, (dep
,_
,_
), cur
, _
, _
) ->
313 let (cur_info
,cur_plus
) = rule_fn cur in_plus
in
315 (* no dependencies if dependent on another rule; then we
316 need to find the constants of that rule *)
318 List.for_all
(check_inherited nm
).V.combiner_top_level cur
321 if cur_info = [] then raise No_info
else cur_info in
322 (Common.union_set
[cur_info] rest_info
,cur_plus
))
325 with No_info
-> List.map
(function _
-> []) rules