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 (* Computes starting and ending logical lines for statements and
26 expressions. every node gets an index as well. *)
28 module Ast0
= Ast0_cocci
29 module Ast
= Ast_cocci
31 (* --------------------------------------------------------------------- *)
34 (* This is a horrible hack. We need to have a special treatment for the code
35 inside a nest, and this is to avoid threading that information around
37 let in_nest_count = ref 0
38 let check_attachable v
= if !in_nest_count > 0 then false else v
40 let mkres x e left right
=
41 let lstart = Ast0.get_info left
in
42 let lend = Ast0.get_info right
in
44 { Ast0.line_start
= lstart.Ast0.pos_info.Ast0.line_start
;
45 Ast0.line_end
= lend.Ast0.pos_info.Ast0.line_end
;
46 Ast0.logical_start
= lstart.Ast0.pos_info.Ast0.logical_start
;
47 Ast0.logical_end
= lend.Ast0.pos_info.Ast0.logical_end
;
48 Ast0.column
= lstart.Ast0.pos_info.Ast0.column
;
49 Ast0.offset
= lstart.Ast0.pos_info.Ast0.offset
;} in
51 { Ast0.pos_info = pos_info;
52 Ast0.attachable_start
= check_attachable lstart.Ast0.attachable_start
;
53 Ast0.attachable_end
= check_attachable lend.Ast0.attachable_end
;
54 Ast0.mcode_start
= lstart.Ast0.mcode_start
;
55 Ast0.mcode_end
= lend.Ast0.mcode_end
;
56 (* only for tokens, not inherited upwards *)
57 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
58 {x
with Ast0.node
= e
; Ast0.info = info}
60 (* This looks like it is there to allow distribution of plus code
61 over disjunctions. But this doesn't work with single_statement, as the
62 plus code has not been distributed to the place that it expects. So the
63 only reasonably easy solution seems to be to disallow distribution. *)
64 (* inherit attachable is because single_statement doesn't work well when +
65 code is attached outside an or, but this has to be allowed after
66 isomorphisms have been introduced. So only set it to true then, or when we
67 know that the code involved cannot contain a statement, ie it is a
69 let inherit_attachable = ref false
70 let mkmultires x e left right
(astart
,start_mcodes
) (aend
,end_mcodes
) =
71 let lstart = Ast0.get_info left
in
72 let lend = Ast0.get_info right
in
74 { Ast0.line_start
= lstart.Ast0.pos_info.Ast0.line_start
;
75 Ast0.line_end
= lend.Ast0.pos_info.Ast0.line_end
;
76 Ast0.logical_start
= lstart.Ast0.pos_info.Ast0.logical_start
;
77 Ast0.logical_end
= lend.Ast0.pos_info.Ast0.logical_end
;
78 Ast0.column
= lstart.Ast0.pos_info.Ast0.column
;
79 Ast0.offset
= lstart.Ast0.pos_info.Ast0.offset
; } in
81 { Ast0.pos_info = pos_info;
82 Ast0.attachable_start
=
83 check_attachable (if !inherit_attachable then astart
else false);
85 check_attachable (if !inherit_attachable then aend
else false);
86 Ast0.mcode_start
= start_mcodes
;
87 Ast0.mcode_end
= end_mcodes
;
88 (* only for tokens, not inherited upwards *)
89 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
90 {x
with Ast0.node
= e
; Ast0.info = info}
92 (* --------------------------------------------------------------------- *)
94 let get_option fn
= function
96 | Some x
-> Some
(fn x
)
98 (* --------------------------------------------------------------------- *)
99 (* --------------------------------------------------------------------- *)
102 let promote_mcode (_
,_
,info,mcodekind
,_
,_
) =
105 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
106 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
108 let promote_mcode_plus_one (_
,_
,info,mcodekind
,_
,_
) =
110 {info.Ast0.pos_info with
111 Ast0.line_start
= info.Ast0.pos_info.Ast0.line_start
+ 1;
112 Ast0.logical_start
= info.Ast0.pos_info.Ast0.logical_start
+ 1;
113 Ast0.line_end
= info.Ast0.pos_info.Ast0.line_end
+ 1;
114 Ast0.logical_end
= info.Ast0.pos_info.Ast0.logical_end
+ 1; } in
117 Ast0.pos_info = new_pos_info;
118 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
119 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
121 let promote_to_statement stm mcodekind
=
122 let info = Ast0.get_info stm
in
124 {info.Ast0.pos_info with
125 Ast0.logical_start
= info.Ast0.pos_info.Ast0.logical_end
;
126 Ast0.line_start
= info.Ast0.pos_info.Ast0.line_end
; } in
129 Ast0.pos_info = new_pos_info;
130 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
];
131 Ast0.attachable_start
= check_attachable true;
132 Ast0.attachable_end
= check_attachable true} in
133 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
135 let promote_to_statement_start stm mcodekind
=
136 let info = Ast0.get_info stm
in
138 {info.Ast0.pos_info with
139 Ast0.logical_end
= info.Ast0.pos_info.Ast0.logical_start
;
140 Ast0.line_end
= info.Ast0.pos_info.Ast0.line_start
; } in
143 Ast0.pos_info = new_pos_info;
144 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
];
145 Ast0.attachable_start
= check_attachable true;
146 Ast0.attachable_end
= check_attachable true} in
147 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
149 (* mcode is good by default *)
150 let bad_mcode (t
,a
,info,mcodekind
,pos
,adj
) =
153 Ast0.attachable_start
= check_attachable false;
154 Ast0.attachable_end
= check_attachable false} in
155 (t
,a
,new_info,mcodekind
,pos
,adj
)
157 let get_all_start_info l
=
158 (List.for_all
(function x
-> (Ast0.get_info x
).Ast0.attachable_start
) l
,
159 List.concat
(List.map
(function x
-> (Ast0.get_info x
).Ast0.mcode_start
) l
))
161 let get_all_end_info l
=
162 (List.for_all
(function x
-> (Ast0.get_info x
).Ast0.attachable_end
) l
,
163 List.concat
(List.map
(function x
-> (Ast0.get_info x
).Ast0.mcode_end
) l
))
165 (* --------------------------------------------------------------------- *)
168 (* for the logline classification and the mcode field, on both sides, skip
169 over initial minus dots, as they don't contribute anything *)
170 let dot_list is_dots fn
= function
171 [] -> failwith
"dots should not be empty"
174 let first = List.hd l
in
176 match (is_dots
first, l
) with (true,_
::x
::_
) -> x
| _
-> first in
177 (* get the logline decorator and the mcodekind of the chosen node *)
178 fn
(Ast0.get_info
chosen) in
179 let forward = List.map fn l
in
180 let backward = List.rev
forward in
181 let (first_attachable
,first_mcode
) =
183 (function x
-> (x
.Ast0.attachable_start
,x
.Ast0.mcode_start
)) in
184 let (last_attachable
,last_mcode
) =
186 (function x
-> (x
.Ast0.attachable_end
,x
.Ast0.mcode_end
)) in
187 let first = List.hd
forward in
188 let last = List.hd
backward in
190 { (Ast0.get_info
first) with
191 Ast0.attachable_start
= check_attachable first_attachable
;
192 Ast0.mcode_start
= first_mcode
} in
194 { (Ast0.get_info
last) with
195 Ast0.attachable_end
= check_attachable last_attachable
;
196 Ast0.mcode_end
= last_mcode
} in
197 let first = Ast0.set_info
first first_info in
198 let last = Ast0.set_info
last last_info in
201 let dots is_dots prev fn d
=
202 match (prev
,Ast0.unwrap d
) with
203 (Some prev
,Ast0.DOTS
([])) ->
204 mkres d
(Ast0.DOTS
[]) prev prev
205 | (None
,Ast0.DOTS
([])) ->
209 Ast0.attachable_start
= check_attachable false;
210 Ast0.attachable_end
= check_attachable false}
211 | (_
,Ast0.DOTS
(x
)) ->
212 let (l
,lstart,lend) = dot_list is_dots fn x
in
213 mkres d
(Ast0.DOTS l
) lstart lend
214 | (_
,Ast0.CIRCLES
(x
)) ->
215 let (l
,lstart,lend) = dot_list is_dots fn x
in
216 mkres d
(Ast0.CIRCLES l
) lstart lend
217 | (_
,Ast0.STARS
(x
)) ->
218 let (l
,lstart,lend) = dot_list is_dots fn x
in
219 mkres d
(Ast0.STARS l
) lstart lend
221 (* --------------------------------------------------------------------- *)
224 (* for #define name, with no value, to compute right side *)
225 let mkidres a b c d r
= (mkres a b c d
,r
)
227 let rec full_ident i
=
228 match Ast0.unwrap i
with
229 Ast0.Id
(name
) as ui
->
230 let name = promote_mcode name in mkidres i ui
name name name
231 | Ast0.MetaId
(name,_
,_
)
232 | Ast0.MetaFunc
(name,_
,_
) | Ast0.MetaLocalFunc
(name,_
,_
) as ui
->
233 let name = promote_mcode name in mkidres i ui
name name name
234 | Ast0.OptIdent
(id
) ->
235 let (id
,r
) = full_ident id
in mkidres i
(Ast0.OptIdent
(id
)) id id r
236 | Ast0.UniqueIdent
(id
) ->
237 let (id
,r
) = full_ident id
in mkidres i
(Ast0.UniqueIdent
(id
)) id id r
238 and ident i
= let (id
,_
) = full_ident i
in id
240 (* --------------------------------------------------------------------- *)
244 match Ast0.unwrap e
with
245 Ast0.Edots
(_
,_
) | Ast0.Ecircles
(_
,_
) | Ast0.Estars
(_
,_
) -> true
248 let rec expression e
=
249 match Ast0.unwrap e
with
252 mkres e
(Ast0.Ident
(id)) id id
253 | Ast0.Constant
(const
) as ue
->
254 let ln = promote_mcode const
in
256 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
257 let fn = expression fn in
258 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
259 mkres e
(Ast0.FunCall
(fn,lp
,args,rp
)) fn (promote_mcode rp
)
260 | Ast0.Assignment
(left
,op
,right
,simple
) ->
261 let left = expression left in
262 let right = expression right in
263 mkres e
(Ast0.Assignment
(left,op
,right,simple
)) left right
264 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
265 let exp1 = expression exp1 in
266 let exp2 = get_option expression exp2 in
267 let exp3 = expression exp3 in
268 mkres e
(Ast0.CondExpr
(exp1,why
,exp2,colon
,exp3)) exp1 exp3
269 | Ast0.Postfix
(exp
,op
) ->
270 let exp = expression exp in
271 mkres e
(Ast0.Postfix
(exp,op
)) exp (promote_mcode op
)
272 | Ast0.Infix
(exp,op
) ->
273 let exp = expression exp in
274 mkres e
(Ast0.Infix
(exp,op
)) (promote_mcode op
) exp
275 | Ast0.Unary
(exp,op
) ->
276 let exp = expression exp in
277 mkres e
(Ast0.Unary
(exp,op
)) (promote_mcode op
) exp
278 | Ast0.Binary
(left,op
,right) ->
279 let left = expression left in
280 let right = expression right in
281 mkres e
(Ast0.Binary
(left,op
,right)) left right
282 | Ast0.Nested
(left,op
,right) ->
283 let left = expression left in
284 let right = expression right in
285 mkres e
(Ast0.Nested
(left,op
,right)) left right
286 | Ast0.Paren
(lp
,exp,rp
) ->
287 mkres e
(Ast0.Paren
(lp
,expression exp,rp
))
288 (promote_mcode lp
) (promote_mcode rp
)
289 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
290 let exp1 = expression exp1 in
291 let exp2 = expression exp2 in
292 mkres e
(Ast0.ArrayAccess
(exp1,lb
,exp2,rb
)) exp1 (promote_mcode rb
)
293 | Ast0.RecordAccess
(exp,pt
,field
) ->
294 let exp = expression exp in
295 let field = ident
field in
296 mkres e
(Ast0.RecordAccess
(exp,pt
,field)) exp field
297 | Ast0.RecordPtAccess
(exp,ar
,field) ->
298 let exp = expression exp in
299 let field = ident
field in
300 mkres e
(Ast0.RecordPtAccess
(exp,ar
,field)) exp field
301 | Ast0.Cast
(lp
,ty
,rp
,exp) ->
302 let exp = expression exp in
303 mkres e
(Ast0.Cast
(lp
,typeC ty
,rp
,exp)) (promote_mcode lp
) exp
304 | Ast0.SizeOfExpr
(szf
,exp) ->
305 let exp = expression exp in
306 mkres e
(Ast0.SizeOfExpr
(szf
,exp)) (promote_mcode szf
) exp
307 | Ast0.SizeOfType
(szf
,lp
,ty
,rp
) ->
308 mkres e
(Ast0.SizeOfType
(szf
,lp
,typeC ty
,rp
))
309 (promote_mcode szf
) (promote_mcode rp
)
310 | Ast0.TypeExp
(ty
) ->
311 let ty = typeC
ty in mkres e
(Ast0.TypeExp
(ty)) ty ty
312 | Ast0.MetaErr
(name,_
,_
) | Ast0.MetaExpr
(name,_
,_
,_
,_
)
313 | Ast0.MetaExprList
(name,_
,_
) as ue
->
314 let ln = promote_mcode name in mkres e ue
ln ln
316 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
317 let ln = promote_mcode cm in
318 mkres e
(Ast0.EComma
(cm)) ln ln
319 | Ast0.DisjExpr
(starter
,exps
,mids
,ender
) ->
320 let starter = bad_mcode starter in
321 let exps = List.map
expression exps in
322 let mids = List.map
bad_mcode mids in
323 let ender = bad_mcode ender in
324 mkmultires e
(Ast0.DisjExpr
(starter,exps,mids,ender))
325 (promote_mcode starter) (promote_mcode ender)
326 (get_all_start_info exps) (get_all_end_info exps)
327 | Ast0.NestExpr
(starter,exp_dots
,ender,whencode
,multi
) ->
328 let exp_dots = dots is_exp_dots None
expression exp_dots in
329 let starter = bad_mcode starter in
330 let ender = bad_mcode ender in
331 mkres e
(Ast0.NestExpr
(starter,exp_dots,ender,whencode
,multi
))
332 (promote_mcode starter) (promote_mcode ender)
333 | Ast0.Edots
(dots,whencode
) ->
334 let dots = bad_mcode dots in
335 let ln = promote_mcode dots in
336 mkres e
(Ast0.Edots
(dots,whencode
)) ln ln
337 | Ast0.Ecircles
(dots,whencode
) ->
338 let dots = bad_mcode dots in
339 let ln = promote_mcode dots in
340 mkres e
(Ast0.Ecircles
(dots,whencode
)) ln ln
341 | Ast0.Estars
(dots,whencode
) ->
342 let dots = bad_mcode dots in
343 let ln = promote_mcode dots in
344 mkres e
(Ast0.Estars
(dots,whencode
)) ln ln
345 | Ast0.OptExp
(exp) ->
346 let exp = expression exp in
347 mkres e
(Ast0.OptExp
(exp)) exp exp
348 | Ast0.UniqueExp
(exp) ->
349 let exp = expression exp in
350 mkres e
(Ast0.UniqueExp
(exp)) exp exp
352 and expression_dots x
= dots is_exp_dots None
expression x
354 (* --------------------------------------------------------------------- *)
358 match Ast0.unwrap t
with
359 Ast0.ConstVol
(cv
,ty) ->
361 mkres t
(Ast0.ConstVol
(cv
,ty)) (promote_mcode cv
) ty
362 | Ast0.BaseType
(ty,strings
) as ut
->
363 let first = List.hd strings
in
364 let last = List.hd
(List.rev strings
) in
365 mkres t ut
(promote_mcode first) (promote_mcode last)
366 | Ast0.Signed
(sgn
,None
) as ut
->
367 mkres t ut
(promote_mcode sgn
) (promote_mcode sgn
)
368 | Ast0.Signed
(sgn
,Some
ty) ->
370 mkres t
(Ast0.Signed
(sgn
,Some
ty)) (promote_mcode sgn
) ty
371 | Ast0.Pointer
(ty,star
) ->
373 mkres t
(Ast0.Pointer
(ty,star
)) ty (promote_mcode star
)
374 | Ast0.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
376 let params = parameter_list
(Some
(promote_mcode lp2
)) params in
377 mkres t
(Ast0.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params,rp2
))
378 ty (promote_mcode rp2
)
379 | Ast0.FunctionType
(Some
ty,lp1
,params,rp1
) ->
381 let params = parameter_list
(Some
(promote_mcode lp1
)) params in
382 let res = Ast0.FunctionType
(Some
ty,lp1
,params,rp1
) in
383 mkres t
res ty (promote_mcode rp1
)
384 | Ast0.FunctionType
(None
,lp1
,params,rp1
) ->
385 let params = parameter_list
(Some
(promote_mcode lp1
)) params in
386 let res = Ast0.FunctionType
(None
,lp1
,params,rp1
) in
387 mkres t
res (promote_mcode lp1
) (promote_mcode rp1
)
388 | Ast0.Array
(ty,lb
,size
,rb
) ->
390 mkres t
(Ast0.Array
(ty,lb
,get_option expression size
,rb
))
391 ty (promote_mcode rb
)
392 | Ast0.EnumName
(kind
,Some
name) ->
393 let name = ident
name in
394 mkres t
(Ast0.EnumName
(kind
,Some
name)) (promote_mcode kind
) name
395 | Ast0.EnumName
(kind
,None
) ->
396 let mc = promote_mcode kind
in
397 mkres t
(Ast0.EnumName
(kind
,None
)) mc mc
398 | Ast0.EnumDef
(ty,lb
,ids
,rb
) ->
400 let ids = dots is_exp_dots (Some
(promote_mcode lb
)) expression ids in
401 mkres t
(Ast0.EnumDef
(ty,lb
,ids,rb
)) ty (promote_mcode rb
)
402 | Ast0.StructUnionName
(kind
,Some
name) ->
403 let name = ident
name in
404 mkres t
(Ast0.StructUnionName
(kind
,Some
name)) (promote_mcode kind
) name
405 | Ast0.StructUnionName
(kind
,None
) ->
406 let mc = promote_mcode kind
in
407 mkres t
(Ast0.StructUnionName
(kind
,None
)) mc mc
408 | Ast0.StructUnionDef
(ty,lb
,decls
,rb
) ->
411 dots is_decl_dots
(Some
(promote_mcode lb
)) declaration
decls in
412 mkres t
(Ast0.StructUnionDef
(ty,lb
,decls,rb
)) ty (promote_mcode rb
)
413 | Ast0.TypeName
(name) as ut
->
414 let ln = promote_mcode name in mkres t ut
ln ln
415 | Ast0.MetaType
(name,_
) as ut
->
416 let ln = promote_mcode name in mkres t ut
ln ln
417 | Ast0.DisjType
(starter,types
,mids,ender) ->
418 let starter = bad_mcode starter in
419 let types = List.map typeC
types in
420 let mids = List.map
bad_mcode mids in
421 let ender = bad_mcode ender in
422 mkmultires t
(Ast0.DisjType
(starter,types,mids,ender))
423 (promote_mcode starter) (promote_mcode ender)
424 (get_all_start_info types) (get_all_end_info types)
425 | Ast0.OptType
(ty) ->
426 let ty = typeC
ty in mkres t
(Ast0.OptType
(ty)) ty ty
427 | Ast0.UniqueType
(ty) ->
428 let ty = typeC
ty in mkres t
(Ast0.UniqueType
(ty)) ty ty
430 (* --------------------------------------------------------------------- *)
431 (* Variable declaration *)
432 (* Even if the Cocci program specifies a list of declarations, they are
433 split out into multiple declarations of a single variable each. *)
436 match Ast0.unwrap s
with
437 Ast0.Ddots
(_
,_
) -> true
441 match Ast0.unwrap d
with
442 (Ast0.MetaDecl
(name,_
) | Ast0.MetaField
(name,_
)) as up
->
443 let ln = promote_mcode name in mkres d up
ln ln
444 | Ast0.Init
(stg
,ty,id,eq
,exp,sem
) ->
447 let exp = initialiser
exp in
450 mkres d
(Ast0.Init
(stg
,ty,id,eq
,exp,sem
)) ty (promote_mcode sem
)
452 mkres d
(Ast0.Init
(stg
,ty,id,eq
,exp,sem
))
453 (promote_mcode x
) (promote_mcode sem
))
454 | Ast0.UnInit
(stg
,ty,id,sem
) ->
459 mkres d
(Ast0.UnInit
(stg
,ty,id,sem
)) ty (promote_mcode sem
)
461 mkres d
(Ast0.UnInit
(stg
,ty,id,sem
))
462 (promote_mcode x
) (promote_mcode sem
))
463 | Ast0.MacroDecl
(name,lp
,args,rp
,sem
) ->
464 let name = ident
name in
465 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
466 mkres d
(Ast0.MacroDecl
(name,lp
,args,rp
,sem
)) name (promote_mcode sem
)
467 | Ast0.TyDecl
(ty,sem
) ->
469 mkres d
(Ast0.TyDecl
(ty,sem
)) ty (promote_mcode sem
)
470 | Ast0.Typedef
(stg
,ty,id,sem
) ->
473 mkres d
(Ast0.Typedef
(stg
,ty,id,sem
))
474 (promote_mcode stg
) (promote_mcode sem
)
475 | Ast0.DisjDecl
(starter,decls,mids,ender) ->
476 let starter = bad_mcode starter in
477 let decls = List.map declaration
decls in
478 let mids = List.map
bad_mcode mids in
479 let ender = bad_mcode ender in
480 mkmultires d
(Ast0.DisjDecl
(starter,decls,mids,ender))
481 (promote_mcode starter) (promote_mcode ender)
482 (get_all_start_info decls) (get_all_end_info decls)
483 | Ast0.Ddots
(dots,whencode
) ->
484 let dots = bad_mcode dots in
485 let ln = promote_mcode dots in
486 mkres d
(Ast0.Ddots
(dots,whencode
)) ln ln
487 | Ast0.OptDecl
(decl
) ->
488 let decl = declaration
decl in
489 mkres d
(Ast0.OptDecl
(declaration
decl)) decl decl
490 | Ast0.UniqueDecl
(decl) ->
491 let decl = declaration
decl in
492 mkres d
(Ast0.UniqueDecl
(declaration
decl)) decl decl
494 (* --------------------------------------------------------------------- *)
498 match Ast0.unwrap i
with
499 Ast0.Idots
(_
,_
) -> true
503 match Ast0.unwrap i
with
504 Ast0.MetaInit
(name,_
) as ut
->
505 let ln = promote_mcode name in mkres i ut
ln ln
506 | Ast0.InitExpr
(exp) ->
507 let exp = expression exp in
508 mkres i
(Ast0.InitExpr
(exp)) exp exp
509 | Ast0.InitList
(lb
,initlist
,rb
,ordered
) ->
511 dots is_init_dots
(Some
(promote_mcode lb
)) initialiser
initlist in
512 mkres i
(Ast0.InitList
(lb
,initlist,rb
,ordered
))
513 (promote_mcode lb
) (promote_mcode rb
)
514 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
515 let (delims
,designators
) = (* non empty due to parsing *)
516 List.split
(List.map designator designators
) in
517 let ini = initialiser
ini in
518 mkres i
(Ast0.InitGccExt
(designators
,eq
,ini))
519 (promote_mcode (List.hd delims
)) ini
520 | Ast0.InitGccName
(name,eq
,ini) ->
521 let name = ident
name in
522 let ini = initialiser
ini in
523 mkres i
(Ast0.InitGccName
(name,eq
,ini)) name ini
524 | Ast0.IComma
(cm) as up
->
525 let ln = promote_mcode cm in mkres i up
ln ln
526 | Ast0.Idots
(dots,whencode
) ->
527 let dots = bad_mcode dots in
528 let ln = promote_mcode dots in
529 mkres i
(Ast0.Idots
(dots,whencode
)) ln ln
530 | Ast0.OptIni
(ini) ->
531 let ini = initialiser
ini in
532 mkres i
(Ast0.OptIni
(ini)) ini ini
533 | Ast0.UniqueIni
(ini) ->
534 let ini = initialiser
ini in
535 mkres i
(Ast0.UniqueIni
(ini)) ini ini
537 and designator
= function
538 Ast0.DesignatorField
(dot
,id) ->
539 (dot
,Ast0.DesignatorField
(dot
,ident
id))
540 | Ast0.DesignatorIndex
(lb
,exp,rb
) ->
541 (lb
,Ast0.DesignatorIndex
(lb
,expression exp,rb
))
542 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
543 (lb
,Ast0.DesignatorRange
(lb
,expression min
,dots,expression max
,rb
))
545 and initialiser_list prev
= dots is_init_dots prev initialiser
548 and initialiser_dots x
= dots is_init_dots None initialiser x
550 (* --------------------------------------------------------------------- *)
553 and is_param_dots p
=
554 match Ast0.unwrap p
with
555 Ast0.Pdots
(_
) | Ast0.Pcircles
(_
) -> true
558 and parameterTypeDef p
=
559 match Ast0.unwrap p
with
560 Ast0.VoidParam
(ty) ->
561 let ty = typeC
ty in mkres p
(Ast0.VoidParam
(ty)) ty ty
562 | Ast0.Param
(ty,Some
id) ->
564 let ty = typeC
ty in mkres p
(Ast0.Param
(ty,Some
id)) ty id
565 | Ast0.Param
(ty,None
) ->
566 let ty = typeC
ty in mkres p
(Ast0.Param
(ty,None
)) ty ty
567 | Ast0.MetaParam
(name,_
) as up
->
568 let ln = promote_mcode name in mkres p up
ln ln
569 | Ast0.MetaParamList
(name,_
,_
) as up
->
570 let ln = promote_mcode name in mkres p up
ln ln
572 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
573 let ln = promote_mcode cm in
574 mkres p
(Ast0.PComma
(cm)) ln ln
575 | Ast0.Pdots
(dots) ->
576 let dots = bad_mcode dots in
577 let ln = promote_mcode dots in
578 mkres p
(Ast0.Pdots
(dots)) ln ln
579 | Ast0.Pcircles
(dots) ->
580 let dots = bad_mcode dots in
581 let ln = promote_mcode dots in
582 mkres p
(Ast0.Pcircles
(dots)) ln ln
583 | Ast0.OptParam
(param
) ->
584 let res = parameterTypeDef param
in
585 mkres p
(Ast0.OptParam
(res)) res res
586 | Ast0.UniqueParam
(param
) ->
587 let res = parameterTypeDef param
in
588 mkres p
(Ast0.UniqueParam
(res)) res res
590 and parameter_list prev
= dots is_param_dots prev parameterTypeDef
593 let parameter_dots x
= dots is_param_dots None parameterTypeDef x
595 (* --------------------------------------------------------------------- *)
597 let is_define_param_dots s
=
598 match Ast0.unwrap s
with
599 Ast0.DPdots
(_
) | Ast0.DPcircles
(_
) -> true
602 let rec define_param p
=
603 match Ast0.unwrap p
with
605 let id = ident
id in mkres p
(Ast0.DParam
(id)) id id
606 | Ast0.DPComma
(cm) ->
607 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
608 let ln = promote_mcode cm in
609 mkres p
(Ast0.DPComma
(cm)) ln ln
610 | Ast0.DPdots
(dots) ->
611 let dots = bad_mcode dots in
612 let ln = promote_mcode dots in
613 mkres p
(Ast0.DPdots
(dots)) ln ln
614 | Ast0.DPcircles
(dots) ->
615 let dots = bad_mcode dots in
616 let ln = promote_mcode dots in
617 mkres p
(Ast0.DPcircles
(dots)) ln ln
618 | Ast0.OptDParam
(dp
) ->
619 let res = define_param dp
in
620 mkres p
(Ast0.OptDParam
(res)) res res
621 | Ast0.UniqueDParam
(dp
) ->
622 let res = define_param dp
in
623 mkres p
(Ast0.UniqueDParam
(res)) res res
625 let define_parameters x
id =
626 match Ast0.unwrap x
with
627 Ast0.NoParams
-> (x
,id) (* no info, should be ignored *)
628 | Ast0.DParams
(lp
,dp
,rp
) ->
629 let dp = dots is_define_param_dots None
define_param dp in
630 let l = promote_mcode lp
in
631 let r = promote_mcode rp
in
632 (mkres x
(Ast0.DParams
(lp
,dp,rp
)) l r, r)
634 (* --------------------------------------------------------------------- *)
638 match Ast0.unwrap s
with
639 Ast0.Dots
(_
,_
) | Ast0.Circles
(_
,_
) | Ast0.Stars
(_
,_
) -> true
642 let rec statement s
=
644 match Ast0.unwrap s
with
645 Ast0.Decl
((_
,bef
),decl) ->
646 let decl = declaration
decl in
647 let left = promote_to_statement_start decl bef
in
648 mkres s
(Ast0.Decl
((Ast0.get_info
left,bef
),decl)) decl decl
649 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
651 dots is_stm_dots (Some
(promote_mcode lbrace
)) statement body in
652 mkres s
(Ast0.Seq
(lbrace
,body,rbrace
))
653 (promote_mcode lbrace
) (promote_mcode rbrace
)
654 | Ast0.ExprStatement
(exp,sem
) ->
655 let exp = expression exp in
656 mkres s
(Ast0.ExprStatement
(exp,sem
)) exp (promote_mcode sem
)
657 | Ast0.IfThen
(iff
,lp
,exp,rp
,branch
,(_
,aft
)) ->
658 let exp = expression exp in
659 let branch = statement branch in
660 let right = promote_to_statement branch aft
in
661 mkres s
(Ast0.IfThen
(iff
,lp
,exp,rp
,branch,(Ast0.get_info
right,aft
)))
662 (promote_mcode iff
) right
663 | Ast0.IfThenElse
(iff
,lp
,exp,rp
,branch1
,els
,branch2
,(_
,aft
)) ->
664 let exp = expression exp in
665 let branch1 = statement branch1 in
666 let branch2 = statement branch2 in
667 let right = promote_to_statement branch2 aft
in
669 (Ast0.IfThenElse
(iff
,lp
,exp,rp
,branch1,els
,branch2,
670 (Ast0.get_info
right,aft
)))
671 (promote_mcode iff
) right
672 | Ast0.While
(wh
,lp
,exp,rp
,body,(_
,aft
)) ->
673 let exp = expression exp in
674 let body = statement body in
675 let right = promote_to_statement body aft
in
676 mkres s
(Ast0.While
(wh
,lp
,exp,rp
,body,(Ast0.get_info
right,aft
)))
677 (promote_mcode wh
) right
678 | Ast0.Do
(d
,body,wh
,lp
,exp,rp
,sem
) ->
679 let body = statement body in
680 let exp = expression exp in
681 mkres s
(Ast0.Do
(d
,body,wh
,lp
,exp,rp
,sem
))
682 (promote_mcode d
) (promote_mcode sem
)
683 | Ast0.For
(fr
,lp
,exp1,sem1
,exp2,sem2
,exp3,rp
,body,(_
,aft
)) ->
684 let exp1 = get_option expression exp1 in
685 let exp2 = get_option expression exp2 in
686 let exp3 = get_option expression exp3 in
687 let body = statement body in
688 let right = promote_to_statement body aft
in
689 mkres s
(Ast0.For
(fr
,lp
,exp1,sem1
,exp2,sem2
,exp3,rp
,body,
690 (Ast0.get_info
right,aft
)))
691 (promote_mcode fr
) right
692 | Ast0.Iterator
(nm
,lp
,args,rp
,body,(_
,aft
)) ->
694 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
695 let body = statement body in
696 let right = promote_to_statement body aft
in
697 mkres s
(Ast0.Iterator
(nm,lp
,args,rp
,body,(Ast0.get_info
right,aft
)))
699 | Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases
,rb
) ->
700 let exp = expression exp in
702 dots is_stm_dots (Some
(promote_mcode lb
))
705 dots (function _
-> false)
706 (if Ast0.undots
decls = []
707 then (Some
(promote_mcode lb
))
708 else None
(* not sure this is right, but not sure the case can
712 (Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases,rb
))
713 (promote_mcode switch
) (promote_mcode rb
)
714 | Ast0.Break
(br
,sem
) as us
->
715 mkres s us
(promote_mcode br
) (promote_mcode sem
)
716 | Ast0.Continue
(cont
,sem
) as us
->
717 mkres s us
(promote_mcode cont
) (promote_mcode sem
)
718 | Ast0.Label
(l,dd
) ->
720 mkres s
(Ast0.Label
(l,dd
)) l (promote_mcode dd
)
721 | Ast0.Goto
(goto
,id,sem
) ->
723 mkres s
(Ast0.Goto
(goto
,id,sem
))
724 (promote_mcode goto
) (promote_mcode sem
)
725 | Ast0.Return
(ret
,sem
) as us
->
726 mkres s us
(promote_mcode ret
) (promote_mcode sem
)
727 | Ast0.ReturnExpr
(ret
,exp,sem
) ->
728 let exp = expression exp in
729 mkres s
(Ast0.ReturnExpr
(ret
,exp,sem
))
730 (promote_mcode ret
) (promote_mcode sem
)
731 | Ast0.MetaStmt
(name,_
)
732 | Ast0.MetaStmtList
(name,_
) as us
->
733 let ln = promote_mcode name in mkres s us
ln ln
735 let exp = expression exp in
736 mkres s
(Ast0.Exp
(exp)) exp exp
737 | Ast0.TopExp
(exp) ->
738 let exp = expression exp in
739 mkres s
(Ast0.TopExp
(exp)) exp exp
742 mkres s
(Ast0.Ty
(ty)) ty ty
743 | Ast0.TopInit
(init
) ->
744 let init = initialiser
init in
745 mkres s
(Ast0.TopInit
(init)) init init
746 | Ast0.Disj
(starter,rule_elem_dots_list
,mids,ender) ->
747 let starter = bad_mcode starter in
748 let mids = List.map
bad_mcode mids in
749 let ender = bad_mcode ender in
750 let rec loop prevs
= function
753 (dots is_stm_dots (Some
(promote_mcode_plus_one(List.hd prevs
)))
755 (loop (List.tl prevs
) stms
) in
756 let elems = loop (starter::mids) rule_elem_dots_list
in
757 mkmultires s
(Ast0.Disj
(starter,elems,mids,ender))
758 (promote_mcode starter) (promote_mcode ender)
759 (get_all_start_info elems) (get_all_end_info elems)
760 | Ast0.Nest
(starter,rule_elem_dots
,ender,whencode
,multi
) ->
761 let starter = bad_mcode starter in
762 let ender = bad_mcode ender in
764 match Ast0.get_mcode_mcodekind
starter with
766 (* if minus, then all nest code has to be minus. This is
767 checked at the token level, in parse_cocci.ml. All nest code
768 is also unattachable. We strip the minus annotations from
769 the nest code because in the CTL another metavariable will
770 take care of removing all the code matched by the nest.
771 Without stripping the minus annotations, we would get a
772 double transformation. Perhaps there is a more elegant
773 way to do this in the CTL, but it is not easy, because of
774 the interaction with the whencode and the implementation of
776 in_nest_count := !in_nest_count + 1;
778 in_nest_count := !in_nest_count - 1;
783 (function _
-> dots is_stm_dots None
statement rule_elem_dots) in
784 mkres s
(Ast0.Nest
(starter,rule_elem_dots,ender,whencode
,multi
))
785 (promote_mcode starter) (promote_mcode ender)
786 | Ast0.Dots
(dots,whencode
) ->
787 let dots = bad_mcode dots in
788 let ln = promote_mcode dots in
789 mkres s
(Ast0.Dots
(dots,whencode
)) ln ln
790 | Ast0.Circles
(dots,whencode
) ->
791 let dots = bad_mcode dots in
792 let ln = promote_mcode dots in
793 mkres s
(Ast0.Circles
(dots,whencode
)) ln ln
794 | Ast0.Stars
(dots,whencode
) ->
795 let dots = bad_mcode dots in
796 let ln = promote_mcode dots in
797 mkres s
(Ast0.Stars
(dots,whencode
)) ln ln
798 | Ast0.FunDecl
((_
,bef
),fninfo
,name,lp
,params,rp
,lbrace
,body,rbrace
) ->
801 (function Ast0.FType
(ty) -> Ast0.FType
(typeC
ty) | x
-> x
)
803 let name = ident
name in
804 let params = parameter_list
(Some
(promote_mcode lp
)) params in
806 dots is_stm_dots (Some
(promote_mcode lbrace
)) statement body in
808 (* cases on what is leftmost *)
810 [] -> promote_to_statement_start name bef
811 | Ast0.FStorage
(stg
)::_
->
812 promote_to_statement_start (promote_mcode stg
) bef
813 | Ast0.FType
(ty)::_
->
814 promote_to_statement_start ty bef
815 | Ast0.FInline
(inline
)::_
->
816 promote_to_statement_start (promote_mcode inline
) bef
817 | Ast0.FAttr
(attr
)::_
->
818 promote_to_statement_start (promote_mcode attr
) bef
in
819 (* pretend it is one line before the start of the function, so that it
820 will catch things defined at top level. We assume that these will not
821 be defined on the same line as the function. This is a HACK.
822 A better approach would be to attach top_level things to this node,
823 and other things to the node after, but that would complicate
824 insert_plus, which doesn't distinguish between different mcodekinds *)
826 Ast0.FunDecl
((Ast0.get_info
left,bef
),fninfo,name,lp
,params,rp
,lbrace
,
828 (* have to do this test again, because of typing problems - can't save
829 the result, only use it *)
831 [] -> mkres s
res name (promote_mcode rbrace
)
832 | Ast0.FStorage
(stg
)::_
->
833 mkres s
res (promote_mcode stg
) (promote_mcode rbrace
)
834 | Ast0.FType
(ty)::_
-> mkres s
res ty (promote_mcode rbrace
)
835 | Ast0.FInline
(inline
)::_
->
836 mkres s
res (promote_mcode inline
) (promote_mcode rbrace
)
837 | Ast0.FAttr
(attr
)::_
->
838 mkres s
res (promote_mcode attr
) (promote_mcode rbrace
))
840 | Ast0.Include
(inc
,stm
) ->
841 mkres s
(Ast0.Include
(inc
,stm
)) (promote_mcode inc
) (promote_mcode stm
)
842 | Ast0.Undef
(def
,id) ->
843 let (id,right) = full_ident id in
844 mkres s
(Ast0.Undef
(def
,id)) (promote_mcode def
) id
845 | Ast0.Define
(def
,id,params,body) ->
846 let (id,right) = full_ident id in
847 let (params,prev
) = define_parameters params right in
848 let body = dots is_stm_dots (Some prev
) statement body in
849 mkres s
(Ast0.Define
(def
,id,params,body)) (promote_mcode def
) body
850 | Ast0.OptStm
(stm
) ->
851 let stm = statement stm in mkres s
(Ast0.OptStm
(stm)) stm stm
852 | Ast0.UniqueStm
(stm) ->
853 let stm = statement stm in mkres s
(Ast0.UniqueStm
(stm)) stm stm in
854 Ast0.set_dots_bef_aft
res
855 (match Ast0.get_dots_bef_aft
res with
856 Ast0.NoDots
-> Ast0.NoDots
857 | Ast0.AddingBetweenDots s
->
858 Ast0.AddingBetweenDots
(statement s
)
859 | Ast0.DroppingBetweenDots s
->
860 Ast0.DroppingBetweenDots
(statement s
))
863 match Ast0.unwrap c
with
864 Ast0.Default
(def
,colon
,code
) ->
865 let code = dots is_stm_dots (Some
(promote_mcode colon
)) statement code in
866 mkres c
(Ast0.Default
(def
,colon
,code)) (promote_mcode def
) code
867 | Ast0.Case
(case
,exp,colon
,code) ->
868 let exp = expression exp in
869 let code = dots is_stm_dots (Some
(promote_mcode colon
)) statement code in
870 mkres c
(Ast0.Case
(case
,exp,colon
,code)) (promote_mcode case
) code
871 | Ast0.DisjCase
(starter,case_lines
,mids,ender) ->
872 let starter = bad_mcode starter in
873 let case_lines = List.map case_line
case_lines in
874 let mids = List.map
bad_mcode mids in
875 let ender = bad_mcode ender in
876 mkmultires c
(Ast0.DisjCase
(starter,case_lines,mids,ender))
877 (promote_mcode starter) (promote_mcode ender)
878 (get_all_start_info case_lines) (get_all_end_info case_lines)
879 | Ast0.OptCase
(case
) ->
880 let case = case_line
case in mkres c
(Ast0.OptCase
(case)) case case
882 and statement_dots x
= dots is_stm_dots None
statement x
884 (* --------------------------------------------------------------------- *)
885 (* Function declaration *)
888 match Ast0.unwrap t
with
889 Ast0.FILEINFO
(old_file
,new_file
) -> t
891 let stmt = statement stmt in mkres t
(Ast0.DECL
(stmt)) stmt stmt
892 | Ast0.CODE
(rule_elem_dots) ->
893 let rule_elem_dots = dots is_stm_dots None
statement rule_elem_dots in
894 mkres t
(Ast0.CODE
(rule_elem_dots)) rule_elem_dots rule_elem_dots
895 | Ast0.ERRORWORDS
(exps) -> t
896 | Ast0.OTHER
(_
) -> failwith
"eliminated by top_level"
898 (* --------------------------------------------------------------------- *)
901 let compute_lines attachable_or x
=
903 inherit_attachable := attachable_or
;
906 let compute_statement_lines attachable_or x
=
908 inherit_attachable := attachable_or
;
911 let compute_statement_dots_lines attachable_or x
=
913 inherit_attachable := attachable_or
;