Coccinelle release 0.2.5-rc5
[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
d3f655c6
C
221(* --------------------------------------------------------------------- *)
222(* Disjunctions *)
223
224let do_disj e starter xs mids ender processor rebuilder =
225 let starter = bad_mcode starter in
226 let xs = List.map processor xs in
227 let mids = List.map bad_mcode mids in
228 let ender = bad_mcode ender in
229 mkmultires e (rebuilder starter xs mids ender)
230 (promote_mcode starter) (promote_mcode ender)
231 (get_all_start_info xs) (get_all_end_info xs)
232
34e49164
C
233(* --------------------------------------------------------------------- *)
234(* Identifier *)
faf9a90c 235
5636bb2c
C
236(* for #define name, with no value, to compute right side *)
237let mkidres a b c d r = (mkres a b c d,r)
238
239let rec full_ident i =
34e49164 240 match Ast0.unwrap i with
d3f655c6
C
241 Ast0.Id(name) as ui ->
242 let name = promote_mcode name in mkidres i ui name name (Some name)
243 | Ast0.MetaId(name,_,_)
244 | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
245 let name = promote_mcode name in mkidres i ui name name (Some name)
246 | Ast0.DisjId(starter,ids,mids,ender) ->
247 let res =
248 do_disj i starter ids mids ender ident
249 (fun starter ids mids ender ->
250 Ast0.DisjId(starter,ids,mids,ender)) in
251 (res,None)
252 | Ast0.OptIdent(id) ->
253 let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
254 | Ast0.UniqueIdent(id) ->
255 let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
5636bb2c 256and ident i = let (id,_) = full_ident i in id
faf9a90c 257
34e49164
C
258(* --------------------------------------------------------------------- *)
259(* Expression *)
260
261let is_exp_dots e =
262 match Ast0.unwrap e with
263 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
264 | _ -> false
265
266let rec expression e =
267 match Ast0.unwrap e with
268 Ast0.Ident(id) ->
269 let id = ident id in
270 mkres e (Ast0.Ident(id)) id id
271 | Ast0.Constant(const) as ue ->
272 let ln = promote_mcode const in
273 mkres e ue ln ln
274 | Ast0.FunCall(fn,lp,args,rp) ->
275 let fn = expression fn in
276 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
277 mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
278 | Ast0.Assignment(left,op,right,simple) ->
279 let left = expression left in
280 let right = expression right in
281 mkres e (Ast0.Assignment(left,op,right,simple)) left right
282 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
283 let exp1 = expression exp1 in
284 let exp2 = get_option expression exp2 in
285 let exp3 = expression exp3 in
286 mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
287 | Ast0.Postfix(exp,op) ->
288 let exp = expression exp in
289 mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
290 | Ast0.Infix(exp,op) ->
291 let exp = expression exp in
292 mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
293 | Ast0.Unary(exp,op) ->
294 let exp = expression exp in
295 mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
296 | Ast0.Binary(left,op,right) ->
297 let left = expression left in
298 let right = expression right in
299 mkres e (Ast0.Binary(left,op,right)) left right
300 | Ast0.Nested(left,op,right) ->
301 let left = expression left in
302 let right = expression right in
303 mkres e (Ast0.Nested(left,op,right)) left right
304 | Ast0.Paren(lp,exp,rp) ->
305 mkres e (Ast0.Paren(lp,expression exp,rp))
306 (promote_mcode lp) (promote_mcode rp)
307 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
308 let exp1 = expression exp1 in
309 let exp2 = expression exp2 in
310 mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
311 | Ast0.RecordAccess(exp,pt,field) ->
312 let exp = expression exp in
313 let field = ident field in
314 mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
315 | Ast0.RecordPtAccess(exp,ar,field) ->
316 let exp = expression exp in
317 let field = ident field in
318 mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
319 | Ast0.Cast(lp,ty,rp,exp) ->
320 let exp = expression exp in
321 mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
322 | Ast0.SizeOfExpr(szf,exp) ->
323 let exp = expression exp in
324 mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
325 | Ast0.SizeOfType(szf,lp,ty,rp) ->
faf9a90c 326 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
34e49164
C
327 (promote_mcode szf) (promote_mcode rp)
328 | Ast0.TypeExp(ty) ->
329 let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
330 | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
331 | Ast0.MetaExprList(name,_,_) as ue ->
332 let ln = promote_mcode name in mkres e ue ln ln
333 | Ast0.EComma(cm) ->
fc1ad971 334 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
335 let ln = promote_mcode cm in
336 mkres e (Ast0.EComma(cm)) ln ln
337 | Ast0.DisjExpr(starter,exps,mids,ender) ->
d3f655c6
C
338 do_disj e starter exps mids ender expression
339 (fun starter exps mids ender -> Ast0.DisjExpr(starter,exps,mids,ender))
34e49164
C
340 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
341 let exp_dots = dots is_exp_dots None expression exp_dots in
342 let starter = bad_mcode starter in
343 let ender = bad_mcode ender in
344 mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
345 (promote_mcode starter) (promote_mcode ender)
346 | Ast0.Edots(dots,whencode) ->
347 let dots = bad_mcode dots in
348 let ln = promote_mcode dots in
349 mkres e (Ast0.Edots(dots,whencode)) ln ln
350 | Ast0.Ecircles(dots,whencode) ->
351 let dots = bad_mcode dots in
352 let ln = promote_mcode dots in
353 mkres e (Ast0.Ecircles(dots,whencode)) ln ln
354 | Ast0.Estars(dots,whencode) ->
355 let dots = bad_mcode dots in
356 let ln = promote_mcode dots in
357 mkres e (Ast0.Estars(dots,whencode)) ln ln
358 | Ast0.OptExp(exp) ->
359 let exp = expression exp in
360 mkres e (Ast0.OptExp(exp)) exp exp
361 | Ast0.UniqueExp(exp) ->
362 let exp = expression exp in
363 mkres e (Ast0.UniqueExp(exp)) exp exp
364
365and expression_dots x = dots is_exp_dots None expression x
faf9a90c 366
34e49164
C
367(* --------------------------------------------------------------------- *)
368(* Types *)
faf9a90c 369
34e49164
C
370and typeC t =
371 match Ast0.unwrap t with
372 Ast0.ConstVol(cv,ty) ->
373 let ty = typeC ty in
374 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
faf9a90c
C
375 | Ast0.BaseType(ty,strings) as ut ->
376 let first = List.hd strings in
377 let last = List.hd (List.rev strings) in
378 mkres t ut (promote_mcode first) (promote_mcode last)
379 | Ast0.Signed(sgn,None) as ut ->
34e49164 380 mkres t ut (promote_mcode sgn) (promote_mcode sgn)
faf9a90c
C
381 | Ast0.Signed(sgn,Some ty) ->
382 let ty = typeC ty in
383 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
34e49164
C
384 | Ast0.Pointer(ty,star) ->
385 let ty = typeC ty in
386 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
387 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
388 let ty = typeC ty in
389 let params = parameter_list (Some(promote_mcode lp2)) params in
390 mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
391 ty (promote_mcode rp2)
392 | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
393 let ty = typeC ty in
394 let params = parameter_list (Some(promote_mcode lp1)) params in
395 let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
396 mkres t res ty (promote_mcode rp1)
397 | Ast0.FunctionType(None,lp1,params,rp1) ->
398 let params = parameter_list (Some(promote_mcode lp1)) params in
399 let res = Ast0.FunctionType(None,lp1,params,rp1) in
400 mkres t res (promote_mcode lp1) (promote_mcode rp1)
401 | Ast0.Array(ty,lb,size,rb) ->
402 let ty = typeC ty in
403 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
404 ty (promote_mcode rb)
c491d8ee 405 | Ast0.EnumName(kind,Some name) ->
faf9a90c 406 let name = ident name in
c491d8ee
C
407 mkres t (Ast0.EnumName(kind,Some name)) (promote_mcode kind) name
408 | Ast0.EnumName(kind,None) ->
409 let mc = promote_mcode kind in
410 mkres t (Ast0.EnumName(kind,None)) mc mc
411 | Ast0.EnumDef(ty,lb,ids,rb) ->
412 let ty = typeC ty in
413 let ids = dots is_exp_dots (Some(promote_mcode lb)) expression ids in
414 mkres t (Ast0.EnumDef(ty,lb,ids,rb)) ty (promote_mcode rb)
34e49164
C
415 | Ast0.StructUnionName(kind,Some name) ->
416 let name = ident name in
417 mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
418 | Ast0.StructUnionName(kind,None) ->
419 let mc = promote_mcode kind in
420 mkres t (Ast0.StructUnionName(kind,None)) mc mc
421 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
422 let ty = typeC ty in
423 let decls =
424 dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
425 mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
426 | Ast0.TypeName(name) as ut ->
427 let ln = promote_mcode name in mkres t ut ln ln
428 | Ast0.MetaType(name,_) as ut ->
429 let ln = promote_mcode name in mkres t ut ln ln
430 | Ast0.DisjType(starter,types,mids,ender) ->
d3f655c6
C
431 do_disj t starter types mids ender typeC
432 (fun starter types mids ender ->
433 Ast0.DisjType(starter,types,mids,ender))
34e49164
C
434 | Ast0.OptType(ty) ->
435 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
436 | Ast0.UniqueType(ty) ->
437 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
faf9a90c 438
34e49164
C
439(* --------------------------------------------------------------------- *)
440(* Variable declaration *)
441(* Even if the Cocci program specifies a list of declarations, they are
442 split out into multiple declarations of a single variable each. *)
443
444and is_decl_dots s =
445 match Ast0.unwrap s with
446 Ast0.Ddots(_,_) -> true
447 | _ -> false
faf9a90c 448
34e49164
C
449and declaration d =
450 match Ast0.unwrap d with
413ffc02
C
451 (Ast0.MetaDecl(name,_) | Ast0.MetaField(name,_)) as up ->
452 let ln = promote_mcode name in mkres d up ln ln
453 | Ast0.Init(stg,ty,id,eq,exp,sem) ->
34e49164
C
454 let ty = typeC ty in
455 let id = ident id in
456 let exp = initialiser exp in
457 (match stg with
458 None ->
459 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 460 | Some x ->
34e49164
C
461 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
462 (promote_mcode x) (promote_mcode sem))
463 | Ast0.UnInit(stg,ty,id,sem) ->
464 let ty = typeC ty in
465 let id = ident id in
466 (match stg with
467 None ->
468 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
469 | Some x ->
470 mkres d (Ast0.UnInit(stg,ty,id,sem))
471 (promote_mcode x) (promote_mcode sem))
472 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
473 let name = ident name in
474 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
475 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
476 | Ast0.TyDecl(ty,sem) ->
477 let ty = typeC ty in
478 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
479 | Ast0.Typedef(stg,ty,id,sem) ->
480 let ty = typeC ty in
481 let id = typeC id in
482 mkres d (Ast0.Typedef(stg,ty,id,sem))
483 (promote_mcode stg) (promote_mcode sem)
484 | Ast0.DisjDecl(starter,decls,mids,ender) ->
d3f655c6
C
485 do_disj d starter decls mids ender declaration
486 (fun starter decls mids ender ->
487 Ast0.DisjDecl(starter,decls,mids,ender))
34e49164
C
488 | Ast0.Ddots(dots,whencode) ->
489 let dots = bad_mcode dots in
490 let ln = promote_mcode dots in
491 mkres d (Ast0.Ddots(dots,whencode)) ln ln
492 | Ast0.OptDecl(decl) ->
493 let decl = declaration decl in
494 mkres d (Ast0.OptDecl(declaration decl)) decl decl
495 | Ast0.UniqueDecl(decl) ->
496 let decl = declaration decl in
497 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
498
499(* --------------------------------------------------------------------- *)
500(* Initializer *)
501
502and is_init_dots i =
503 match Ast0.unwrap i with
504 Ast0.Idots(_,_) -> true
505 | _ -> false
faf9a90c 506
34e49164
C
507and initialiser i =
508 match Ast0.unwrap i with
113803cf
C
509 Ast0.MetaInit(name,_) as ut ->
510 let ln = promote_mcode name in mkres i ut ln ln
511 | Ast0.InitExpr(exp) ->
34e49164
C
512 let exp = expression exp in
513 mkres i (Ast0.InitExpr(exp)) exp exp
c491d8ee 514 | Ast0.InitList(lb,initlist,rb,ordered) ->
34e49164
C
515 let initlist =
516 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
c491d8ee 517 mkres i (Ast0.InitList(lb,initlist,rb,ordered))
34e49164 518 (promote_mcode lb) (promote_mcode rb)
113803cf
C
519 | Ast0.InitGccExt(designators,eq,ini) ->
520 let (delims,designators) = (* non empty due to parsing *)
521 List.split (List.map designator designators) in
34e49164 522 let ini = initialiser ini in
113803cf
C
523 mkres i (Ast0.InitGccExt(designators,eq,ini))
524 (promote_mcode (List.hd delims)) ini
34e49164
C
525 | Ast0.InitGccName(name,eq,ini) ->
526 let name = ident name in
527 let ini = initialiser ini in
528 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
34e49164
C
529 | Ast0.IComma(cm) as up ->
530 let ln = promote_mcode cm in mkres i up ln ln
531 | Ast0.Idots(dots,whencode) ->
532 let dots = bad_mcode dots in
533 let ln = promote_mcode dots in
534 mkres i (Ast0.Idots(dots,whencode)) ln ln
535 | Ast0.OptIni(ini) ->
536 let ini = initialiser ini in
537 mkres i (Ast0.OptIni(ini)) ini ini
538 | Ast0.UniqueIni(ini) ->
539 let ini = initialiser ini in
540 mkres i (Ast0.UniqueIni(ini)) ini ini
541
113803cf
C
542and designator = function
543 Ast0.DesignatorField(dot,id) ->
544 (dot,Ast0.DesignatorField(dot,ident id))
545 | Ast0.DesignatorIndex(lb,exp,rb) ->
546 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
547 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
548 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
549
34e49164
C
550and initialiser_list prev = dots is_init_dots prev initialiser
551
552(* for export *)
553and initialiser_dots x = dots is_init_dots None initialiser x
554
555(* --------------------------------------------------------------------- *)
556(* Parameter *)
557
558and is_param_dots p =
559 match Ast0.unwrap p with
560 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
561 | _ -> false
faf9a90c 562
34e49164
C
563and parameterTypeDef p =
564 match Ast0.unwrap p with
565 Ast0.VoidParam(ty) ->
566 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
567 | Ast0.Param(ty,Some id) ->
568 let id = ident id in
569 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
570 | Ast0.Param(ty,None) ->
571 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
572 | Ast0.MetaParam(name,_) as up ->
573 let ln = promote_mcode name in mkres p up ln ln
574 | Ast0.MetaParamList(name,_,_) as up ->
575 let ln = promote_mcode name in mkres p up ln ln
576 | Ast0.PComma(cm) ->
fc1ad971 577 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
578 let ln = promote_mcode cm in
579 mkres p (Ast0.PComma(cm)) ln ln
580 | Ast0.Pdots(dots) ->
581 let dots = bad_mcode dots in
582 let ln = promote_mcode dots in
583 mkres p (Ast0.Pdots(dots)) ln ln
584 | Ast0.Pcircles(dots) ->
585 let dots = bad_mcode dots in
586 let ln = promote_mcode dots in
587 mkres p (Ast0.Pcircles(dots)) ln ln
588 | Ast0.OptParam(param) ->
589 let res = parameterTypeDef param in
590 mkres p (Ast0.OptParam(res)) res res
591 | Ast0.UniqueParam(param) ->
592 let res = parameterTypeDef param in
593 mkres p (Ast0.UniqueParam(res)) res res
594
595and parameter_list prev = dots is_param_dots prev parameterTypeDef
596
597(* for export *)
598let parameter_dots x = dots is_param_dots None parameterTypeDef x
599
7f004419
C
600(* --------------------------------------------------------------------- *)
601
602let is_define_param_dots s =
603 match Ast0.unwrap s with
604 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
605 | _ -> false
606
607let rec define_param p =
608 match Ast0.unwrap p with
609 Ast0.DParam(id) ->
610 let id = ident id in mkres p (Ast0.DParam(id)) id id
611 | Ast0.DPComma(cm) ->
612 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
613 let ln = promote_mcode cm in
614 mkres p (Ast0.DPComma(cm)) ln ln
615 | Ast0.DPdots(dots) ->
616 let dots = bad_mcode dots in
617 let ln = promote_mcode dots in
618 mkres p (Ast0.DPdots(dots)) ln ln
619 | Ast0.DPcircles(dots) ->
620 let dots = bad_mcode dots in
621 let ln = promote_mcode dots in
622 mkres p (Ast0.DPcircles(dots)) ln ln
623 | Ast0.OptDParam(dp) ->
624 let res = define_param dp in
625 mkres p (Ast0.OptDParam(res)) res res
626 | Ast0.UniqueDParam(dp) ->
627 let res = define_param dp in
628 mkres p (Ast0.UniqueDParam(res)) res res
629
5636bb2c 630let define_parameters x id =
7f004419 631 match Ast0.unwrap x with
5636bb2c 632 Ast0.NoParams -> (x,id) (* no info, should be ignored *)
7f004419
C
633 | Ast0.DParams(lp,dp,rp) ->
634 let dp = dots is_define_param_dots None define_param dp in
635 let l = promote_mcode lp in
636 let r = promote_mcode rp in
5636bb2c 637 (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
7f004419 638
34e49164
C
639(* --------------------------------------------------------------------- *)
640(* Top-level code *)
641
642let is_stm_dots s =
643 match Ast0.unwrap s with
644 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
645 | _ -> false
faf9a90c 646
34e49164
C
647let rec statement s =
648 let res =
649 match Ast0.unwrap s with
650 Ast0.Decl((_,bef),decl) ->
651 let decl = declaration decl in
652 let left = promote_to_statement_start decl bef in
653 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
faf9a90c 654 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164
C
655 let body =
656 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
657 mkres s (Ast0.Seq(lbrace,body,rbrace))
658 (promote_mcode lbrace) (promote_mcode rbrace)
659 | Ast0.ExprStatement(exp,sem) ->
660 let exp = expression exp in
661 mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
662 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
663 let exp = expression exp in
664 let branch = statement branch in
665 let right = promote_to_statement branch aft in
666 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
667 (promote_mcode iff) right
668 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
669 let exp = expression exp in
670 let branch1 = statement branch1 in
671 let branch2 = statement branch2 in
672 let right = promote_to_statement branch2 aft in
673 mkres s
674 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
675 (Ast0.get_info right,aft)))
676 (promote_mcode iff) right
677 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
678 let exp = expression exp in
679 let body = statement body in
680 let right = promote_to_statement body aft in
681 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
682 (promote_mcode wh) right
683 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
684 let body = statement body in
685 let exp = expression exp in
686 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
687 (promote_mcode d) (promote_mcode sem)
688 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
689 let exp1 = get_option expression exp1 in
690 let exp2 = get_option expression exp2 in
691 let exp3 = get_option expression exp3 in
692 let body = statement body in
693 let right = promote_to_statement body aft in
694 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
695 (Ast0.get_info right,aft)))
696 (promote_mcode fr) right
697 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
698 let nm = ident nm in
699 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
700 let body = statement body in
701 let right = promote_to_statement body aft in
702 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
703 nm right
fc1ad971 704 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 705 let exp = expression exp in
fc1ad971
C
706 let decls =
707 dots is_stm_dots (Some(promote_mcode lb))
708 statement decls in
34e49164 709 let cases =
fc1ad971
C
710 dots (function _ -> false)
711 (if Ast0.undots decls = []
712 then (Some(promote_mcode lb))
713 else None (* not sure this is right, but not sure the case can
714 arise either *))
715 case_line cases in
34e49164 716 mkres s
fc1ad971 717 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164
C
718 (promote_mcode switch) (promote_mcode rb)
719 | Ast0.Break(br,sem) as us ->
720 mkres s us (promote_mcode br) (promote_mcode sem)
721 | Ast0.Continue(cont,sem) as us ->
722 mkres s us (promote_mcode cont) (promote_mcode sem)
723 | Ast0.Label(l,dd) ->
724 let l = ident l in
725 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
726 | Ast0.Goto(goto,id,sem) ->
727 let id = ident id in
faf9a90c 728 mkres s (Ast0.Goto(goto,id,sem))
34e49164
C
729 (promote_mcode goto) (promote_mcode sem)
730 | Ast0.Return(ret,sem) as us ->
731 mkres s us (promote_mcode ret) (promote_mcode sem)
732 | Ast0.ReturnExpr(ret,exp,sem) ->
733 let exp = expression exp in
faf9a90c 734 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164
C
735 (promote_mcode ret) (promote_mcode sem)
736 | Ast0.MetaStmt(name,_)
737 | Ast0.MetaStmtList(name,_) as us ->
738 let ln = promote_mcode name in mkres s us ln ln
739 | Ast0.Exp(exp) ->
740 let exp = expression exp in
741 mkres s (Ast0.Exp(exp)) exp exp
742 | Ast0.TopExp(exp) ->
743 let exp = expression exp in
744 mkres s (Ast0.TopExp(exp)) exp exp
745 | Ast0.Ty(ty) ->
746 let ty = typeC ty in
747 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
748 | Ast0.TopInit(init) ->
749 let init = initialiser init in
750 mkres s (Ast0.TopInit(init)) init init
34e49164
C
751 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
752 let starter = bad_mcode starter in
753 let mids = List.map bad_mcode mids in
754 let ender = bad_mcode ender in
755 let rec loop prevs = function
756 [] -> []
757 | stm::stms ->
758 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
759 statement stm)::
760 (loop (List.tl prevs) stms) in
761 let elems = loop (starter::mids) rule_elem_dots_list in
762 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
763 (promote_mcode starter) (promote_mcode ender)
764 (get_all_start_info elems) (get_all_end_info elems)
765 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
766 let starter = bad_mcode starter in
767 let ender = bad_mcode ender in
5636bb2c
C
768 let wrapper f =
769 match Ast0.get_mcode_mcodekind starter with
770 Ast0.MINUS _ ->
771 (* if minus, then all nest code has to be minus. This is
772 checked at the token level, in parse_cocci.ml. All nest code
773 is also unattachable. We strip the minus annotations from
774 the nest code because in the CTL another metavariable will
775 take care of removing all the code matched by the nest.
776 Without stripping the minus annotations, we would get a
777 double transformation. Perhaps there is a more elegant
778 way to do this in the CTL, but it is not easy, because of
779 the interaction with the whencode and the implementation of
780 plus *)
781 in_nest_count := !in_nest_count + 1;
782 let res = f() in
783 in_nest_count := !in_nest_count - 1;
784 res
785 | _ -> f() in
786 let rule_elem_dots =
787 wrapper
788 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
789 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
790 (promote_mcode starter) (promote_mcode ender)
791 | Ast0.Dots(dots,whencode) ->
792 let dots = bad_mcode dots in
793 let ln = promote_mcode dots in
794 mkres s (Ast0.Dots(dots,whencode)) ln ln
795 | Ast0.Circles(dots,whencode) ->
796 let dots = bad_mcode dots in
797 let ln = promote_mcode dots in
798 mkres s (Ast0.Circles(dots,whencode)) ln ln
799 | Ast0.Stars(dots,whencode) ->
800 let dots = bad_mcode dots in
801 let ln = promote_mcode dots in
802 mkres s (Ast0.Stars(dots,whencode)) ln ln
803 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
804 let fninfo =
805 List.map
806 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
807 fninfo in
808 let name = ident name in
809 let params = parameter_list (Some(promote_mcode lp)) params in
810 let body =
811 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
812 let left =
813 (* cases on what is leftmost *)
814 match fninfo with
815 [] -> promote_to_statement_start name bef
816 | Ast0.FStorage(stg)::_ ->
817 promote_to_statement_start (promote_mcode stg) bef
818 | Ast0.FType(ty)::_ ->
819 promote_to_statement_start ty bef
820 | Ast0.FInline(inline)::_ ->
821 promote_to_statement_start (promote_mcode inline) bef
822 | Ast0.FAttr(attr)::_ ->
823 promote_to_statement_start (promote_mcode attr) bef in
824 (* pretend it is one line before the start of the function, so that it
825 will catch things defined at top level. We assume that these will not
826 be defined on the same line as the function. This is a HACK.
827 A better approach would be to attach top_level things to this node,
828 and other things to the node after, but that would complicate
829 insert_plus, which doesn't distinguish between different mcodekinds *)
830 let res =
831 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
832 body,rbrace) in
833 (* have to do this test again, because of typing problems - can't save
834 the result, only use it *)
835 (match fninfo with
836 [] -> mkres s res name (promote_mcode rbrace)
837 | Ast0.FStorage(stg)::_ ->
838 mkres s res (promote_mcode stg) (promote_mcode rbrace)
839 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
840 | Ast0.FInline(inline)::_ ->
841 mkres s res (promote_mcode inline) (promote_mcode rbrace)
842 | Ast0.FAttr(attr)::_ ->
843 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 844
34e49164
C
845 | Ast0.Include(inc,stm) ->
846 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
3a314143 847 | Ast0.Undef(def,id) ->
d3f655c6 848 let id = ident id in
3a314143 849 mkres s (Ast0.Undef(def,id)) (promote_mcode def) id
34e49164 850 | Ast0.Define(def,id,params,body) ->
5636bb2c 851 let (id,right) = full_ident id in
d3f655c6
C
852 (match right with
853 None -> failwith "no disj id for #define"
854 | Some right ->
855 let (params,prev) = define_parameters params right in
856 let body = dots is_stm_dots (Some prev) statement body in
857 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body)
34e49164
C
858 | Ast0.OptStm(stm) ->
859 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
860 | Ast0.UniqueStm(stm) ->
861 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
862 Ast0.set_dots_bef_aft res
863 (match Ast0.get_dots_bef_aft res with
864 Ast0.NoDots -> Ast0.NoDots
865 | Ast0.AddingBetweenDots s ->
866 Ast0.AddingBetweenDots(statement s)
867 | Ast0.DroppingBetweenDots s ->
868 Ast0.DroppingBetweenDots(statement s))
869
870and case_line c =
871 match Ast0.unwrap c with
872 Ast0.Default(def,colon,code) ->
873 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
874 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
875 | Ast0.Case(case,exp,colon,code) ->
876 let exp = expression exp in
877 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
878 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
fc1ad971 879 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
d3f655c6
C
880 do_disj c starter case_lines mids ender case_line
881 (fun starter case_lines mids ender ->
882 Ast0.DisjCase(starter,case_lines,mids,ender))
34e49164
C
883 | Ast0.OptCase(case) ->
884 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
885
886and statement_dots x = dots is_stm_dots None statement x
faf9a90c 887
34e49164
C
888(* --------------------------------------------------------------------- *)
889(* Function declaration *)
faf9a90c 890
34e49164
C
891let top_level t =
892 match Ast0.unwrap t with
893 Ast0.FILEINFO(old_file,new_file) -> t
894 | Ast0.DECL(stmt) ->
895 let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
896 | Ast0.CODE(rule_elem_dots) ->
897 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
898 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
899 | Ast0.ERRORWORDS(exps) -> t
900 | Ast0.OTHER(_) -> failwith "eliminated by top_level"
faf9a90c 901
34e49164
C
902(* --------------------------------------------------------------------- *)
903(* Entry points *)
faf9a90c 904
978fd7e5 905let compute_lines attachable_or x =
5636bb2c 906 in_nest_count := 0;
978fd7e5
C
907 inherit_attachable := attachable_or;
908 List.map top_level x
909
910let compute_statement_lines attachable_or x =
5636bb2c 911 in_nest_count := 0;
978fd7e5
C
912 inherit_attachable := attachable_or;
913 statement x
914
915let compute_statement_dots_lines attachable_or x =
5636bb2c 916 in_nest_count := 0;
978fd7e5
C
917 inherit_attachable := attachable_or;
918 statement_dots x
faf9a90c 919