21d45da04685b44b0f7ed4c34bff421fa1d9ea3a
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 module Ast
= Ast_cocci
26 module V
= Visitor_ast
28 let disjmult2 e1 e2 k
=
30 (List.map
(function e1
-> List.map
(function e2
-> k e1 e2
) e2
) e1
)
32 let disjmult3 e1 e2 e3 k
=
38 (function e2
-> List.map
(function e3
-> k e1 e2 e3
) e3
)
42 let rec disjmult f
= function
46 let rest = disjmult f xs
in
47 disjmult2 cur rest (function cur -> function rest -> cur :: rest)
49 let disjoption f
= function
51 | Some x
-> List.map
(function x
-> Some x
) (f x
)
54 match Ast.unwrap d
with
56 List.map
(function l
-> Ast.rewrap d
(Ast.DOTS
(l
))) (disjmult f l
)
58 List.map
(function l
-> Ast.rewrap d
(Ast.CIRCLES
(l
))) (disjmult f l
)
60 List.map
(function l
-> Ast.rewrap d
(Ast.STARS
(l
))) (disjmult f l
)
63 match Ast.unwrap ft
with
65 let ty = disjtypeC
ty in
66 List.map
(function ty -> Ast.rewrap ft
(Ast.Type
(cv
,ty))) ty
67 | Ast.DisjType
(types
) -> List.concat
(List.map
disjty types
)
70 List.map
(function ty -> Ast.rewrap ft
(Ast.OptType
(ty))) ty
71 | Ast.UniqueType
(ty) ->
73 List.map
(function ty -> Ast.rewrap ft
(Ast.UniqueType
(ty))) ty
76 match Ast.unwrap bty
with
77 Ast.BaseType
(_
) | Ast.SignedT
(_
,_
) -> [bty
]
78 | Ast.Pointer
(ty,star
) ->
80 List.map
(function ty -> Ast.rewrap bty
(Ast.Pointer
(ty,star
))) ty
81 | Ast.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
85 Ast.rewrap bty
(Ast.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
)))
87 | Ast.FunctionType
(s
,ty,lp1
,params
,rp1
) ->
88 let ty = disjoption disjty ty in
91 Ast.rewrap bty
(Ast.FunctionType
(s
,ty,lp1
,params
,rp1
)))
93 | Ast.Array
(ty,lb
,size
,rb
) ->
94 disjmult2 (disjty ty) (disjoption disjexp size
)
95 (function ty -> function size
->
96 Ast.rewrap bty
(Ast.Array
(ty,lb
,size
,rb
)))
97 | Ast.EnumName
(_
,_
) | Ast.StructUnionName
(_
,_
) -> [bty
]
98 | Ast.EnumDef
(ty,lb
,ids
,rb
) ->
99 disjmult2 (disjty ty) (disjdots disjexp ids
)
100 (function ty -> function ids
->
101 Ast.rewrap bty
(Ast.EnumDef
(ty,lb
,ids
,rb
)))
102 | Ast.StructUnionDef
(ty,lb
,decls
,rb
) ->
103 disjmult2 (disjty ty) (disjdots disjdecl decls
)
104 (function ty -> function decls
->
105 Ast.rewrap bty
(Ast.StructUnionDef
(ty,lb
,decls
,rb
)))
106 | Ast.TypeName
(_
) | Ast.MetaType
(_
,_
,_
) -> [bty
]
109 match Ast.unwrap e
with
110 Ast.Ident
(_
) | Ast.Constant
(_
) -> [e
]
111 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
112 disjmult2 (disjexp fn
) (disjdots disjexp args
)
113 (function fn
-> function args
->
114 Ast.rewrap e
(Ast.FunCall
(fn
,lp
,args
,rp
)))
115 | Ast.Assignment
(left
,op
,right
,simple
) ->
116 disjmult2 (disjexp left
) (disjexp right
)
117 (function left
-> function right
->
118 Ast.rewrap e
(Ast.Assignment
(left
,op
,right
,simple
)))
119 | Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
) ->
120 let res = disjmult disjexp
[exp1
;exp2
;exp3
] in
124 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
))
125 | _
-> failwith
"not possible")
127 | Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
) ->
128 disjmult2 (disjexp exp1
) (disjexp exp3
)
129 (function exp1
-> function exp3
->
130 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
)))
131 | Ast.Postfix
(exp
,op
) ->
132 let exp = disjexp
exp in
133 List.map
(function exp -> Ast.rewrap e
(Ast.Postfix
(exp,op
))) exp
134 | Ast.Infix
(exp,op
) ->
135 let exp = disjexp
exp in
136 List.map
(function exp -> Ast.rewrap e
(Ast.Infix
(exp,op
))) exp
137 | Ast.Unary
(exp,op
) ->
138 let exp = disjexp
exp in
139 List.map
(function exp -> Ast.rewrap e
(Ast.Unary
(exp,op
))) exp
140 | Ast.Binary
(left
,op
,right
) ->
141 disjmult2 (disjexp left
) (disjexp right
)
142 (function left
-> function right
->
143 Ast.rewrap e
(Ast.Binary
(left
,op
,right
)))
144 | Ast.Nested
(exp,op
,right
) ->
145 (* disj not possible in right *)
146 let exp = disjexp
exp in
147 List.map
(function exp -> Ast.rewrap e
(Ast.Nested
(exp,op
,right
))) exp
148 | Ast.Paren
(lp
,exp,rp
) ->
149 let exp = disjexp
exp in
150 List.map
(function exp -> Ast.rewrap e
(Ast.Paren
(lp
,exp,rp
))) exp
151 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
152 disjmult2 (disjexp exp1
) (disjexp exp2
)
153 (function exp1
-> function exp2
->
154 Ast.rewrap e
(Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
)))
155 | Ast.RecordAccess
(exp,pt
,field
) ->
156 let exp = disjexp
exp in
158 (function exp -> Ast.rewrap e
(Ast.RecordAccess
(exp,pt
,field
))) exp
159 | Ast.RecordPtAccess
(exp,ar
,field
) ->
160 let exp = disjexp
exp in
162 (function exp -> Ast.rewrap e
(Ast.RecordPtAccess
(exp,ar
,field
))) exp
163 | Ast.Cast
(lp
,ty,rp
,exp) ->
164 disjmult2 (disjty ty) (disjexp
exp)
165 (function ty -> function exp -> Ast.rewrap e
(Ast.Cast
(lp
,ty,rp
,exp)))
166 | Ast.SizeOfExpr
(szf
,exp) ->
167 let exp = disjexp
exp in
168 List.map
(function exp -> Ast.rewrap e
(Ast.SizeOfExpr
(szf
,exp))) exp
169 | Ast.SizeOfType
(szf
,lp
,ty,rp
) ->
170 let ty = disjty ty in
172 (function ty -> Ast.rewrap e
(Ast.SizeOfType
(szf
,lp
,ty,rp
))) ty
174 let ty = disjty ty in
175 List.map
(function ty -> Ast.rewrap e
(Ast.TypeExp
(ty))) ty
176 | Ast.MetaErr
(_
,_
,_
,_
) | Ast.MetaExpr
(_
,_
,_
,_
,_
,_
)
177 | Ast.MetaExprList
(_
,_
,_
,_
) | Ast.EComma
(_
) -> [e
]
178 | Ast.DisjExpr
(exp_list
) ->
179 List.concat
(List.map disjexp exp_list
)
180 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
) ->
181 (* not sure what to do here, so ambiguities still possible *)
183 | Ast.Edots
(dots
,_
) | Ast.Ecircles
(dots
,_
) | Ast.Estars
(dots
,_
) -> [e
]
185 let exp = disjexp
exp in
186 List.map
(function exp -> Ast.rewrap e
(Ast.OptExp
(exp))) exp
187 | Ast.UniqueExp
(exp) ->
188 let exp = disjexp
exp in
189 List.map
(function exp -> Ast.rewrap e
(Ast.UniqueExp
(exp))) exp
192 match Ast.unwrap p
with
193 Ast.VoidParam
(ty) -> [p
] (* void is the only possible value *)
194 | Ast.Param
(ty,id
) ->
195 let ty = disjty ty in
196 List.map
(function ty -> Ast.rewrap p
(Ast.Param
(ty,id
))) ty
197 | Ast.MetaParam
(_
,_
,_
) | Ast.MetaParamList
(_
,_
,_
,_
) | Ast.PComma
(_
) -> [p
]
198 | Ast.Pdots
(dots
) | Ast.Pcircles
(dots
) -> [p
]
199 | Ast.OptParam
(param
) ->
200 let param = disjparam
param in
201 List.map
(function param -> Ast.rewrap p
(Ast.OptParam
(param))) param
202 | Ast.UniqueParam
(param) ->
203 let param = disjparam
param in
204 List.map
(function param -> Ast.rewrap p
(Ast.UniqueParam
(param))) param
207 match Ast.unwrap i
with
208 Ast.MetaInit
(_
,_
,_
) -> [i
]
209 | Ast.InitExpr
(exp) ->
210 let exp = disjexp
exp in
211 List.map
(function exp -> Ast.rewrap i
(Ast.InitExpr
(exp))) exp
212 | Ast.ArInitList
(lb
,initlist
,rb
) ->
214 (function initlist
->
215 Ast.rewrap i
(Ast.ArInitList
(lb
,initlist
,rb
)))
216 (disjdots disjini initlist
)
217 | Ast.StrInitList
(allminus
,lb
,initlist
,rb
,whencode
) ->
219 (function initlist
->
220 Ast.rewrap i
(Ast.StrInitList
(allminus
,lb
,initlist
,rb
,whencode
)))
221 (disjmult disjini initlist
)
222 | Ast.InitGccExt
(designators
,eq
,ini
) ->
223 let designators = disjmult designator
designators in
224 let ini = disjini
ini in
225 disjmult2 designators ini
226 (function designators -> function ini ->
227 Ast.rewrap i
(Ast.InitGccExt
(designators,eq
,ini)))
228 | Ast.InitGccName
(name
,eq
,ini) ->
229 let ini = disjini
ini in
231 (function ini -> Ast.rewrap i
(Ast.InitGccName
(name
,eq
,ini)))
233 | Ast.IComma
(comma
) -> [i
]
234 | Ast.Idots
(dots
,_
) -> [i
]
236 let ini = disjini
ini in
237 List.map
(function ini -> Ast.rewrap i
(Ast.OptIni
(ini))) ini
238 | Ast.UniqueIni
(ini) ->
239 let ini = disjini
ini in
240 List.map
(function ini -> Ast.rewrap i
(Ast.UniqueIni
(ini))) ini
242 and designator
= function
243 Ast.DesignatorField
(dot
,id
) -> [Ast.DesignatorField
(dot
,id
)]
244 | Ast.DesignatorIndex
(lb
,exp,rb
) ->
245 let exp = disjexp
exp in
246 List.map
(function exp -> Ast.DesignatorIndex
(lb
,exp,rb
)) exp
247 | Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
248 disjmult2 (disjexp min
) (disjexp max
)
249 (function min
-> function max
->
250 Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
))
253 match Ast.unwrap d
with
254 Ast.MetaDecl
(_
,_
,_
) | Ast.MetaField
(_
,_
,_
) -> [d
]
255 | Ast.Init
(stg
,ty,id
,eq
,ini,sem
) ->
256 disjmult2 (disjty ty) (disjini
ini)
257 (function ty -> function ini ->
258 Ast.rewrap d
(Ast.Init
(stg
,ty,id
,eq
,ini,sem
)))
259 | Ast.UnInit
(stg
,ty,id
,sem
) ->
260 let ty = disjty ty in
261 List.map
(function ty -> Ast.rewrap d
(Ast.UnInit
(stg
,ty,id
,sem
))) ty
262 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
264 (function args
-> Ast.rewrap d
(Ast.MacroDecl
(name
,lp
,args
,rp
,sem
)))
265 (disjdots disjexp args
)
266 | Ast.TyDecl
(ty,sem
) ->
267 let ty = disjty ty in
268 List.map
(function ty -> Ast.rewrap d
(Ast.TyDecl
(ty,sem
))) ty
269 | Ast.Typedef
(stg
,ty,id
,sem
) ->
270 let ty = disjty ty in (* disj not allowed in id *)
271 List.map
(function ty -> Ast.rewrap d
(Ast.Typedef
(stg
,ty,id
,sem
))) ty
272 | Ast.DisjDecl
(decls
) -> List.concat
(List.map disjdecl decls
)
273 | Ast.Ddots
(_
,_
) -> [d
]
274 | Ast.OptDecl
(decl
) ->
275 let decl = disjdecl
decl in
276 List.map
(function decl -> Ast.rewrap d
(Ast.OptDecl
(decl))) decl
277 | Ast.UniqueDecl
(decl) ->
278 let decl = disjdecl
decl in
279 List.map
(function decl -> Ast.rewrap d
(Ast.UniqueDecl
(decl))) decl
281 let generic_orify_rule_elem f re
exp rebuild
=
284 | orexps
-> Ast.rewrap re
(Ast.DisjRuleElem
(List.map rebuild orexps
))
286 let orify_rule_elem re
exp rebuild
=
287 generic_orify_rule_elem disjexp re
exp rebuild
289 let orify_rule_elem_ty = generic_orify_rule_elem disjty
290 let orify_rule_elem_param = generic_orify_rule_elem disjparam
291 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
292 let orify_rule_elem_ini = generic_orify_rule_elem disjini
294 let rec disj_rule_elem r k re
=
295 match Ast.unwrap re
with
296 Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
) ->
297 generic_orify_rule_elem (disjdots disjparam
) re params
300 (Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
)))
301 | Ast.Decl
(bef
,allminus
,decl) ->
302 orify_rule_elem_decl re
decl
303 (function decl -> Ast.rewrap re
(Ast.Decl
(bef
,allminus
,decl)))
304 | Ast.SeqStart
(brace
) -> re
305 | Ast.SeqEnd
(brace
) -> re
306 | Ast.ExprStatement
(exp,sem
) ->
307 orify_rule_elem re
exp
308 (function exp -> Ast.rewrap re
(Ast.ExprStatement
(exp,sem
)))
309 | Ast.IfHeader
(iff
,lp
,exp,rp
) ->
310 orify_rule_elem re
exp
311 (function exp -> Ast.rewrap re
(Ast.IfHeader
(iff
,lp
,exp,rp
)))
312 | Ast.Else
(els
) -> re
313 | Ast.WhileHeader
(whl
,lp
,exp,rp
) ->
314 orify_rule_elem re
exp
315 (function exp -> Ast.rewrap re
(Ast.WhileHeader
(whl
,lp
,exp,rp
)))
316 | Ast.DoHeader
(d
) -> re
317 | Ast.WhileTail
(whl
,lp
,exp,rp
,sem
) ->
318 orify_rule_elem re
exp
319 (function exp -> Ast.rewrap re
(Ast.WhileTail
(whl
,lp
,exp,rp
,sem
)))
320 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
321 generic_orify_rule_elem (disjmult (disjoption disjexp
)) re
[e1
;e2
;e3
]
324 Ast.rewrap re
(Ast.ForHeader
(fr
,lp
,exp1
,sem1
,exp2
,sem2
,exp3
,rp
))
325 | _
-> failwith
"not possible")
326 | Ast.IteratorHeader
(whl
,lp
,args
,rp
) ->
327 generic_orify_rule_elem (disjdots disjexp
) re args
328 (function args
-> Ast.rewrap re
(Ast.IteratorHeader
(whl
,lp
,args
,rp
)))
329 | Ast.SwitchHeader
(switch
,lp
,exp,rp
) ->
330 orify_rule_elem re
exp
331 (function exp -> Ast.rewrap re
(Ast.SwitchHeader
(switch
,lp
,exp,rp
)))
332 | Ast.Break
(_
,_
) | Ast.Continue
(_
,_
) | Ast.Label
(_
,_
) | Ast.Goto
(_
,_
,_
)
333 | Ast.Return
(_
,_
) -> re
334 | Ast.ReturnExpr
(ret
,exp,sem
) ->
335 orify_rule_elem re
exp
336 (function exp -> Ast.rewrap re
(Ast.ReturnExpr
(ret
,exp,sem
)))
337 | Ast.MetaRuleElem
(_
,_
,_
) | Ast.MetaStmt
(_
,_
,_
,_
)
338 | Ast.MetaStmtList
(_
,_
,_
) -> re
340 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.Exp
(exp)))
342 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.TopExp
(exp)))
344 orify_rule_elem_ty re
ty (function ty -> Ast.rewrap
ty (Ast.Ty
(ty)))
345 | Ast.TopInit
(init
) ->
346 orify_rule_elem_ini re init
347 (function init
-> Ast.rewrap init
(Ast.TopInit
(init
)))
348 | Ast.Include
(inc
,s
) -> re
349 | Ast.DefineHeader
(def
,id
,params
) -> re
350 | Ast.Default
(def
,colon
) -> re
351 | Ast.Case
(case
,exp,colon
) ->
352 orify_rule_elem re
exp
353 (function exp -> Ast.rewrap re
(Ast.Case
(case
,exp,colon
)))
354 | Ast.DisjRuleElem
(l
) ->
355 (* only case lines *)
356 Ast.rewrap re
(Ast.DisjRuleElem
(List.map
(disj_rule_elem r k
) l
))
360 let donothing r k e
= k e
in
362 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
363 donothing donothing donothing donothing donothing
364 donothing donothing donothing donothing donothing donothing donothing
365 disj_rule_elem donothing donothing donothing donothing
367 (* ----------------------------------------------------------------------- *)
368 (* collect iso information at the rule_elem level *)
370 let collect_all_isos =
372 let option_default = [] in
373 let mcode r x
= [] in
374 let donothing r k e
= Common.union_set
(Ast.get_isos e
) (k e
) in
375 let doanything r k e
= k e
in
376 V.combiner
bind option_default
377 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
378 donothing donothing donothing donothing donothing donothing donothing
379 donothing donothing donothing donothing donothing donothing donothing
380 donothing donothing doanything
382 let collect_iso_info =
384 let donothing r k e
= k e
in
385 let rule_elem r k e
=
386 match Ast.unwrap e
with
387 Ast.DisjRuleElem
(l
) -> k e
389 let isos = collect_all_isos.V.combiner_rule_elem e
in
390 Ast.set_isos e
isos in
392 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
393 donothing donothing donothing donothing donothing donothing donothing
395 donothing donothing donothing donothing rule_elem donothing donothing
398 (* ----------------------------------------------------------------------- *)
405 | Ast.InitialScriptRule _
| Ast.FinalScriptRule _
-> (mv
, r
)
406 | Ast.CocciRule
(nm
, rule_info
, r
, isexp
, ruletype
) ->
410 let res = disj_all.V.rebuilder_top_level x
in
411 if !Flag.track_iso_usage
412 then collect_iso_info.V.rebuilder_top_level
res
415 (mv
, Ast.CocciRule
(nm
,rule_info
,res,isexp
,ruletype
)))