2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
27 (* on the first pass, onlyModif is true, so we don't see all matched nodes,
30 module Ast
= Ast_cocci
31 module V
= Visitor_ast
34 let mcode r
(_
,_
,kind
,_
) =
36 Ast.MINUS
(_
,_
,_
,_
) -> true
37 | Ast.PLUS _
-> failwith
"not possible"
38 | Ast.CONTEXT
(_
,info
) -> not
(info
= Ast.NOTHING
)
40 let no_mcode _ _
= false
42 let contains_modif used_after x
=
43 if List.exists
(function x
-> List.mem x used_after
) (Ast.get_fvs x
)
46 let bind x y
= x
or y
in
47 let option_default = false in
48 let do_nothing r k e
= k e
in
49 let rule_elem r k re
=
51 match Ast.unwrap re
with
52 Ast.FunHeader
(bef
,_
,fninfo
,name
,lp
,params
,rp
) ->
53 bind (mcode r
((),(),bef
,[])) res
54 | Ast.Decl
(bef
,_
,decl
) ->
55 bind (mcode r
((),(),bef
,[])) res
58 V.combiner
bind option_default
59 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
61 do_nothing do_nothing do_nothing do_nothing do_nothing
62 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
63 do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in
64 recursor.V.combiner_rule_elem x
66 (* contains an inherited metavariable or contains a constant *)
67 let contains_constant x
=
68 match Ast.get_inherited x
with
70 let bind x y
= x
or y
in
71 let option_default = false in
72 let do_nothing r k e
= k e
in
73 let mcode _ _
= false in
75 match Ast.unwrap i
with
79 match Ast.unwrap e
with
80 Ast.Constant
(const
) -> true
83 V.combiner
bind option_default
84 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
86 do_nothing do_nothing do_nothing do_nothing do_nothing
87 ident expr do_nothing do_nothing do_nothing do_nothing
88 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in
89 recursor.V.combiner_rule_elem x
92 (* --------------------------------------------------------------------- *)
94 let print_info = function
95 [] -> Printf.printf
"no information\n"
99 Printf.printf
"one set of required things %d:\n"
102 (function (_
,thing
) ->
104 (Pretty_print_cocci.rule_elem_to_string thing
))
108 (* --------------------------------------------------------------------- *)
110 (* drop all distinguishing information from a term except inherited
111 variables, which are used to improve efficiency of matching process *)
113 let do_nothing r k e
=
114 let inh = Ast.get_inherited e
in
115 Ast.make_inherited_term
(Ast.unwrap
(k e
)) inh in
116 let do_absolutely_nothing r k e
= k e
in
117 let mcode m
= Ast.make_mcode
(Ast.unwrap_mcode m
) in
118 let rule_elem r k re
=
119 let res = do_nothing r k re
in
120 let no_mcode = Ast.CONTEXT
(Ast.NoPos
,Ast.NOTHING
) in
121 match Ast.unwrap
res with
122 Ast.FunHeader
(bef
,b
,fninfo
,name
,lp
,params
,rp
) ->
124 (Ast.FunHeader
(no_mcode,b
,fninfo
,name
,lp
,params
,rp
))
125 | Ast.Decl
(bef
,b
,decl
) -> Ast.rewrap
res (Ast.Decl
(no_mcode,b
,decl
))
129 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
130 do_nothing do_nothing do_nothing do_nothing do_nothing
131 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
132 do_nothing rule_elem do_nothing do_nothing
133 do_nothing do_absolutely_nothing in
134 recursor.V.rebuilder_rule_elem x
136 (* --------------------------------------------------------------------- *)
138 let disj l1 l2
= l1 l2
151 let cur_res = (List.sort compare
(Common.union_set x cur
)) in
154 (function x
-> not
(Common.include_set
cur_res x
))
159 let conj_wrapped x l
= conj [List.map
(function x
-> (1,strip x
)) x
] l
161 (* --------------------------------------------------------------------- *)
162 (* the main translation loop *)
164 let rec rule_elem re
=
165 match Ast.unwrap re
with
166 Ast.DisjRuleElem
(res) ->
167 (* why was the following done? ors have to be kept together for
168 efficiency, so they are considered at once and not individually
169 anded with everything else *)
171 let all_inhs = List.map
Ast.get_inherited
res in
176 Common.inter_set
inh prev
)
177 (List.hd
all_inhs) (List.tl
all_inhs) in
178 Ast.make_inherited_term
(Ast.unwrap
re) inhs in
179 [[(List.length
res,strip re)]]
180 | _
-> [[(1,strip re)]]
182 let conj_one testfn x l
=
184 then conj (rule_elem x
) l
187 let rec statement_list testfn
mcode tail stmt_list
: 'a list list
=
188 match Ast.unwrap stmt_list
with
189 Ast.DOTS
(x
) | Ast.CIRCLES
(x
) | Ast.STARS
(x
) ->
190 (match List.rev x
with
196 conj (statement testfn
mcode false cur
) rest
)
197 rest
(statement testfn
mcode tail last
))
199 and statement testfn
mcode tail stmt
: 'a list list
=
200 match Ast.unwrap stmt
with
202 (match Ast.unwrap ast
with
203 (* modifications on return are managed in some other way *)
204 Ast.Return
(_
,_
) | Ast.ReturnExpr
(_
,_
,_
) when tail
-> []
205 | _
-> if testfn ast
then rule_elem ast
else [])
206 | Ast.Seq
(lbrace
,body
,rbrace
) ->
207 let body_info = statement_list testfn
mcode tail body
in
208 if testfn lbrace
or testfn rbrace
209 then conj_wrapped [lbrace
;rbrace
] body_info
212 | Ast.IfThen
(header
,branch
,(_
,_
,_
,aft
))
213 | Ast.While
(header
,branch
,(_
,_
,_
,aft
))
214 | Ast.For
(header
,branch
,(_
,_
,_
,aft
))
215 | Ast.Iterator
(header
,branch
,(_
,_
,_
,aft
)) ->
216 if testfn header
or mcode () ((),(),aft
,[])
217 then conj (rule_elem header
) (statement testfn
mcode tail branch
)
218 else statement testfn
mcode tail branch
220 | Ast.Switch
(header
,lb
,decls
,cases
,rb
) ->
223 (statement_list testfn
mcode false decls
)
224 (case_lines testfn
mcode tail cases
) in
225 if testfn header
or testfn lb
or testfn rb
226 then conj (rule_elem header
) body_info
229 | Ast.IfThenElse
(ifheader
,branch1
,els
,branch2
,(_
,_
,_
,aft
)) ->
232 (statement testfn
mcode tail branch1
)
233 (statement testfn
mcode tail branch2
) in
234 if testfn ifheader
or mcode () ((),(),aft
,[])
235 then conj (rule_elem ifheader
) branches
238 | Ast.Disj
(stmt_dots_list
) ->
240 List.map
(statement_list testfn
mcode tail
) stmt_dots_list
in
241 (* if one branch gives no information, then we have to take anything *)
242 if List.exists
(function [] -> true | _
-> false) processed
244 else Common.union_all
processed
246 | Ast.Nest
(starter
,stmt_dots
,ender
,whencode
,true,_
,_
) ->
247 statement_list testfn
mcode false stmt_dots
249 | Ast.Nest
(starter
,stmt_dots
,ender
,whencode
,false,_
,_
) -> []
251 | Ast.Dots
(_
,whencodes
,_
,_
) -> []
253 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
254 let body_info = statement_list testfn
mcode true body
in
255 if testfn header
or testfn lbrace
or testfn rbrace
256 then conj (rule_elem header
) body_info
259 | Ast.Define
(header
,body
) ->
260 conj_one testfn header
(statement_list testfn
mcode tail body
)
262 | Ast.AsStmt
(stm
,asstm
) ->
264 (statement testfn
mcode tail stm
)
265 (statement testfn
mcode tail asstm
)
267 | Ast.OptStm
(stm
) -> []
269 | Ast.UniqueStm
(stm
) -> statement testfn
mcode tail stm
271 | _
-> failwith
"not supported"
273 and case_lines testfn
mcode tail cases
=
280 conj (case_line testfn
mcode false cur
) rest
)
281 rest
(case_line testfn
mcode tail last
)
283 and case_line testfn
mcode tail case
=
284 match Ast.unwrap case
with
285 Ast.CaseLine
(header
,code
) ->
286 conj_one testfn header
(statement_list testfn
mcode tail code
)
288 | Ast.OptCase
(case
) -> []
290 (* --------------------------------------------------------------------- *)
291 (* Function declaration *)
293 let top_level testfn
mcode t
: 'a list list
=
294 match Ast.unwrap t
with
295 Ast.FILEINFO
(old_file
,new_file
) -> failwith
"not supported fileinfo"
296 | Ast.NONDECL
(stmt
) -> statement testfn
mcode false stmt
297 | Ast.CODE
(stmt_dots
) -> statement_list testfn
mcode false stmt_dots
298 | Ast.ERRORWORDS
(exps
) -> failwith
"not supported errorwords"
300 (* --------------------------------------------------------------------- *)
305 (* if we end up with nothing, we assume that this rule is only here because
306 someone depends on it, and thus we try again with testfn as contains_modif.
307 Alternatively, we could check that this rule is mentioned in some
308 dependency, but that would be a little more work, and doesn't seem
311 (* lists are sorted such that smaller DisjRuleElem are first, because they
312 are cheaper to test *)
314 let asttomemberz (_
,_
,l
) used_after
=
315 let process_one (l
: (int * Ast_cocci.rule_elem) list list
) =
321 List.sort
(function (n1
,_
) -> function (n2
,_
) -> compare n1 n2
)
323 List.map
(function (_
,x
) -> (Lib_engine.Match
(x
),CTL.Control
)) info)
326 (function min
-> function (max
,big_max
) ->
330 [] -> process_one (big_max
())
331 | max
-> process_one max
)
332 | _
-> process_one min
)
333 (List.map
(top_level contains_constant no_mcode) l
)
336 (function x
-> function ua
-> function _
->
337 top_level (contains_modif ua
) mcode x
)
340 (function x
-> function _
->
341 top_level (function _
-> true) no_mcode x
)
344 let asttomember r used_after
=
346 Ast.ScriptRule _
| Ast.InitialScriptRule _
| Ast.FinalScriptRule _
-> []
347 | Ast.CocciRule
(a
,b
,c
,_
,_
) -> asttomemberz (a
,b
,c
) used_after