Release coccinelle-0.2.3rc1
[bpt/coccinelle.git] / parsing_cocci / compute_lines.ml
CommitLineData
9f8e26f4 1(*
ae4735db 2 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
9f8e26f4
C
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
5 *
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
9 *
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
5636bb2c
C
23(*
24 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
25 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
26 * This file is part of Coccinelle.
27 *
28 * Coccinelle is free software: you can redistribute it and/or modify
29 * it under the terms of the GNU General Public License as published by
30 * the Free Software Foundation, according to version 2 of the License.
31 *
32 * Coccinelle is distributed in the hope that it will be useful,
33 * but WITHOUT ANY WARRANTY; without even the implied warranty of
34 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
35 * GNU General Public License for more details.
36 *
37 * You should have received a copy of the GNU General Public License
38 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
39 *
40 * The authors reserve the right to distribute this or future versions of
41 * Coccinelle under other licenses.
42 *)
43
44
34e49164
C
45(* Computes starting and ending logical lines for statements and
46expressions. every node gets an index as well. *)
47
48module Ast0 = Ast0_cocci
49module Ast = Ast_cocci
faf9a90c 50
34e49164
C
51(* --------------------------------------------------------------------- *)
52(* Result *)
53
5636bb2c
C
54(* This is a horrible hack. We need to have a special treatment for the code
55inside a nest, and this is to avoid threading that information around
56everywhere *)
57let in_nest_count = ref 0
58let check_attachable v = if !in_nest_count > 0 then false else v
59
34e49164
C
60let mkres x e left right =
61 let lstart = Ast0.get_info left in
62 let lend = Ast0.get_info right in
0708f913
C
63 let pos_info =
64 { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
65 Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
66 Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
67 Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
68 Ast0.column = lstart.Ast0.pos_info.Ast0.column;
708f4980 69 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in
34e49164 70 let info =
0708f913 71 { Ast0.pos_info = pos_info;
5636bb2c
C
72 Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start;
73 Ast0.attachable_end = check_attachable lend.Ast0.attachable_end;
34e49164
C
74 Ast0.mcode_start = lstart.Ast0.mcode_start;
75 Ast0.mcode_end = lend.Ast0.mcode_end;
34e49164 76 (* only for tokens, not inherited upwards *)
0708f913 77 Ast0.strings_before = []; Ast0.strings_after = [] } in
34e49164
C
78 {x with Ast0.node = e; Ast0.info = info}
79
978fd7e5
C
80(* This looks like it is there to allow distribution of plus code
81over disjunctions. But this doesn't work with single_statement, as the
82plus code has not been distributed to the place that it expects. So the
83only reasonably easy solution seems to be to disallow distribution. *)
84(* inherit attachable is because single_statement doesn't work well when +
85code is attached outside an or, but this has to be allowed after
86isomorphisms have been introduced. So only set it to true then, or when we
87know that the code involved cannot contain a statement, ie it is a
88declaration. *)
89let inherit_attachable = ref false
34e49164
C
90let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) =
91 let lstart = Ast0.get_info left in
92 let lend = Ast0.get_info right in
0708f913
C
93 let pos_info =
94 { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
95 Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
96 Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
97 Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
98 Ast0.column = lstart.Ast0.pos_info.Ast0.column;
99 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in
34e49164 100 let info =
0708f913 101 { Ast0.pos_info = pos_info;
5636bb2c
C
102 Ast0.attachable_start =
103 check_attachable (if !inherit_attachable then astart else false);
104 Ast0.attachable_end =
105 check_attachable (if !inherit_attachable then aend else false);
34e49164
C
106 Ast0.mcode_start = start_mcodes;
107 Ast0.mcode_end = end_mcodes;
34e49164
C
108 (* only for tokens, not inherited upwards *)
109 Ast0.strings_before = []; Ast0.strings_after = [] } in
110 {x with Ast0.node = e; Ast0.info = info}
111
112(* --------------------------------------------------------------------- *)
faf9a90c 113
34e49164
C
114let get_option fn = function
115 None -> None
116 | Some x -> Some (fn x)
faf9a90c 117
34e49164
C
118(* --------------------------------------------------------------------- *)
119(* --------------------------------------------------------------------- *)
120(* Mcode *)
121
708f4980 122let promote_mcode (_,_,info,mcodekind,_,_) =
34e49164
C
123 let new_info =
124 {info with
125 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
126 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
127
708f4980 128let promote_mcode_plus_one (_,_,info,mcodekind,_,_) =
ae4735db 129 let new_pos_info =
0708f913
C
130 {info.Ast0.pos_info with
131 Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1;
132 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1;
133 Ast0.line_end = info.Ast0.pos_info.Ast0.line_end + 1;
134 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_end + 1; } in
34e49164
C
135 let new_info =
136 {info with
0708f913 137 Ast0.pos_info = new_pos_info;
34e49164
C
138 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
139 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
140
141let promote_to_statement stm mcodekind =
142 let info = Ast0.get_info stm in
0708f913
C
143 let new_pos_info =
144 {info.Ast0.pos_info with
145 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_end;
146 Ast0.line_start = info.Ast0.pos_info.Ast0.line_end; } in
34e49164
C
147 let new_info =
148 {info with
0708f913 149 Ast0.pos_info = new_pos_info;
34e49164 150 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
151 Ast0.attachable_start = check_attachable true;
152 Ast0.attachable_end = check_attachable true} in
34e49164
C
153 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
154
155let promote_to_statement_start stm mcodekind =
156 let info = Ast0.get_info stm in
0708f913
C
157 let new_pos_info =
158 {info.Ast0.pos_info with
159 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_start;
160 Ast0.line_end = info.Ast0.pos_info.Ast0.line_start; } in
34e49164
C
161 let new_info =
162 {info with
0708f913 163 Ast0.pos_info = new_pos_info;
34e49164 164 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
165 Ast0.attachable_start = check_attachable true;
166 Ast0.attachable_end = check_attachable true} in
34e49164
C
167 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
168
169(* mcode is good by default *)
708f4980 170let bad_mcode (t,a,info,mcodekind,pos,adj) =
34e49164 171 let new_info =
5636bb2c
C
172 {info with
173 Ast0.attachable_start = check_attachable false;
174 Ast0.attachable_end = check_attachable false} in
708f4980 175 (t,a,new_info,mcodekind,pos,adj)
34e49164
C
176
177let get_all_start_info l =
178 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l,
179 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l))
180
181let get_all_end_info l =
182 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l,
183 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l))
184
185(* --------------------------------------------------------------------- *)
186(* Dots *)
187
188(* for the logline classification and the mcode field, on both sides, skip
189over initial minus dots, as they don't contribute anything *)
190let dot_list is_dots fn = function
191 [] -> failwith "dots should not be empty"
192 | l ->
193 let get_node l fn =
194 let first = List.hd l in
195 let chosen =
196 match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in
197 (* get the logline decorator and the mcodekind of the chosen node *)
198 fn (Ast0.get_info chosen) in
199 let forward = List.map fn l in
200 let backward = List.rev forward in
201 let (first_attachable,first_mcode) =
202 get_node forward
203 (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
204 let (last_attachable,last_mcode) =
205 get_node backward
206 (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in
207 let first = List.hd forward in
208 let last = List.hd backward in
209 let first_info =
210 { (Ast0.get_info first) with
5636bb2c 211 Ast0.attachable_start = check_attachable first_attachable;
34e49164
C
212 Ast0.mcode_start = first_mcode } in
213 let last_info =
214 { (Ast0.get_info last) with
5636bb2c 215 Ast0.attachable_end = check_attachable last_attachable;
34e49164
C
216 Ast0.mcode_end = last_mcode } in
217 let first = Ast0.set_info first first_info in
218 let last = Ast0.set_info last last_info in
219 (forward,first,last)
faf9a90c 220
34e49164
C
221let dots is_dots prev fn d =
222 match (prev,Ast0.unwrap d) with
223 (Some prev,Ast0.DOTS([])) ->
224 mkres d (Ast0.DOTS []) prev prev
225 | (None,Ast0.DOTS([])) ->
226 Ast0.set_info d
227 {(Ast0.get_info d)
5636bb2c
C
228 with
229 Ast0.attachable_start = check_attachable false;
230 Ast0.attachable_end = check_attachable false}
34e49164
C
231 | (_,Ast0.DOTS(x)) ->
232 let (l,lstart,lend) = dot_list is_dots fn x in
233 mkres d (Ast0.DOTS l) lstart lend
234 | (_,Ast0.CIRCLES(x)) ->
235 let (l,lstart,lend) = dot_list is_dots fn x in
236 mkres d (Ast0.CIRCLES l) lstart lend
237 | (_,Ast0.STARS(x)) ->
238 let (l,lstart,lend) = dot_list is_dots fn x in
239 mkres d (Ast0.STARS l) lstart lend
240
241(* --------------------------------------------------------------------- *)
242(* Identifier *)
faf9a90c 243
5636bb2c
C
244(* for #define name, with no value, to compute right side *)
245let mkidres a b c d r = (mkres a b c d,r)
246
247let rec full_ident i =
34e49164 248 match Ast0.unwrap i with
951c7801 249 Ast0.Id(name) as ui ->
5636bb2c 250 let name = promote_mcode name in mkidres i ui name name name
951c7801
C
251 | Ast0.MetaId(name,_,_)
252 | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
5636bb2c 253 let name = promote_mcode name in mkidres i ui name name name
951c7801 254 | Ast0.OptIdent(id) ->
5636bb2c 255 let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
951c7801 256 | Ast0.UniqueIdent(id) ->
5636bb2c
C
257 let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
258and ident i = let (id,_) = full_ident i in id
faf9a90c 259
34e49164
C
260(* --------------------------------------------------------------------- *)
261(* Expression *)
262
263let is_exp_dots e =
264 match Ast0.unwrap e with
265 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
266 | _ -> false
267
268let rec expression e =
269 match Ast0.unwrap e with
270 Ast0.Ident(id) ->
271 let id = ident id in
272 mkres e (Ast0.Ident(id)) id id
273 | Ast0.Constant(const) as ue ->
274 let ln = promote_mcode const in
275 mkres e ue ln ln
276 | Ast0.FunCall(fn,lp,args,rp) ->
277 let fn = expression fn in
278 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
279 mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
280 | Ast0.Assignment(left,op,right,simple) ->
281 let left = expression left in
282 let right = expression right in
283 mkres e (Ast0.Assignment(left,op,right,simple)) left right
284 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
285 let exp1 = expression exp1 in
286 let exp2 = get_option expression exp2 in
287 let exp3 = expression exp3 in
288 mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
289 | Ast0.Postfix(exp,op) ->
290 let exp = expression exp in
291 mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
292 | Ast0.Infix(exp,op) ->
293 let exp = expression exp in
294 mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
295 | Ast0.Unary(exp,op) ->
296 let exp = expression exp in
297 mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
298 | Ast0.Binary(left,op,right) ->
299 let left = expression left in
300 let right = expression right in
301 mkres e (Ast0.Binary(left,op,right)) left right
302 | Ast0.Nested(left,op,right) ->
303 let left = expression left in
304 let right = expression right in
305 mkres e (Ast0.Nested(left,op,right)) left right
306 | Ast0.Paren(lp,exp,rp) ->
307 mkres e (Ast0.Paren(lp,expression exp,rp))
308 (promote_mcode lp) (promote_mcode rp)
309 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
310 let exp1 = expression exp1 in
311 let exp2 = expression exp2 in
312 mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
313 | Ast0.RecordAccess(exp,pt,field) ->
314 let exp = expression exp in
315 let field = ident field in
316 mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
317 | Ast0.RecordPtAccess(exp,ar,field) ->
318 let exp = expression exp in
319 let field = ident field in
320 mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
321 | Ast0.Cast(lp,ty,rp,exp) ->
322 let exp = expression exp in
323 mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
324 | Ast0.SizeOfExpr(szf,exp) ->
325 let exp = expression exp in
326 mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
327 | Ast0.SizeOfType(szf,lp,ty,rp) ->
faf9a90c 328 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
34e49164
C
329 (promote_mcode szf) (promote_mcode rp)
330 | Ast0.TypeExp(ty) ->
331 let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
332 | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
333 | Ast0.MetaExprList(name,_,_) as ue ->
334 let ln = promote_mcode name in mkres e ue ln ln
335 | Ast0.EComma(cm) ->
fc1ad971 336 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
337 let ln = promote_mcode cm in
338 mkres e (Ast0.EComma(cm)) ln ln
339 | Ast0.DisjExpr(starter,exps,mids,ender) ->
340 let starter = bad_mcode starter in
341 let exps = List.map expression exps in
342 let mids = List.map bad_mcode mids in
343 let ender = bad_mcode ender in
344 mkmultires e (Ast0.DisjExpr(starter,exps,mids,ender))
345 (promote_mcode starter) (promote_mcode ender)
346 (get_all_start_info exps) (get_all_end_info exps)
347 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
348 let exp_dots = dots is_exp_dots None expression exp_dots in
349 let starter = bad_mcode starter in
350 let ender = bad_mcode ender in
351 mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
352 (promote_mcode starter) (promote_mcode ender)
353 | Ast0.Edots(dots,whencode) ->
354 let dots = bad_mcode dots in
355 let ln = promote_mcode dots in
356 mkres e (Ast0.Edots(dots,whencode)) ln ln
357 | Ast0.Ecircles(dots,whencode) ->
358 let dots = bad_mcode dots in
359 let ln = promote_mcode dots in
360 mkres e (Ast0.Ecircles(dots,whencode)) ln ln
361 | Ast0.Estars(dots,whencode) ->
362 let dots = bad_mcode dots in
363 let ln = promote_mcode dots in
364 mkres e (Ast0.Estars(dots,whencode)) ln ln
365 | Ast0.OptExp(exp) ->
366 let exp = expression exp in
367 mkres e (Ast0.OptExp(exp)) exp exp
368 | Ast0.UniqueExp(exp) ->
369 let exp = expression exp in
370 mkres e (Ast0.UniqueExp(exp)) exp exp
371
372and expression_dots x = dots is_exp_dots None expression x
faf9a90c 373
34e49164
C
374(* --------------------------------------------------------------------- *)
375(* Types *)
faf9a90c 376
34e49164
C
377and typeC t =
378 match Ast0.unwrap t with
379 Ast0.ConstVol(cv,ty) ->
380 let ty = typeC ty in
381 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
faf9a90c
C
382 | Ast0.BaseType(ty,strings) as ut ->
383 let first = List.hd strings in
384 let last = List.hd (List.rev strings) in
385 mkres t ut (promote_mcode first) (promote_mcode last)
386 | Ast0.Signed(sgn,None) as ut ->
34e49164 387 mkres t ut (promote_mcode sgn) (promote_mcode sgn)
faf9a90c
C
388 | Ast0.Signed(sgn,Some ty) ->
389 let ty = typeC ty in
390 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
34e49164
C
391 | Ast0.Pointer(ty,star) ->
392 let ty = typeC ty in
393 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
394 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
395 let ty = typeC ty in
396 let params = parameter_list (Some(promote_mcode lp2)) params in
397 mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
398 ty (promote_mcode rp2)
399 | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
400 let ty = typeC ty in
401 let params = parameter_list (Some(promote_mcode lp1)) params in
402 let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
403 mkres t res ty (promote_mcode rp1)
404 | Ast0.FunctionType(None,lp1,params,rp1) ->
405 let params = parameter_list (Some(promote_mcode lp1)) params in
406 let res = Ast0.FunctionType(None,lp1,params,rp1) in
407 mkres t res (promote_mcode lp1) (promote_mcode rp1)
408 | Ast0.Array(ty,lb,size,rb) ->
409 let ty = typeC ty in
410 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
411 ty (promote_mcode rb)
faf9a90c
C
412 | Ast0.EnumName(kind,name) ->
413 let name = ident name in
414 mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name
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) ->
431 let starter = bad_mcode starter in
432 let types = List.map typeC types in
433 let mids = List.map bad_mcode mids in
434 let ender = bad_mcode ender in
435 mkmultires t (Ast0.DisjType(starter,types,mids,ender))
436 (promote_mcode starter) (promote_mcode ender)
437 (get_all_start_info types) (get_all_end_info types)
438 | Ast0.OptType(ty) ->
439 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
440 | Ast0.UniqueType(ty) ->
441 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
faf9a90c 442
34e49164
C
443(* --------------------------------------------------------------------- *)
444(* Variable declaration *)
445(* Even if the Cocci program specifies a list of declarations, they are
446 split out into multiple declarations of a single variable each. *)
447
448and is_decl_dots s =
449 match Ast0.unwrap s with
450 Ast0.Ddots(_,_) -> true
451 | _ -> false
faf9a90c 452
34e49164
C
453and declaration d =
454 match Ast0.unwrap d with
455 Ast0.Init(stg,ty,id,eq,exp,sem) ->
456 let ty = typeC ty in
457 let id = ident id in
458 let exp = initialiser exp in
459 (match stg with
460 None ->
461 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 462 | Some x ->
34e49164
C
463 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
464 (promote_mcode x) (promote_mcode sem))
465 | Ast0.UnInit(stg,ty,id,sem) ->
466 let ty = typeC ty in
467 let id = ident id in
468 (match stg with
469 None ->
470 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
471 | Some x ->
472 mkres d (Ast0.UnInit(stg,ty,id,sem))
473 (promote_mcode x) (promote_mcode sem))
474 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
475 let name = ident name in
476 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
477 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
478 | Ast0.TyDecl(ty,sem) ->
479 let ty = typeC ty in
480 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
481 | Ast0.Typedef(stg,ty,id,sem) ->
482 let ty = typeC ty in
483 let id = typeC id in
484 mkres d (Ast0.Typedef(stg,ty,id,sem))
485 (promote_mcode stg) (promote_mcode sem)
486 | Ast0.DisjDecl(starter,decls,mids,ender) ->
487 let starter = bad_mcode starter in
488 let decls = List.map declaration decls in
489 let mids = List.map bad_mcode mids in
490 let ender = bad_mcode ender in
491 mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
492 (promote_mcode starter) (promote_mcode ender)
493 (get_all_start_info decls) (get_all_end_info decls)
494 | Ast0.Ddots(dots,whencode) ->
495 let dots = bad_mcode dots in
496 let ln = promote_mcode dots in
497 mkres d (Ast0.Ddots(dots,whencode)) ln ln
498 | Ast0.OptDecl(decl) ->
499 let decl = declaration decl in
500 mkres d (Ast0.OptDecl(declaration decl)) decl decl
501 | Ast0.UniqueDecl(decl) ->
502 let decl = declaration decl in
503 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
504
505(* --------------------------------------------------------------------- *)
506(* Initializer *)
507
508and is_init_dots i =
509 match Ast0.unwrap i with
510 Ast0.Idots(_,_) -> true
511 | _ -> false
faf9a90c 512
34e49164
C
513and initialiser i =
514 match Ast0.unwrap i with
113803cf
C
515 Ast0.MetaInit(name,_) as ut ->
516 let ln = promote_mcode name in mkres i ut ln ln
517 | Ast0.InitExpr(exp) ->
34e49164
C
518 let exp = expression exp in
519 mkres i (Ast0.InitExpr(exp)) exp exp
520 | Ast0.InitList(lb,initlist,rb) ->
521 let initlist =
522 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
523 mkres i (Ast0.InitList(lb,initlist,rb))
524 (promote_mcode lb) (promote_mcode rb)
113803cf
C
525 | Ast0.InitGccExt(designators,eq,ini) ->
526 let (delims,designators) = (* non empty due to parsing *)
527 List.split (List.map designator designators) in
34e49164 528 let ini = initialiser ini in
113803cf
C
529 mkres i (Ast0.InitGccExt(designators,eq,ini))
530 (promote_mcode (List.hd delims)) ini
34e49164
C
531 | Ast0.InitGccName(name,eq,ini) ->
532 let name = ident name in
533 let ini = initialiser ini in
534 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
34e49164
C
535 | Ast0.IComma(cm) as up ->
536 let ln = promote_mcode cm in mkres i up ln ln
537 | Ast0.Idots(dots,whencode) ->
538 let dots = bad_mcode dots in
539 let ln = promote_mcode dots in
540 mkres i (Ast0.Idots(dots,whencode)) ln ln
541 | Ast0.OptIni(ini) ->
542 let ini = initialiser ini in
543 mkres i (Ast0.OptIni(ini)) ini ini
544 | Ast0.UniqueIni(ini) ->
545 let ini = initialiser ini in
546 mkres i (Ast0.UniqueIni(ini)) ini ini
547
113803cf
C
548and designator = function
549 Ast0.DesignatorField(dot,id) ->
550 (dot,Ast0.DesignatorField(dot,ident id))
551 | Ast0.DesignatorIndex(lb,exp,rb) ->
552 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
553 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
554 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
555
34e49164
C
556and initialiser_list prev = dots is_init_dots prev initialiser
557
558(* for export *)
559and initialiser_dots x = dots is_init_dots None initialiser x
560
561(* --------------------------------------------------------------------- *)
562(* Parameter *)
563
564and is_param_dots p =
565 match Ast0.unwrap p with
566 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
567 | _ -> false
faf9a90c 568
34e49164
C
569and parameterTypeDef p =
570 match Ast0.unwrap p with
571 Ast0.VoidParam(ty) ->
572 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
573 | Ast0.Param(ty,Some id) ->
574 let id = ident id in
575 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
576 | Ast0.Param(ty,None) ->
577 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
578 | Ast0.MetaParam(name,_) as up ->
579 let ln = promote_mcode name in mkres p up ln ln
580 | Ast0.MetaParamList(name,_,_) as up ->
581 let ln = promote_mcode name in mkres p up ln ln
582 | Ast0.PComma(cm) ->
fc1ad971 583 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
584 let ln = promote_mcode cm in
585 mkres p (Ast0.PComma(cm)) ln ln
586 | Ast0.Pdots(dots) ->
587 let dots = bad_mcode dots in
588 let ln = promote_mcode dots in
589 mkres p (Ast0.Pdots(dots)) ln ln
590 | Ast0.Pcircles(dots) ->
591 let dots = bad_mcode dots in
592 let ln = promote_mcode dots in
593 mkres p (Ast0.Pcircles(dots)) ln ln
594 | Ast0.OptParam(param) ->
595 let res = parameterTypeDef param in
596 mkres p (Ast0.OptParam(res)) res res
597 | Ast0.UniqueParam(param) ->
598 let res = parameterTypeDef param in
599 mkres p (Ast0.UniqueParam(res)) res res
600
601and parameter_list prev = dots is_param_dots prev parameterTypeDef
602
603(* for export *)
604let parameter_dots x = dots is_param_dots None parameterTypeDef x
605
7f004419
C
606(* --------------------------------------------------------------------- *)
607
608let is_define_param_dots s =
609 match Ast0.unwrap s with
610 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
611 | _ -> false
612
613let rec define_param p =
614 match Ast0.unwrap p with
615 Ast0.DParam(id) ->
616 let id = ident id in mkres p (Ast0.DParam(id)) id id
617 | Ast0.DPComma(cm) ->
618 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
619 let ln = promote_mcode cm in
620 mkres p (Ast0.DPComma(cm)) ln ln
621 | Ast0.DPdots(dots) ->
622 let dots = bad_mcode dots in
623 let ln = promote_mcode dots in
624 mkres p (Ast0.DPdots(dots)) ln ln
625 | Ast0.DPcircles(dots) ->
626 let dots = bad_mcode dots in
627 let ln = promote_mcode dots in
628 mkres p (Ast0.DPcircles(dots)) ln ln
629 | Ast0.OptDParam(dp) ->
630 let res = define_param dp in
631 mkres p (Ast0.OptDParam(res)) res res
632 | Ast0.UniqueDParam(dp) ->
633 let res = define_param dp in
634 mkres p (Ast0.UniqueDParam(res)) res res
635
5636bb2c 636let define_parameters x id =
7f004419 637 match Ast0.unwrap x with
5636bb2c 638 Ast0.NoParams -> (x,id) (* no info, should be ignored *)
7f004419
C
639 | Ast0.DParams(lp,dp,rp) ->
640 let dp = dots is_define_param_dots None define_param dp in
641 let l = promote_mcode lp in
642 let r = promote_mcode rp in
5636bb2c 643 (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
7f004419 644
34e49164
C
645(* --------------------------------------------------------------------- *)
646(* Top-level code *)
647
648let is_stm_dots s =
649 match Ast0.unwrap s with
650 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
651 | _ -> false
faf9a90c 652
34e49164
C
653let rec statement s =
654 let res =
655 match Ast0.unwrap s with
656 Ast0.Decl((_,bef),decl) ->
657 let decl = declaration decl in
658 let left = promote_to_statement_start decl bef in
659 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
faf9a90c 660 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164
C
661 let body =
662 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
663 mkres s (Ast0.Seq(lbrace,body,rbrace))
664 (promote_mcode lbrace) (promote_mcode rbrace)
665 | Ast0.ExprStatement(exp,sem) ->
666 let exp = expression exp in
667 mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
668 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
669 let exp = expression exp in
670 let branch = statement branch in
671 let right = promote_to_statement branch aft in
672 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
673 (promote_mcode iff) right
674 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
675 let exp = expression exp in
676 let branch1 = statement branch1 in
677 let branch2 = statement branch2 in
678 let right = promote_to_statement branch2 aft in
679 mkres s
680 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
681 (Ast0.get_info right,aft)))
682 (promote_mcode iff) right
683 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
684 let exp = expression exp in
685 let body = statement body in
686 let right = promote_to_statement body aft in
687 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
688 (promote_mcode wh) right
689 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
690 let body = statement body in
691 let exp = expression exp in
692 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
693 (promote_mcode d) (promote_mcode sem)
694 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
695 let exp1 = get_option expression exp1 in
696 let exp2 = get_option expression exp2 in
697 let exp3 = get_option expression exp3 in
698 let body = statement body in
699 let right = promote_to_statement body aft in
700 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
701 (Ast0.get_info right,aft)))
702 (promote_mcode fr) right
703 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
704 let nm = ident nm in
705 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
706 let body = statement body in
707 let right = promote_to_statement body aft in
708 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
709 nm right
fc1ad971 710 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 711 let exp = expression exp in
fc1ad971
C
712 let decls =
713 dots is_stm_dots (Some(promote_mcode lb))
714 statement decls in
34e49164 715 let cases =
fc1ad971
C
716 dots (function _ -> false)
717 (if Ast0.undots decls = []
718 then (Some(promote_mcode lb))
719 else None (* not sure this is right, but not sure the case can
720 arise either *))
721 case_line cases in
34e49164 722 mkres s
fc1ad971 723 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164
C
724 (promote_mcode switch) (promote_mcode rb)
725 | Ast0.Break(br,sem) as us ->
726 mkres s us (promote_mcode br) (promote_mcode sem)
727 | Ast0.Continue(cont,sem) as us ->
728 mkres s us (promote_mcode cont) (promote_mcode sem)
729 | Ast0.Label(l,dd) ->
730 let l = ident l in
731 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
732 | Ast0.Goto(goto,id,sem) ->
733 let id = ident id in
faf9a90c 734 mkres s (Ast0.Goto(goto,id,sem))
34e49164
C
735 (promote_mcode goto) (promote_mcode sem)
736 | Ast0.Return(ret,sem) as us ->
737 mkres s us (promote_mcode ret) (promote_mcode sem)
738 | Ast0.ReturnExpr(ret,exp,sem) ->
739 let exp = expression exp in
faf9a90c 740 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164
C
741 (promote_mcode ret) (promote_mcode sem)
742 | Ast0.MetaStmt(name,_)
743 | Ast0.MetaStmtList(name,_) as us ->
744 let ln = promote_mcode name in mkres s us ln ln
745 | Ast0.Exp(exp) ->
746 let exp = expression exp in
747 mkres s (Ast0.Exp(exp)) exp exp
748 | Ast0.TopExp(exp) ->
749 let exp = expression exp in
750 mkres s (Ast0.TopExp(exp)) exp exp
751 | Ast0.Ty(ty) ->
752 let ty = typeC ty in
753 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
754 | Ast0.TopInit(init) ->
755 let init = initialiser init in
756 mkres s (Ast0.TopInit(init)) init init
34e49164
C
757 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
758 let starter = bad_mcode starter in
759 let mids = List.map bad_mcode mids in
760 let ender = bad_mcode ender in
761 let rec loop prevs = function
762 [] -> []
763 | stm::stms ->
764 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
765 statement stm)::
766 (loop (List.tl prevs) stms) in
767 let elems = loop (starter::mids) rule_elem_dots_list in
768 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
769 (promote_mcode starter) (promote_mcode ender)
770 (get_all_start_info elems) (get_all_end_info elems)
771 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
772 let starter = bad_mcode starter in
773 let ender = bad_mcode ender in
5636bb2c
C
774 let wrapper f =
775 match Ast0.get_mcode_mcodekind starter with
776 Ast0.MINUS _ ->
777 (* if minus, then all nest code has to be minus. This is
778 checked at the token level, in parse_cocci.ml. All nest code
779 is also unattachable. We strip the minus annotations from
780 the nest code because in the CTL another metavariable will
781 take care of removing all the code matched by the nest.
782 Without stripping the minus annotations, we would get a
783 double transformation. Perhaps there is a more elegant
784 way to do this in the CTL, but it is not easy, because of
785 the interaction with the whencode and the implementation of
786 plus *)
787 in_nest_count := !in_nest_count + 1;
788 let res = f() in
789 in_nest_count := !in_nest_count - 1;
790 res
791 | _ -> f() in
792 let rule_elem_dots =
793 wrapper
794 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
795 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
796 (promote_mcode starter) (promote_mcode ender)
797 | Ast0.Dots(dots,whencode) ->
798 let dots = bad_mcode dots in
799 let ln = promote_mcode dots in
800 mkres s (Ast0.Dots(dots,whencode)) ln ln
801 | Ast0.Circles(dots,whencode) ->
802 let dots = bad_mcode dots in
803 let ln = promote_mcode dots in
804 mkres s (Ast0.Circles(dots,whencode)) ln ln
805 | Ast0.Stars(dots,whencode) ->
806 let dots = bad_mcode dots in
807 let ln = promote_mcode dots in
808 mkres s (Ast0.Stars(dots,whencode)) ln ln
809 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
810 let fninfo =
811 List.map
812 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
813 fninfo in
814 let name = ident name in
815 let params = parameter_list (Some(promote_mcode lp)) params in
816 let body =
817 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
818 let left =
819 (* cases on what is leftmost *)
820 match fninfo with
821 [] -> promote_to_statement_start name bef
822 | Ast0.FStorage(stg)::_ ->
823 promote_to_statement_start (promote_mcode stg) bef
824 | Ast0.FType(ty)::_ ->
825 promote_to_statement_start ty bef
826 | Ast0.FInline(inline)::_ ->
827 promote_to_statement_start (promote_mcode inline) bef
828 | Ast0.FAttr(attr)::_ ->
829 promote_to_statement_start (promote_mcode attr) bef in
830 (* pretend it is one line before the start of the function, so that it
831 will catch things defined at top level. We assume that these will not
832 be defined on the same line as the function. This is a HACK.
833 A better approach would be to attach top_level things to this node,
834 and other things to the node after, but that would complicate
835 insert_plus, which doesn't distinguish between different mcodekinds *)
836 let res =
837 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
838 body,rbrace) in
839 (* have to do this test again, because of typing problems - can't save
840 the result, only use it *)
841 (match fninfo with
842 [] -> mkres s res name (promote_mcode rbrace)
843 | Ast0.FStorage(stg)::_ ->
844 mkres s res (promote_mcode stg) (promote_mcode rbrace)
845 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
846 | Ast0.FInline(inline)::_ ->
847 mkres s res (promote_mcode inline) (promote_mcode rbrace)
848 | Ast0.FAttr(attr)::_ ->
849 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 850
34e49164
C
851 | Ast0.Include(inc,stm) ->
852 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
853 | Ast0.Define(def,id,params,body) ->
5636bb2c
C
854 let (id,right) = full_ident id in
855 let (params,prev) = define_parameters params right in
856 let body = dots is_stm_dots (Some prev) statement body in
34e49164
C
857 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
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
C
879 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
880 let starter = bad_mcode starter in
881 let case_lines = List.map case_line case_lines in
882 let mids = List.map bad_mcode mids in
883 let ender = bad_mcode ender in
884 mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender))
885 (promote_mcode starter) (promote_mcode ender)
886 (get_all_start_info case_lines) (get_all_end_info case_lines)
34e49164
C
887 | Ast0.OptCase(case) ->
888 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
889
890and statement_dots x = dots is_stm_dots None statement x
faf9a90c 891
34e49164
C
892(* --------------------------------------------------------------------- *)
893(* Function declaration *)
faf9a90c 894
34e49164
C
895let top_level t =
896 match Ast0.unwrap t with
897 Ast0.FILEINFO(old_file,new_file) -> t
898 | Ast0.DECL(stmt) ->
899 let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
900 | Ast0.CODE(rule_elem_dots) ->
901 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
902 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
903 | Ast0.ERRORWORDS(exps) -> t
904 | Ast0.OTHER(_) -> failwith "eliminated by top_level"
faf9a90c 905
34e49164
C
906(* --------------------------------------------------------------------- *)
907(* Entry points *)
faf9a90c 908
978fd7e5 909let compute_lines attachable_or x =
5636bb2c 910 in_nest_count := 0;
978fd7e5
C
911 inherit_attachable := attachable_or;
912 List.map top_level x
913
914let compute_statement_lines attachable_or x =
5636bb2c 915 in_nest_count := 0;
978fd7e5
C
916 inherit_attachable := attachable_or;
917 statement x
918
919let compute_statement_dots_lines attachable_or x =
5636bb2c 920 in_nest_count := 0;
978fd7e5
C
921 inherit_attachable := attachable_or;
922 statement_dots x
faf9a90c 923