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 (* on the first pass, onlyModif is true, so we don't see all matched nodes,
28 module Ast
= Ast_cocci
29 module V
= Visitor_ast
32 let mcode r
(_
,_
,kind
,_
) =
34 Ast.MINUS
(_
,_
,_
,_
) -> true
35 | Ast.PLUS _
-> failwith
"not possible"
36 | Ast.CONTEXT
(_
,info
) -> not
(info
= Ast.NOTHING
)
38 let no_mcode _ _
= false
40 let contains_modif used_after x
=
41 if List.exists
(function x
-> List.mem x used_after
) (Ast.get_fvs x
)
44 let bind x y
= x
or y
in
45 let option_default = false in
46 let do_nothing r k e
= k e
in
47 let rule_elem r k re
=
49 match Ast.unwrap re
with
50 Ast.FunHeader
(bef
,_
,fninfo
,name
,lp
,params
,rp
) ->
51 bind (mcode r
((),(),bef
,Ast.NoMetaPos
)) res
52 | Ast.Decl
(bef
,_
,decl
) ->
53 bind (mcode r
((),(),bef
,Ast.NoMetaPos
)) res
56 V.combiner
bind option_default
57 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
59 do_nothing do_nothing do_nothing do_nothing do_nothing
60 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
61 do_nothing rule_elem do_nothing do_nothing do_nothing do_nothing in
62 recursor.V.combiner_rule_elem x
64 (* contains an inherited metavariable or contains a constant *)
65 let contains_constant x
=
66 match Ast.get_inherited x
with
68 let bind x y
= x
or y
in
69 let option_default = false in
70 let do_nothing r k e
= k e
in
71 let mcode _ _
= false in
73 match Ast.unwrap i
with
77 match Ast.unwrap e
with
78 Ast.Constant
(const
) -> true
81 V.combiner
bind option_default
82 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
84 do_nothing do_nothing do_nothing do_nothing do_nothing
85 ident expr do_nothing do_nothing do_nothing do_nothing
86 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing in
87 recursor.V.combiner_rule_elem x
90 (* --------------------------------------------------------------------- *)
92 let print_info = function
93 [] -> Printf.printf
"no information\n"
97 Printf.printf
"one set of required things %d:\n"
100 (function (_
,thing
) ->
102 (Pretty_print_cocci.rule_elem_to_string thing
))
106 (* --------------------------------------------------------------------- *)
108 (* drop all distinguishing information from a term *)
110 let do_nothing r k e
= Ast.make_term
(Ast.unwrap
(k e
)) in
111 let do_absolutely_nothing r k e
= k e
in
112 let mcode m
= Ast.make_mcode
(Ast.unwrap_mcode m
) in
113 let rule_elem r k re
=
114 let res = do_nothing r k re
in
115 let no_mcode = Ast.CONTEXT
(Ast.NoPos
,Ast.NOTHING
) in
116 match Ast.unwrap
res with
117 Ast.FunHeader
(bef
,b
,fninfo
,name
,lp
,params
,rp
) ->
119 (Ast.FunHeader
(no_mcode,b
,fninfo
,name
,lp
,params
,rp
))
120 | Ast.Decl
(bef
,b
,decl
) -> Ast.rewrap
res (Ast.Decl
(no_mcode,b
,decl
))
124 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
125 do_nothing do_nothing do_nothing do_nothing do_nothing
126 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
127 do_nothing rule_elem do_nothing do_nothing
128 do_nothing do_absolutely_nothing in
129 recursor.V.rebuilder_rule_elem
131 (* --------------------------------------------------------------------- *)
133 let disj l1 l2
= l1 l2
146 let cur_res = (List.sort compare
(Common.union_set x cur
)) in
149 (function x
-> not
(Common.include_set
cur_res x
))
154 let conj_wrapped x l
= conj [List.map
(function x
-> (1,strip x
)) x
] l
156 (* --------------------------------------------------------------------- *)
157 (* the main translation loop *)
160 match Ast.unwrap re
with
161 Ast.DisjRuleElem
(res) -> [[(List.length
res,strip re
)]]
162 | _
-> [[(1,strip re
)]]
164 let conj_one testfn x l
=
166 then conj (rule_elem x
) l
169 let rec statement_list testfn
mcode tail stmt_list
: 'a list list
=
170 match Ast.unwrap stmt_list
with
171 Ast.DOTS
(x
) | Ast.CIRCLES
(x
) | Ast.STARS
(x
) ->
172 (match List.rev x
with
178 conj (statement testfn
mcode false cur
) rest
)
179 rest
(statement testfn
mcode tail last
))
181 and statement testfn
mcode tail stmt
: 'a list list
=
182 match Ast.unwrap stmt
with
184 (match Ast.unwrap ast
with
185 (* modifications on return are managed in some other way *)
186 Ast.Return
(_
,_
) | Ast.ReturnExpr
(_
,_
,_
) when tail
-> []
187 | _
-> if testfn ast
then rule_elem ast
else [])
188 | Ast.Seq
(lbrace
,body
,rbrace
) ->
189 let body_info = statement_list testfn
mcode tail body
in
190 if testfn lbrace
or testfn rbrace
191 then conj_wrapped [lbrace
;rbrace
] body_info
194 | Ast.IfThen
(header
,branch
,(_
,_
,_
,aft
))
195 | Ast.While
(header
,branch
,(_
,_
,_
,aft
))
196 | Ast.For
(header
,branch
,(_
,_
,_
,aft
))
197 | Ast.Iterator
(header
,branch
,(_
,_
,_
,aft
)) ->
198 if testfn header
or mcode () ((),(),aft
,Ast.NoMetaPos
)
199 then conj (rule_elem header
) (statement testfn
mcode tail branch
)
200 else statement testfn
mcode tail branch
202 | Ast.Switch
(header
,lb
,decls
,cases
,rb
) ->
205 (statement_list testfn
mcode false decls
)
206 (case_lines testfn
mcode tail cases
) in
207 if testfn header
or testfn lb
or testfn rb
208 then conj (rule_elem header
) body_info
211 | Ast.IfThenElse
(ifheader
,branch1
,els
,branch2
,(_
,_
,_
,aft
)) ->
214 (statement testfn
mcode tail branch1
)
215 (statement testfn
mcode tail branch2
) in
216 if testfn ifheader
or mcode () ((),(),aft
,Ast.NoMetaPos
)
217 then conj (rule_elem ifheader
) branches
220 | Ast.Disj
(stmt_dots_list
) ->
222 List.map
(statement_list testfn
mcode tail
) stmt_dots_list
in
223 (* if one branch gives no information, then we have to take anything *)
224 if List.exists
(function [] -> true | _
-> false) processed
226 else Common.union_all
processed
228 | Ast.Nest
(starter
,stmt_dots
,ender
,whencode
,true,_
,_
) ->
229 statement_list testfn
mcode false stmt_dots
231 | Ast.Nest
(starter
,stmt_dots
,ender
,whencode
,false,_
,_
) -> []
233 | Ast.Dots
(_
,whencodes
,_
,_
) -> []
235 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
236 let body_info = statement_list testfn
mcode true body
in
237 if testfn header
or testfn lbrace
or testfn rbrace
238 then conj (rule_elem header
) body_info
241 | Ast.Define
(header
,body
) ->
242 conj_one testfn header
(statement_list testfn
mcode tail body
)
244 | Ast.OptStm
(stm
) -> []
246 | Ast.UniqueStm
(stm
) -> statement testfn
mcode tail stm
248 | _
-> failwith
"not supported"
250 and case_lines testfn
mcode tail cases
=
257 conj (case_line testfn
mcode false cur
) rest
)
258 rest
(case_line testfn
mcode tail last
)
260 and case_line testfn
mcode tail case
=
261 match Ast.unwrap case
with
262 Ast.CaseLine
(header
,code
) ->
263 conj_one testfn header
(statement_list testfn
mcode tail code
)
265 | Ast.OptCase
(case
) -> []
267 (* --------------------------------------------------------------------- *)
268 (* Function declaration *)
270 let top_level testfn
mcode t
: 'a list list
=
271 match Ast.unwrap t
with
272 Ast.FILEINFO
(old_file
,new_file
) -> failwith
"not supported fileinfo"
273 | Ast.DECL
(stmt
) -> statement testfn
mcode false stmt
274 | Ast.CODE
(stmt_dots
) -> statement_list testfn
mcode false stmt_dots
275 | Ast.ERRORWORDS
(exps
) -> failwith
"not supported errorwords"
277 (* --------------------------------------------------------------------- *)
282 (* if we end up with nothing, we assume that this rule is only here because
283 someone depends on it, and thus we try again with testfn as contains_modif.
284 Alternatively, we could check that this rule is mentioned in some
285 dependency, but that would be a little more work, and doesn't seem
288 (* lists are sorted such that smaller DisjRuleElem are first, because they
289 are cheaper to test *)
291 let asttomemberz (_
,_
,l
) used_after
=
292 let process_one (l
: (int * Ast_cocci.rule_elem) list list
) =
298 List.sort
(function (n1
,_
) -> function (n2
,_
) -> compare n1 n2
)
300 List.map
(function (_
,x
) -> (Lib_engine.Match
(x
),CTL.Control
)) info)
303 (function min
-> function (max
,big_max
) ->
307 [] -> process_one (big_max
())
308 | max
-> process_one max
)
309 | _
-> process_one min
)
310 (List.map
(top_level contains_constant no_mcode) l
)
313 (function x
-> function ua
-> function _
->
314 top_level (contains_modif ua
) mcode x
)
317 (function x
-> function _
->
318 top_level (function _
-> true) no_mcode x
)
321 let asttomember r used_after
=
323 Ast.ScriptRule _
| Ast.InitialScriptRule _
| Ast.FinalScriptRule _
-> []
324 | Ast.CocciRule
(a
,b
,c
,_
,_
) -> asttomemberz (a
,b
,c
) used_after