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.DisjId
(id_list
) -> List.concat
(List.map disjident id_list
)
111 | Ast.OptIdent
(id
) ->
112 let id = disjident
id in
113 List.map
(function id -> Ast.rewrap e
(Ast.OptIdent
(id))) id
114 | Ast.UniqueIdent
(id) ->
115 let id = disjident
id in
116 List.map
(function id -> Ast.rewrap e
(Ast.UniqueIdent
(id))) id
120 match Ast.unwrap e
with
121 Ast.Ident
(_
) | Ast.Constant
(_
) -> [e
] (* even Ident can't contain disj *)
122 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
123 disjmult2 (disjexp fn
) (disjdots disjexp args
)
124 (function fn
-> function args
->
125 Ast.rewrap e
(Ast.FunCall
(fn
,lp
,args
,rp
)))
126 | Ast.Assignment
(left
,op
,right
,simple
) ->
127 disjmult2 (disjexp left
) (disjexp right
)
128 (function left
-> function right
->
129 Ast.rewrap e
(Ast.Assignment
(left
,op
,right
,simple
)))
130 | Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
) ->
131 let res = disjmult disjexp
[exp1
;exp2
;exp3
] in
135 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,Some exp2
,colon
,exp3
))
136 | _
-> failwith
"not possible")
138 | Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
) ->
139 disjmult2 (disjexp exp1
) (disjexp exp3
)
140 (function exp1
-> function exp3
->
141 Ast.rewrap e
(Ast.CondExpr
(exp1
,why
,None
,colon
,exp3
)))
142 | Ast.Postfix
(exp
,op
) ->
143 let exp = disjexp
exp in
144 List.map
(function exp -> Ast.rewrap e
(Ast.Postfix
(exp,op
))) exp
145 | Ast.Infix
(exp,op
) ->
146 let exp = disjexp
exp in
147 List.map
(function exp -> Ast.rewrap e
(Ast.Infix
(exp,op
))) exp
148 | Ast.Unary
(exp,op
) ->
149 let exp = disjexp
exp in
150 List.map
(function exp -> Ast.rewrap e
(Ast.Unary
(exp,op
))) exp
151 | Ast.Binary
(left
,op
,right
) ->
152 disjmult2 (disjexp left
) (disjexp right
)
153 (function left
-> function right
->
154 Ast.rewrap e
(Ast.Binary
(left
,op
,right
)))
155 | Ast.Nested
(exp,op
,right
) ->
156 (* disj not possible in right *)
157 let exp = disjexp
exp in
158 List.map
(function exp -> Ast.rewrap e
(Ast.Nested
(exp,op
,right
))) exp
159 | Ast.Paren
(lp
,exp,rp
) ->
160 let exp = disjexp
exp in
161 List.map
(function exp -> Ast.rewrap e
(Ast.Paren
(lp
,exp,rp
))) exp
162 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
163 disjmult2 (disjexp exp1
) (disjexp exp2
)
164 (function exp1
-> function exp2
->
165 Ast.rewrap e
(Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
)))
166 | Ast.RecordAccess
(exp,pt
,field
) ->
167 let exp = disjexp
exp in
169 (function exp -> Ast.rewrap e
(Ast.RecordAccess
(exp,pt
,field
))) exp
170 | Ast.RecordPtAccess
(exp,ar
,field
) ->
171 let exp = disjexp
exp in
173 (function exp -> Ast.rewrap e
(Ast.RecordPtAccess
(exp,ar
,field
))) exp
174 | Ast.Cast
(lp
,ty,rp
,exp) ->
175 disjmult2 (disjty ty) (disjexp
exp)
176 (function ty -> function exp -> Ast.rewrap e
(Ast.Cast
(lp
,ty,rp
,exp)))
177 | Ast.SizeOfExpr
(szf
,exp) ->
178 let exp = disjexp
exp in
179 List.map
(function exp -> Ast.rewrap e
(Ast.SizeOfExpr
(szf
,exp))) exp
180 | Ast.SizeOfType
(szf
,lp
,ty,rp
) ->
181 let ty = disjty ty in
183 (function ty -> Ast.rewrap e
(Ast.SizeOfType
(szf
,lp
,ty,rp
))) ty
185 let ty = disjty ty in
186 List.map
(function ty -> Ast.rewrap e
(Ast.TypeExp
(ty))) ty
187 | Ast.MetaErr
(_
,_
,_
,_
) | Ast.MetaExpr
(_
,_
,_
,_
,_
,_
)
188 | Ast.MetaExprList
(_
,_
,_
,_
) | Ast.EComma
(_
) -> [e
]
189 | Ast.DisjExpr
(exp_list
) -> List.concat
(List.map disjexp exp_list
)
190 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
) ->
191 (* not sure what to do here, so ambiguities still possible *)
193 | Ast.Edots
(dots
,_
) | Ast.Ecircles
(dots
,_
) | Ast.Estars
(dots
,_
) -> [e
]
195 let exp = disjexp
exp in
196 List.map
(function exp -> Ast.rewrap e
(Ast.OptExp
(exp))) exp
197 | Ast.UniqueExp
(exp) ->
198 let exp = disjexp
exp in
199 List.map
(function exp -> Ast.rewrap e
(Ast.UniqueExp
(exp))) exp
202 match Ast.unwrap p
with
203 Ast.VoidParam
(ty) -> [p
] (* void is the only possible value *)
204 | Ast.Param
(ty,id) ->
205 let ty = disjty ty in
206 List.map
(function ty -> Ast.rewrap p
(Ast.Param
(ty,id))) ty
207 | Ast.MetaParam
(_
,_
,_
) | Ast.MetaParamList
(_
,_
,_
,_
) | Ast.PComma
(_
) -> [p
]
208 | Ast.Pdots
(dots
) | Ast.Pcircles
(dots
) -> [p
]
209 | Ast.OptParam
(param
) ->
210 let param = disjparam
param in
211 List.map
(function param -> Ast.rewrap p
(Ast.OptParam
(param))) param
212 | Ast.UniqueParam
(param) ->
213 let param = disjparam
param in
214 List.map
(function param -> Ast.rewrap p
(Ast.UniqueParam
(param))) param
217 match Ast.unwrap i
with
218 Ast.MetaInit
(_
,_
,_
) -> [i
]
219 | Ast.InitExpr
(exp) ->
220 let exp = disjexp
exp in
221 List.map
(function exp -> Ast.rewrap i
(Ast.InitExpr
(exp))) exp
222 | Ast.ArInitList
(lb
,initlist
,rb
) ->
224 (function initlist
->
225 Ast.rewrap i
(Ast.ArInitList
(lb
,initlist
,rb
)))
226 (disjdots disjini initlist
)
227 | Ast.StrInitList
(allminus
,lb
,initlist
,rb
,whencode
) ->
229 (function initlist
->
230 Ast.rewrap i
(Ast.StrInitList
(allminus
,lb
,initlist
,rb
,whencode
)))
231 (disjmult disjini initlist
)
232 | Ast.InitGccExt
(designators
,eq
,ini
) ->
233 let designators = disjmult designator
designators in
234 let ini = disjini
ini in
235 disjmult2 designators ini
236 (function designators -> function ini ->
237 Ast.rewrap i
(Ast.InitGccExt
(designators,eq
,ini)))
238 | Ast.InitGccName
(name
,eq
,ini) ->
239 let ini = disjini
ini in
241 (function ini -> Ast.rewrap i
(Ast.InitGccName
(name
,eq
,ini)))
243 | Ast.IComma
(comma
) -> [i
]
244 | Ast.Idots
(dots
,_
) -> [i
]
246 let ini = disjini
ini in
247 List.map
(function ini -> Ast.rewrap i
(Ast.OptIni
(ini))) ini
248 | Ast.UniqueIni
(ini) ->
249 let ini = disjini
ini in
250 List.map
(function ini -> Ast.rewrap i
(Ast.UniqueIni
(ini))) ini
252 and designator
= function
253 Ast.DesignatorField
(dot
,id) -> [Ast.DesignatorField
(dot
,id)]
254 | Ast.DesignatorIndex
(lb
,exp,rb
) ->
255 let exp = disjexp
exp in
256 List.map
(function exp -> Ast.DesignatorIndex
(lb
,exp,rb
)) exp
257 | Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
258 disjmult2 (disjexp min
) (disjexp max
)
259 (function min
-> function max
->
260 Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
))
263 match Ast.unwrap d
with
264 Ast.MetaDecl
(_
,_
,_
) | Ast.MetaField
(_
,_
,_
)
265 | Ast.MetaFieldList
(_
,_
,_
,_
) -> [d
]
266 | Ast.Init
(stg
,ty,id,eq
,ini,sem
) ->
267 disjmult2 (disjty ty) (disjini
ini)
268 (function ty -> function ini ->
269 Ast.rewrap d
(Ast.Init
(stg
,ty,id,eq
,ini,sem
)))
270 | Ast.UnInit
(stg
,ty,id,sem
) ->
271 let ty = disjty ty in
272 List.map
(function ty -> Ast.rewrap d
(Ast.UnInit
(stg
,ty,id,sem
))) ty
273 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
275 (function args
-> Ast.rewrap d
(Ast.MacroDecl
(name
,lp
,args
,rp
,sem
)))
276 (disjdots disjexp args
)
277 | Ast.TyDecl
(ty,sem
) ->
278 let ty = disjty ty in
279 List.map
(function ty -> Ast.rewrap d
(Ast.TyDecl
(ty,sem
))) ty
280 | Ast.Typedef
(stg
,ty,id,sem
) ->
281 let ty = disjty ty in (* disj not allowed in id *)
282 List.map
(function ty -> Ast.rewrap d
(Ast.Typedef
(stg
,ty,id,sem
))) ty
283 | Ast.DisjDecl
(decls
) -> List.concat
(List.map disjdecl decls
)
284 | Ast.Ddots
(_
,_
) -> [d
]
285 | Ast.OptDecl
(decl
) ->
286 let decl = disjdecl
decl in
287 List.map
(function decl -> Ast.rewrap d
(Ast.OptDecl
(decl))) decl
288 | Ast.UniqueDecl
(decl) ->
289 let decl = disjdecl
decl in
290 List.map
(function decl -> Ast.rewrap d
(Ast.UniqueDecl
(decl))) decl
292 let generic_orify_rule_elem f re
exp rebuild
=
295 | orexps
-> Ast.rewrap re
(Ast.DisjRuleElem
(List.map rebuild orexps
))
297 let orify_rule_elem re
exp rebuild
=
298 generic_orify_rule_elem disjexp re
exp rebuild
300 let orify_rule_elem_ty = generic_orify_rule_elem disjty
301 let orify_rule_elem_param = generic_orify_rule_elem disjparam
302 let orify_rule_elem_decl = generic_orify_rule_elem disjdecl
303 let orify_rule_elem_ini = generic_orify_rule_elem disjini
305 let rec disj_rule_elem r k re
=
306 match Ast.unwrap re
with
307 Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
) ->
308 generic_orify_rule_elem (disjdots disjparam
) re params
311 (Ast.FunHeader
(bef
,allminus
,fninfo
,name
,lp
,params
,rp
)))
312 | Ast.Decl
(bef
,allminus
,decl) ->
313 orify_rule_elem_decl re
decl
314 (function decl -> Ast.rewrap re
(Ast.Decl
(bef
,allminus
,decl)))
315 | Ast.SeqStart
(brace
) -> re
316 | Ast.SeqEnd
(brace
) -> re
317 | Ast.ExprStatement
(exp,sem
) ->
318 orify_rule_elem re
exp
319 (function exp -> Ast.rewrap re
(Ast.ExprStatement
(exp,sem
)))
320 | Ast.IfHeader
(iff
,lp
,exp,rp
) ->
321 orify_rule_elem re
exp
322 (function exp -> Ast.rewrap re
(Ast.IfHeader
(iff
,lp
,exp,rp
)))
323 | Ast.Else
(els
) -> re
324 | Ast.WhileHeader
(whl
,lp
,exp,rp
) ->
325 orify_rule_elem re
exp
326 (function exp -> Ast.rewrap re
(Ast.WhileHeader
(whl
,lp
,exp,rp
)))
327 | Ast.DoHeader
(d
) -> re
328 | Ast.WhileTail
(whl
,lp
,exp,rp
,sem
) ->
329 orify_rule_elem re
exp
330 (function exp -> Ast.rewrap re
(Ast.WhileTail
(whl
,lp
,exp,rp
,sem
)))
331 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
332 generic_orify_rule_elem (disjmult (disjoption disjexp
)) re
[e1
;e2
;e3
]
335 Ast.rewrap re
(Ast.ForHeader
(fr
,lp
,exp1
,sem1
,exp2
,sem2
,exp3
,rp
))
336 | _
-> failwith
"not possible")
337 | Ast.IteratorHeader
(whl
,lp
,args
,rp
) ->
338 generic_orify_rule_elem (disjdots disjexp
) re args
339 (function args
-> Ast.rewrap re
(Ast.IteratorHeader
(whl
,lp
,args
,rp
)))
340 | Ast.SwitchHeader
(switch
,lp
,exp,rp
) ->
341 orify_rule_elem re
exp
342 (function exp -> Ast.rewrap re
(Ast.SwitchHeader
(switch
,lp
,exp,rp
)))
343 | Ast.Break
(_
,_
) | Ast.Continue
(_
,_
) | Ast.Label
(_
,_
) | Ast.Goto
(_
,_
,_
)
344 | Ast.Return
(_
,_
) -> re
345 | Ast.ReturnExpr
(ret
,exp,sem
) ->
346 orify_rule_elem re
exp
347 (function exp -> Ast.rewrap re
(Ast.ReturnExpr
(ret
,exp,sem
)))
348 | Ast.MetaRuleElem
(_
,_
,_
) | Ast.MetaStmt
(_
,_
,_
,_
)
349 | Ast.MetaStmtList
(_
,_
,_
) -> re
351 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.Exp
(exp)))
353 orify_rule_elem re
exp (function exp -> Ast.rewrap
exp (Ast.TopExp
(exp)))
355 orify_rule_elem_ty re
ty (function ty -> Ast.rewrap
ty (Ast.Ty
(ty)))
356 | Ast.TopInit
(init
) ->
357 orify_rule_elem_ini re init
358 (function init
-> Ast.rewrap init
(Ast.TopInit
(init
)))
359 | Ast.Include
(inc
,s
) -> re
360 | Ast.Undef
(def
,id) -> re
361 | Ast.DefineHeader
(def
,id,params
) -> re
362 | Ast.Default
(def
,colon
) -> re
363 | Ast.Case
(case
,exp,colon
) ->
364 orify_rule_elem re
exp
365 (function exp -> Ast.rewrap re
(Ast.Case
(case
,exp,colon
)))
366 | Ast.DisjRuleElem
(l
) ->
367 (* only case lines *)
368 Ast.rewrap re
(Ast.DisjRuleElem
(List.map
(disj_rule_elem r k
) l
))
372 let donothing r k e
= k e
in
374 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
375 donothing donothing donothing donothing donothing
376 donothing donothing donothing donothing donothing donothing donothing
377 disj_rule_elem donothing donothing donothing donothing
379 (* ----------------------------------------------------------------------- *)
380 (* collect iso information at the rule_elem level *)
382 let collect_all_isos =
384 let option_default = [] in
385 let mcode r x
= [] in
386 let donothing r k e
= Common.union_set
(Ast.get_isos e
) (k e
) in
387 let doanything r k e
= k e
in
388 V.combiner
bind option_default
389 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
390 donothing donothing donothing donothing donothing donothing donothing
391 donothing donothing donothing donothing donothing donothing donothing
392 donothing donothing doanything
394 let collect_iso_info =
396 let donothing r k e
= k e
in
397 let rule_elem r k e
=
398 match Ast.unwrap e
with
399 Ast.DisjRuleElem
(l
) -> k e
401 let isos = collect_all_isos.V.combiner_rule_elem e
in
402 Ast.set_isos e
isos in
404 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
405 donothing donothing donothing donothing donothing donothing donothing
407 donothing donothing donothing donothing rule_elem donothing donothing
410 (* ----------------------------------------------------------------------- *)
417 | Ast.InitialScriptRule _
| Ast.FinalScriptRule _
-> (mv
, r
)
418 | Ast.CocciRule
(nm
, rule_info
, r
, isexp
, ruletype
) ->
422 let res = disj_all.V.rebuilder_top_level x
in
423 if !Flag.track_iso_usage
424 then collect_iso_info.V.rebuilder_top_level
res
427 (mv
, Ast.CocciRule
(nm
,rule_info
,res,isexp
,ruletype
)))