Release coccinelle-0.2.5-rc2
[bpt/coccinelle.git] / parsing_cocci / compute_lines.ml
CommitLineData
c491d8ee
C
1(*
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.
7 *
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.
11 *
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.
16 *
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/>.
19 *
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
22 *)
23
24
34e49164
C
25(* Computes starting and ending logical lines for statements and
26expressions. every node gets an index as well. *)
27
28module Ast0 = Ast0_cocci
29module Ast = Ast_cocci
faf9a90c 30
34e49164
C
31(* --------------------------------------------------------------------- *)
32(* Result *)
33
5636bb2c
C
34(* This is a horrible hack. We need to have a special treatment for the code
35inside a nest, and this is to avoid threading that information around
36everywhere *)
37let in_nest_count = ref 0
38let check_attachable v = if !in_nest_count > 0 then false else v
39
34e49164
C
40let mkres x e left right =
41 let lstart = Ast0.get_info left in
42 let lend = Ast0.get_info right in
0708f913
C
43 let pos_info =
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;
708f4980 49 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in
34e49164 50 let info =
0708f913 51 { Ast0.pos_info = pos_info;
5636bb2c
C
52 Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start;
53 Ast0.attachable_end = check_attachable lend.Ast0.attachable_end;
34e49164
C
54 Ast0.mcode_start = lstart.Ast0.mcode_start;
55 Ast0.mcode_end = lend.Ast0.mcode_end;
34e49164 56 (* only for tokens, not inherited upwards *)
0708f913 57 Ast0.strings_before = []; Ast0.strings_after = [] } in
34e49164
C
58 {x with Ast0.node = e; Ast0.info = info}
59
978fd7e5
C
60(* This looks like it is there to allow distribution of plus code
61over disjunctions. But this doesn't work with single_statement, as the
62plus code has not been distributed to the place that it expects. So the
63only reasonably easy solution seems to be to disallow distribution. *)
64(* inherit attachable is because single_statement doesn't work well when +
65code is attached outside an or, but this has to be allowed after
66isomorphisms have been introduced. So only set it to true then, or when we
67know that the code involved cannot contain a statement, ie it is a
68declaration. *)
69let inherit_attachable = ref false
34e49164
C
70let 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
0708f913
C
73 let pos_info =
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
34e49164 80 let info =
0708f913 81 { Ast0.pos_info = pos_info;
5636bb2c
C
82 Ast0.attachable_start =
83 check_attachable (if !inherit_attachable then astart else false);
84 Ast0.attachable_end =
85 check_attachable (if !inherit_attachable then aend else false);
34e49164
C
86 Ast0.mcode_start = start_mcodes;
87 Ast0.mcode_end = end_mcodes;
34e49164
C
88 (* only for tokens, not inherited upwards *)
89 Ast0.strings_before = []; Ast0.strings_after = [] } in
90 {x with Ast0.node = e; Ast0.info = info}
91
92(* --------------------------------------------------------------------- *)
faf9a90c 93
34e49164
C
94let get_option fn = function
95 None -> None
96 | Some x -> Some (fn x)
faf9a90c 97
34e49164
C
98(* --------------------------------------------------------------------- *)
99(* --------------------------------------------------------------------- *)
100(* Mcode *)
101
708f4980 102let promote_mcode (_,_,info,mcodekind,_,_) =
34e49164
C
103 let new_info =
104 {info with
105 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
106 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
107
708f4980 108let promote_mcode_plus_one (_,_,info,mcodekind,_,_) =
ae4735db 109 let new_pos_info =
0708f913
C
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
34e49164
C
115 let new_info =
116 {info with
0708f913 117 Ast0.pos_info = new_pos_info;
34e49164
C
118 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
119 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
120
121let promote_to_statement stm mcodekind =
122 let info = Ast0.get_info stm in
0708f913
C
123 let new_pos_info =
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
34e49164
C
127 let new_info =
128 {info with
0708f913 129 Ast0.pos_info = new_pos_info;
34e49164 130 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
131 Ast0.attachable_start = check_attachable true;
132 Ast0.attachable_end = check_attachable true} in
34e49164
C
133 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
134
135let promote_to_statement_start stm mcodekind =
136 let info = Ast0.get_info stm in
0708f913
C
137 let new_pos_info =
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
34e49164
C
141 let new_info =
142 {info with
0708f913 143 Ast0.pos_info = new_pos_info;
34e49164 144 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
145 Ast0.attachable_start = check_attachable true;
146 Ast0.attachable_end = check_attachable true} in
34e49164
C
147 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
148
149(* mcode is good by default *)
708f4980 150let bad_mcode (t,a,info,mcodekind,pos,adj) =
34e49164 151 let new_info =
5636bb2c
C
152 {info with
153 Ast0.attachable_start = check_attachable false;
154 Ast0.attachable_end = check_attachable false} in
708f4980 155 (t,a,new_info,mcodekind,pos,adj)
34e49164
C
156
157let 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))
160
161let 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))
164
165(* --------------------------------------------------------------------- *)
166(* Dots *)
167
168(* for the logline classification and the mcode field, on both sides, skip
169over initial minus dots, as they don't contribute anything *)
170let dot_list is_dots fn = function
171 [] -> failwith "dots should not be empty"
172 | l ->
173 let get_node l fn =
174 let first = List.hd l in
175 let chosen =
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) =
182 get_node forward
183 (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
184 let (last_attachable,last_mcode) =
185 get_node backward
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
189 let first_info =
190 { (Ast0.get_info first) with
5636bb2c 191 Ast0.attachable_start = check_attachable first_attachable;
34e49164
C
192 Ast0.mcode_start = first_mcode } in
193 let last_info =
194 { (Ast0.get_info last) with
5636bb2c 195 Ast0.attachable_end = check_attachable last_attachable;
34e49164
C
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
199 (forward,first,last)
faf9a90c 200
34e49164
C
201let 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([])) ->
206 Ast0.set_info d
207 {(Ast0.get_info d)
5636bb2c
C
208 with
209 Ast0.attachable_start = check_attachable false;
210 Ast0.attachable_end = check_attachable false}
34e49164
C
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
220
221(* --------------------------------------------------------------------- *)
222(* Identifier *)
faf9a90c 223
5636bb2c
C
224(* for #define name, with no value, to compute right side *)
225let mkidres a b c d r = (mkres a b c d,r)
226
227let rec full_ident i =
34e49164 228 match Ast0.unwrap i with
951c7801 229 Ast0.Id(name) as ui ->
5636bb2c 230 let name = promote_mcode name in mkidres i ui name name name
951c7801
C
231 | Ast0.MetaId(name,_,_)
232 | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
5636bb2c 233 let name = promote_mcode name in mkidres i ui name name name
951c7801 234 | Ast0.OptIdent(id) ->
5636bb2c 235 let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
951c7801 236 | Ast0.UniqueIdent(id) ->
5636bb2c
C
237 let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
238and ident i = let (id,_) = full_ident i in id
faf9a90c 239
34e49164
C
240(* --------------------------------------------------------------------- *)
241(* Expression *)
242
243let is_exp_dots e =
244 match Ast0.unwrap e with
245 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
246 | _ -> false
247
248let rec expression e =
249 match Ast0.unwrap e with
250 Ast0.Ident(id) ->
251 let id = ident id in
252 mkres e (Ast0.Ident(id)) id id
253 | Ast0.Constant(const) as ue ->
254 let ln = promote_mcode const in
255 mkres e ue ln ln
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) ->
faf9a90c 308 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
34e49164
C
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
315 | Ast0.EComma(cm) ->
fc1ad971 316 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
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
351
352and expression_dots x = dots is_exp_dots None expression x
faf9a90c 353
34e49164
C
354(* --------------------------------------------------------------------- *)
355(* Types *)
faf9a90c 356
34e49164
C
357and typeC t =
358 match Ast0.unwrap t with
359 Ast0.ConstVol(cv,ty) ->
360 let ty = typeC ty in
361 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
faf9a90c
C
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 ->
34e49164 367 mkres t ut (promote_mcode sgn) (promote_mcode sgn)
faf9a90c
C
368 | Ast0.Signed(sgn,Some ty) ->
369 let ty = typeC ty in
370 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
34e49164
C
371 | Ast0.Pointer(ty,star) ->
372 let ty = typeC ty in
373 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
374 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
375 let ty = typeC ty in
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) ->
380 let ty = typeC ty in
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) ->
389 let ty = typeC ty in
390 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
391 ty (promote_mcode rb)
c491d8ee 392 | Ast0.EnumName(kind,Some name) ->
faf9a90c 393 let name = ident name in
c491d8ee
C
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) ->
399 let ty = typeC ty in
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)
34e49164
C
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) ->
409 let ty = typeC ty in
410 let decls =
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
faf9a90c 429
34e49164
C
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. *)
434
435and is_decl_dots s =
436 match Ast0.unwrap s with
437 Ast0.Ddots(_,_) -> true
438 | _ -> false
faf9a90c 439
34e49164
C
440and declaration d =
441 match Ast0.unwrap d with
413ffc02
C
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) ->
34e49164
C
445 let ty = typeC ty in
446 let id = ident id in
447 let exp = initialiser exp in
448 (match stg with
449 None ->
450 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 451 | Some x ->
34e49164
C
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) ->
455 let ty = typeC ty in
456 let id = ident id in
457 (match stg with
458 None ->
459 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
460 | Some x ->
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) ->
468 let ty = typeC ty in
469 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
470 | Ast0.Typedef(stg,ty,id,sem) ->
471 let ty = typeC ty in
472 let id = typeC id in
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
493
494(* --------------------------------------------------------------------- *)
495(* Initializer *)
496
497and is_init_dots i =
498 match Ast0.unwrap i with
499 Ast0.Idots(_,_) -> true
500 | _ -> false
faf9a90c 501
34e49164
C
502and initialiser i =
503 match Ast0.unwrap i with
113803cf
C
504 Ast0.MetaInit(name,_) as ut ->
505 let ln = promote_mcode name in mkres i ut ln ln
506 | Ast0.InitExpr(exp) ->
34e49164
C
507 let exp = expression exp in
508 mkres i (Ast0.InitExpr(exp)) exp exp
c491d8ee 509 | Ast0.InitList(lb,initlist,rb,ordered) ->
34e49164
C
510 let initlist =
511 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
c491d8ee 512 mkres i (Ast0.InitList(lb,initlist,rb,ordered))
34e49164 513 (promote_mcode lb) (promote_mcode rb)
113803cf
C
514 | Ast0.InitGccExt(designators,eq,ini) ->
515 let (delims,designators) = (* non empty due to parsing *)
516 List.split (List.map designator designators) in
34e49164 517 let ini = initialiser ini in
113803cf
C
518 mkres i (Ast0.InitGccExt(designators,eq,ini))
519 (promote_mcode (List.hd delims)) ini
34e49164
C
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
34e49164
C
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
536
113803cf
C
537and 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))
544
34e49164
C
545and initialiser_list prev = dots is_init_dots prev initialiser
546
547(* for export *)
548and initialiser_dots x = dots is_init_dots None initialiser x
549
550(* --------------------------------------------------------------------- *)
551(* Parameter *)
552
553and is_param_dots p =
554 match Ast0.unwrap p with
555 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
556 | _ -> false
faf9a90c 557
34e49164
C
558and 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) ->
563 let id = ident id in
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
571 | Ast0.PComma(cm) ->
fc1ad971 572 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
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
589
590and parameter_list prev = dots is_param_dots prev parameterTypeDef
591
592(* for export *)
593let parameter_dots x = dots is_param_dots None parameterTypeDef x
594
7f004419
C
595(* --------------------------------------------------------------------- *)
596
597let is_define_param_dots s =
598 match Ast0.unwrap s with
599 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
600 | _ -> false
601
602let rec define_param p =
603 match Ast0.unwrap p with
604 Ast0.DParam(id) ->
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
624
5636bb2c 625let define_parameters x id =
7f004419 626 match Ast0.unwrap x with
5636bb2c 627 Ast0.NoParams -> (x,id) (* no info, should be ignored *)
7f004419
C
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
5636bb2c 632 (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
7f004419 633
34e49164
C
634(* --------------------------------------------------------------------- *)
635(* Top-level code *)
636
637let is_stm_dots s =
638 match Ast0.unwrap s with
639 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
640 | _ -> false
faf9a90c 641
34e49164
C
642let rec statement s =
643 let res =
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
faf9a90c 649 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164
C
650 let body =
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
668 mkres s
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)) ->
693 let nm = ident nm in
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)))
698 nm right
fc1ad971 699 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 700 let exp = expression exp in
fc1ad971
C
701 let decls =
702 dots is_stm_dots (Some(promote_mcode lb))
703 statement decls in
34e49164 704 let cases =
fc1ad971
C
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
709 arise either *))
710 case_line cases in
34e49164 711 mkres s
fc1ad971 712 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164
C
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) ->
719 let l = ident l in
720 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
721 | Ast0.Goto(goto,id,sem) ->
722 let id = ident id in
faf9a90c 723 mkres s (Ast0.Goto(goto,id,sem))
34e49164
C
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
faf9a90c 729 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164
C
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
734 | Ast0.Exp(exp) ->
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
740 | Ast0.Ty(ty) ->
741 let ty = typeC ty in
742 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
743 | Ast0.TopInit(init) ->
744 let init = initialiser init in
745 mkres s (Ast0.TopInit(init)) init init
34e49164
C
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
751 [] -> []
752 | stm::stms ->
753 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
754 statement stm)::
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
5636bb2c
C
763 let wrapper f =
764 match Ast0.get_mcode_mcodekind starter with
765 Ast0.MINUS _ ->
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
775 plus *)
776 in_nest_count := !in_nest_count + 1;
777 let res = f() in
778 in_nest_count := !in_nest_count - 1;
779 res
780 | _ -> f() in
781 let rule_elem_dots =
782 wrapper
783 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
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) ->
799 let fninfo =
800 List.map
801 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
802 fninfo in
803 let name = ident name in
804 let params = parameter_list (Some(promote_mcode lp)) params in
805 let body =
806 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
807 let left =
808 (* cases on what is leftmost *)
809 match fninfo with
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 *)
825 let res =
826 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
827 body,rbrace) in
828 (* have to do this test again, because of typing problems - can't save
829 the result, only use it *)
830 (match fninfo with
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))
faf9a90c 839
34e49164
C
840 | Ast0.Include(inc,stm) ->
841 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
3a314143
C
842 | Ast0.Undef(def,id) ->
843 let (id,right) = full_ident id in
844 mkres s (Ast0.Undef(def,id)) (promote_mcode def) id
34e49164 845 | Ast0.Define(def,id,params,body) ->
5636bb2c
C
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
34e49164
C
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))
861
862and case_line c =
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
fc1ad971
C
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)
34e49164
C
879 | Ast0.OptCase(case) ->
880 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
881
882and statement_dots x = dots is_stm_dots None statement x
faf9a90c 883
34e49164
C
884(* --------------------------------------------------------------------- *)
885(* Function declaration *)
faf9a90c 886
34e49164
C
887let top_level t =
888 match Ast0.unwrap t with
889 Ast0.FILEINFO(old_file,new_file) -> t
890 | Ast0.DECL(stmt) ->
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"
faf9a90c 897
34e49164
C
898(* --------------------------------------------------------------------- *)
899(* Entry points *)
faf9a90c 900
978fd7e5 901let compute_lines attachable_or x =
5636bb2c 902 in_nest_count := 0;
978fd7e5
C
903 inherit_attachable := attachable_or;
904 List.map top_level x
905
906let compute_statement_lines attachable_or x =
5636bb2c 907 in_nest_count := 0;
978fd7e5
C
908 inherit_attachable := attachable_or;
909 statement x
910
911let compute_statement_dots_lines attachable_or x =
5636bb2c 912 in_nest_count := 0;
978fd7e5
C
913 inherit_attachable := attachable_or;
914 statement_dots x
faf9a90c 915