5c91ce486db3a80e113f3d676ff12b845747201d
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
23 module Ast
= Ast_cocci
24 module V
= Visitor_ast
26 let disjmult2 e1 e2 k
=
28 (List.map
(function e1
-> List.map
(function e2
-> k e1 e2
) e2
) e1
)
30 let disjmult3 e1 e2 e3 k
=
36 (function e2
-> List.map
(function e3
-> k e1 e2 e3
) e3
)
40 let rec disjmult f
= function
44 let rest = disjmult f xs
in
45 disjmult2 cur rest (function cur -> function rest -> cur :: rest)
47 let disjoption f
= function
49 | Some x
-> List.map
(function x
-> Some x
) (f x
)
52 match Ast.unwrap d
with
54 List.map
(function l
-> Ast.rewrap d
(Ast.DOTS
(l
))) (disjmult f l
)
56 List.map
(function l
-> Ast.rewrap d
(Ast.CIRCLES
(l
))) (disjmult f l
)
58 List.map
(function l
-> Ast.rewrap d
(Ast.STARS
(l
))) (disjmult f l
)
61 match Ast.unwrap ft
with
63 let ty = disjtypeC
ty in
64 List.map
(function ty -> Ast.rewrap ft
(Ast.Type
(cv
,ty))) ty
65 | Ast.DisjType
(types
) -> List.concat
(List.map
disjty types
)
68 List.map
(function ty -> Ast.rewrap ft
(Ast.OptType
(ty))) ty
69 | Ast.UniqueType
(ty) ->
71 List.map
(function ty -> Ast.rewrap ft
(Ast.UniqueType
(ty))) ty
74 match Ast.unwrap bty
with
75 Ast.BaseType
(_
) | Ast.SignedT
(_
,_
) -> [bty
]
76 | Ast.Pointer
(ty,star
) ->
78 List.map
(function ty -> Ast.rewrap bty
(Ast.Pointer
(ty,star
))) ty
79 | Ast.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
83 Ast.rewrap bty
(Ast.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
)))
85 | Ast.FunctionType
(s
,ty,lp1
,params
,rp1
) ->
86 let ty = disjoption disjty ty in
89 Ast.rewrap bty
(Ast.FunctionType
(s
,ty,lp1
,params
,rp1
)))
91 | Ast.Array
(ty,lb
,size
,rb
) ->
92 disjmult2 (disjty ty) (disjoption disjexp size
)
93 (function ty -> function size
->
94 Ast.rewrap bty
(Ast.Array
(ty,lb
,size
,rb
)))
95 | Ast.EnumName
(_
,_
) | Ast.StructUnionName
(_
,_
) -> [bty
]
96 | Ast.StructUnionDef
(ty,lb
,decls
,rb
) ->
97 disjmult2 (disjty ty) (disjdots disjdecl decls
)
98 (function ty -> function decls
->
99 Ast.rewrap bty
(Ast.StructUnionDef
(ty,lb
,decls
,rb
)))
100 | Ast.TypeName
(_
) | Ast.MetaType
(_
,_
,_
) -> [bty
]
103 match Ast.unwrap e
with
104 Ast.Ident
(_
) | Ast.Constant
(_
) -> [e
]
105 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
106 disjmult2 (disjexp fn
) (disjdots disjexp args
)
107 (function fn
-> function args
->
108 Ast.rewrap e
(Ast.FunCall
(fn
,lp
,args
,rp
)))
109 | Ast.Assignment
(left
,op
,right
,simple
) ->
110 disjmult2 (disjexp left
) (disjexp right
)
111 (function left
-> function right
->
112 Ast.rewrap e
(Ast.Assignment
(left
,op
,right
,simple
)))
113 | Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
) ->
114 let res = disjmult disjexp
[exp1
;exp2
;exp3
] in
118 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
))
119 | _
-> failwith
"not possible")
121 | Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
) ->
122 disjmult2 (disjexp exp1
) (disjexp exp3
)
123 (function exp1
-> function exp3
->
124 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
)))
125 | Ast.Postfix
(exp
,op
) ->
126 let exp = disjexp
exp in
127 List.map
(function exp -> Ast.rewrap e
(Ast.Postfix
(exp,op
))) exp
128 | Ast.Infix
(exp,op
) ->
129 let exp = disjexp
exp in
130 List.map
(function exp -> Ast.rewrap e
(Ast.Infix
(exp,op
))) exp
131 | Ast.Unary
(exp,op
) ->
132 let exp = disjexp
exp in
133 List.map
(function exp -> Ast.rewrap e
(Ast.Unary
(exp,op
))) exp
134 | Ast.Binary
(left
,op
,right
) ->
135 disjmult2 (disjexp left
) (disjexp right
)
136 (function left
-> function right
->
137 Ast.rewrap e
(Ast.Binary
(left
,op
,right
)))
138 | Ast.Nested
(exp,op
,right
) ->
139 (* disj not possible in right *)
140 let exp = disjexp
exp in
141 List.map
(function exp -> Ast.rewrap e
(Ast.Nested
(exp,op
,right
))) exp
142 | Ast.Paren
(lp
,exp,rp
) ->
143 let exp = disjexp
exp in
144 List.map
(function exp -> Ast.rewrap e
(Ast.Paren
(lp
,exp,rp
))) exp
145 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
146 disjmult2 (disjexp exp1
) (disjexp exp2
)
147 (function exp1
-> function exp2
->
148 Ast.rewrap e
(Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
)))
149 | Ast.RecordAccess
(exp,pt
,field
) ->
150 let exp = disjexp
exp in
152 (function exp -> Ast.rewrap e
(Ast.RecordAccess
(exp,pt
,field
))) exp
153 | Ast.RecordPtAccess
(exp,ar
,field
) ->
154 let exp = disjexp
exp in
156 (function exp -> Ast.rewrap e
(Ast.RecordPtAccess
(exp,ar
,field
))) exp
157 | Ast.Cast
(lp
,ty,rp
,exp) ->
158 disjmult2 (disjty ty) (disjexp
exp)
159 (function ty -> function exp -> Ast.rewrap e
(Ast.Cast
(lp
,ty,rp
,exp)))
160 | Ast.SizeOfExpr
(szf
,exp) ->
161 let exp = disjexp
exp in
162 List.map
(function exp -> Ast.rewrap e
(Ast.SizeOfExpr
(szf
,exp))) exp
163 | Ast.SizeOfType
(szf
,lp
,ty,rp
) ->
164 let ty = disjty ty in
166 (function ty -> Ast.rewrap e
(Ast.SizeOfType
(szf
,lp
,ty,rp
))) ty
168 let ty = disjty ty in
169 List.map
(function ty -> Ast.rewrap e
(Ast.TypeExp
(ty))) ty
170 | Ast.MetaErr
(_
,_
,_
,_
) | Ast.MetaExpr
(_
,_
,_
,_
,_
,_
)
171 | Ast.MetaExprList
(_
,_
,_
,_
) | Ast.EComma
(_
) -> [e
]
172 | Ast.DisjExpr
(exp_list
) ->
173 List.concat
(List.map disjexp exp_list
)
174 | Ast.NestExpr
(expr_dots
,whencode
,multi
) ->
175 (* not sure what to do here, so ambiguities still possible *)
177 | Ast.Edots
(dots
,_
) | Ast.Ecircles
(dots
,_
) | Ast.Estars
(dots
,_
) -> [e
]
179 let exp = disjexp
exp in
180 List.map
(function exp -> Ast.rewrap e
(Ast.OptExp
(exp))) exp
181 | Ast.UniqueExp
(exp) ->
182 let exp = disjexp
exp in
183 List.map
(function exp -> Ast.rewrap e
(Ast.UniqueExp
(exp))) exp
186 match Ast.unwrap p
with
187 Ast.VoidParam
(ty) -> [p
] (* void is the only possible value *)
188 | Ast.Param
(ty,id
) ->
189 let ty = disjty ty in
190 List.map
(function ty -> Ast.rewrap p
(Ast.Param
(ty,id
))) ty
191 | Ast.MetaParam
(_
,_
,_
) | Ast.MetaParamList
(_
,_
,_
,_
) | Ast.PComma
(_
) -> [p
]
192 | Ast.Pdots
(dots
) | Ast.Pcircles
(dots
) -> [p
]
193 | Ast.OptParam
(param
) ->
194 let param = disjparam
param in
195 List.map
(function param -> Ast.rewrap p
(Ast.OptParam
(param))) param
196 | Ast.UniqueParam
(param) ->
197 let param = disjparam
param in
198 List.map
(function param -> Ast.rewrap p
(Ast.UniqueParam
(param))) param
201 match Ast.unwrap i
with
202 Ast.MetaInit
(_
,_
,_
) -> [i
]
203 | Ast.InitExpr
(exp) ->
204 let exp = disjexp
exp in
205 List.map
(function exp -> Ast.rewrap i
(Ast.InitExpr
(exp))) exp
206 | Ast.InitList
(lb
,initlist
,rb
,whencode
) ->
208 (function initlist
->
209 Ast.rewrap i
(Ast.InitList
(lb
,initlist
,rb
,whencode
)))
210 (disjmult disjini initlist
)
211 | Ast.InitGccExt
(designators
,eq
,ini
) ->
212 let designators = disjmult designator
designators in
213 let ini = disjini
ini in
214 disjmult2 designators ini
215 (function designators -> function ini ->
216 Ast.rewrap i
(Ast.InitGccExt
(designators,eq
,ini)))
217 | Ast.InitGccName
(name
,eq
,ini) ->
218 let ini = disjini
ini in
220 (function ini -> Ast.rewrap i
(Ast.InitGccName
(name
,eq
,ini)))
222 | Ast.IComma
(comma
) -> [i
]
224 let ini = disjini
ini in
225 List.map
(function ini -> Ast.rewrap i
(Ast.OptIni
(ini))) ini
226 | Ast.UniqueIni
(ini) ->
227 let ini = disjini
ini in
228 List.map
(function ini -> Ast.rewrap i
(Ast.UniqueIni
(ini))) ini
230 and designator
= function
231 Ast.DesignatorField
(dot
,id
) -> [Ast.DesignatorField
(dot
,id
)]
232 | Ast.DesignatorIndex
(lb
,exp,rb
) ->
233 let exp = disjexp
exp in
234 List.map
(function exp -> Ast.DesignatorIndex
(lb
,exp,rb
)) exp
235 | Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
236 disjmult2 (disjexp min
) (disjexp max
)
237 (function min
-> function max
->
238 Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
))
241 match Ast.unwrap d
with
242 Ast.Init
(stg
,ty,id
,eq
,ini,sem
) ->
243 disjmult2 (disjty ty) (disjini
ini)
244 (function ty -> function ini ->
245 Ast.rewrap d
(Ast.Init
(stg
,ty,id
,eq
,ini,sem
)))
246 | Ast.UnInit
(stg
,ty,id
,sem
) ->
247 let ty = disjty ty in
248 List.map
(function ty -> Ast.rewrap d
(Ast.UnInit
(stg
,ty,id
,sem
))) ty
249 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
251 (function args
-> Ast.rewrap d
(Ast.MacroDecl
(name
,lp
,args
,rp
,sem
)))
252 (disjdots disjexp args
)
253 | Ast.TyDecl
(ty,sem
) ->
254 let ty = disjty ty in
255 List.map
(function ty -> Ast.rewrap d
(Ast.TyDecl
(ty,sem
))) ty
256 | Ast.Typedef
(stg
,ty,id
,sem
) ->
257 let ty = disjty ty in (* disj not allowed in id *)
258 List.map
(function ty -> Ast.rewrap d
(Ast.Typedef
(stg
,ty,id
,sem
))) ty
259 | Ast.DisjDecl
(decls
) -> List.concat
(List.map disjdecl decls
)
260 | Ast.Ddots
(_
,_
) | Ast.MetaDecl
(_
,_
,_
) -> [d
]
261 | Ast.OptDecl
(decl
) ->
262 let decl = disjdecl
decl in
263 List.map
(function decl -> Ast.rewrap d
(Ast.OptDecl
(decl))) decl
264 | Ast.UniqueDecl
(decl) ->
265 let decl = disjdecl
decl in
266 List.map
(function decl -> Ast.rewrap d
(Ast.UniqueDecl
(decl))) decl
268 let generic_orify_rule_elem f re
exp rebuild
=
271 | orexps
-> Ast.rewrap re
(Ast.DisjRuleElem
(List.map rebuild orexps
))
273 let orify_rule_elem re
exp rebuild
=
274 generic_orify_rule_elem disjexp re
exp rebuild
276 let orify_rule_elem_ty = generic_orify_rule_elem disjty
277 let orify_rule_elem_param = generic_orify_rule_elem disjparam
278 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
279 let orify_rule_elem_ini = generic_orify_rule_elem disjini
281 let rec disj_rule_elem r k re
=
282 match Ast.unwrap re
with
283 Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
) ->
284 generic_orify_rule_elem (disjdots disjparam
) re params
287 (Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
)))
288 | Ast.Decl
(bef
,allminus
,decl) ->
289 orify_rule_elem_decl re
decl
290 (function decl -> Ast.rewrap re
(Ast.Decl
(bef
,allminus
,decl)))
291 | Ast.SeqStart
(brace
) -> re
292 | Ast.SeqEnd
(brace
) -> re
293 | Ast.ExprStatement
(exp,sem
) ->
294 orify_rule_elem re
exp
295 (function exp -> Ast.rewrap re
(Ast.ExprStatement
(exp,sem
)))
296 | Ast.IfHeader
(iff
,lp
,exp,rp
) ->
297 orify_rule_elem re
exp
298 (function exp -> Ast.rewrap re
(Ast.IfHeader
(iff
,lp
,exp,rp
)))
299 | Ast.Else
(els
) -> re
300 | Ast.WhileHeader
(whl
,lp
,exp,rp
) ->
301 orify_rule_elem re
exp
302 (function exp -> Ast.rewrap re
(Ast.WhileHeader
(whl
,lp
,exp,rp
)))
303 | Ast.DoHeader
(d
) -> re
304 | Ast.WhileTail
(whl
,lp
,exp,rp
,sem
) ->
305 orify_rule_elem re
exp
306 (function exp -> Ast.rewrap re
(Ast.WhileTail
(whl
,lp
,exp,rp
,sem
)))
307 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
308 generic_orify_rule_elem (disjmult (disjoption disjexp
)) re
[e1
;e2
;e3
]
311 Ast.rewrap re
(Ast.ForHeader
(fr
,lp
,exp1
,sem1
,exp2
,sem2
,exp3
,rp
))
312 | _
-> failwith
"not possible")
313 | Ast.IteratorHeader
(whl
,lp
,args
,rp
) ->
314 generic_orify_rule_elem (disjdots disjexp
) re args
315 (function args
-> Ast.rewrap re
(Ast.IteratorHeader
(whl
,lp
,args
,rp
)))
316 | Ast.SwitchHeader
(switch
,lp
,exp,rp
) ->
317 orify_rule_elem re
exp
318 (function exp -> Ast.rewrap re
(Ast.SwitchHeader
(switch
,lp
,exp,rp
)))
319 | Ast.Break
(_
,_
) | Ast.Continue
(_
,_
) | Ast.Label
(_
,_
) | Ast.Goto
(_
,_
,_
)
320 | Ast.Return
(_
,_
) -> re
321 | Ast.ReturnExpr
(ret
,exp,sem
) ->
322 orify_rule_elem re
exp
323 (function exp -> Ast.rewrap re
(Ast.ReturnExpr
(ret
,exp,sem
)))
324 | Ast.MetaRuleElem
(_
,_
,_
) | Ast.MetaStmt
(_
,_
,_
,_
)
325 | Ast.MetaStmtList
(_
,_
,_
) -> re
327 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.Exp
(exp)))
329 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.TopExp
(exp)))
331 orify_rule_elem_ty re
ty (function ty -> Ast.rewrap
ty (Ast.Ty
(ty)))
332 | Ast.TopInit
(init
) ->
333 orify_rule_elem_ini re init
334 (function init
-> Ast.rewrap init
(Ast.TopInit
(init
)))
335 | Ast.Include
(inc
,s
) -> re
336 | Ast.DefineHeader
(def
,id
,params
) -> re
337 | Ast.Default
(def
,colon
) -> re
338 | Ast.Case
(case
,exp,colon
) ->
339 orify_rule_elem re
exp
340 (function exp -> Ast.rewrap re
(Ast.Case
(case
,exp,colon
)))
341 | Ast.DisjRuleElem
(l
) ->
342 (* only case lines *)
343 Ast.rewrap re
(Ast.DisjRuleElem
(List.map
(disj_rule_elem r k
) l
))
347 let donothing r k e
= k e
in
349 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
350 donothing donothing donothing donothing
351 donothing donothing donothing donothing donothing donothing donothing
352 disj_rule_elem donothing donothing donothing donothing
354 (* ----------------------------------------------------------------------- *)
355 (* collect iso information at the rule_elem level *)
357 let collect_all_isos =
359 let option_default = [] in
360 let mcode r x
= [] in
361 let donothing r k e
= Common.union_set
(Ast.get_isos e
) (k e
) in
362 let doanything r k e
= k e
in
363 V.combiner
bind option_default
364 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
365 donothing donothing donothing donothing donothing donothing donothing
366 donothing donothing donothing donothing donothing donothing donothing
369 let collect_iso_info =
371 let donothing r k e
= k e
in
372 let rule_elem r k e
=
373 match Ast.unwrap e
with
374 Ast.DisjRuleElem
(l
) -> k e
376 let isos = collect_all_isos.V.combiner_rule_elem e
in
377 Ast.set_isos e
isos in
379 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
380 donothing donothing donothing donothing donothing donothing donothing
381 donothing donothing donothing donothing rule_elem donothing donothing
384 (* ----------------------------------------------------------------------- *)
391 | Ast.InitialScriptRule _
| Ast.FinalScriptRule _
-> (mv
, r
)
392 | Ast.CocciRule
(nm
, rule_info
, r
, isexp
, ruletype
) ->
396 let res = disj_all.V.rebuilder_top_level x
in
397 if !Flag.track_iso_usage
398 then collect_iso_info.V.rebuilder_top_level
res
401 (mv
, Ast.CocciRule
(nm
,rule_info
,res,isexp
,ruletype
)))