Release coccinelle-0.2.3
[bpt/coccinelle.git] / parsing_cocci / compute_lines.ml
CommitLineData
9f8e26f4 1(*
90aeb998
C
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
5636bb2c
C
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)
faf9a90c
C
392 | Ast0.EnumName(kind,name) ->
393 let name = ident name in
394 mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name
34e49164
C
395 | Ast0.StructUnionName(kind,Some name) ->
396 let name = ident name in
397 mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
398 | Ast0.StructUnionName(kind,None) ->
399 let mc = promote_mcode kind in
400 mkres t (Ast0.StructUnionName(kind,None)) mc mc
401 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
402 let ty = typeC ty in
403 let decls =
404 dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
405 mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
406 | Ast0.TypeName(name) as ut ->
407 let ln = promote_mcode name in mkres t ut ln ln
408 | Ast0.MetaType(name,_) as ut ->
409 let ln = promote_mcode name in mkres t ut ln ln
410 | Ast0.DisjType(starter,types,mids,ender) ->
411 let starter = bad_mcode starter in
412 let types = List.map typeC types in
413 let mids = List.map bad_mcode mids in
414 let ender = bad_mcode ender in
415 mkmultires t (Ast0.DisjType(starter,types,mids,ender))
416 (promote_mcode starter) (promote_mcode ender)
417 (get_all_start_info types) (get_all_end_info types)
418 | Ast0.OptType(ty) ->
419 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
420 | Ast0.UniqueType(ty) ->
421 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
faf9a90c 422
34e49164
C
423(* --------------------------------------------------------------------- *)
424(* Variable declaration *)
425(* Even if the Cocci program specifies a list of declarations, they are
426 split out into multiple declarations of a single variable each. *)
427
428and is_decl_dots s =
429 match Ast0.unwrap s with
430 Ast0.Ddots(_,_) -> true
431 | _ -> false
faf9a90c 432
34e49164
C
433and declaration d =
434 match Ast0.unwrap d with
435 Ast0.Init(stg,ty,id,eq,exp,sem) ->
436 let ty = typeC ty in
437 let id = ident id in
438 let exp = initialiser exp in
439 (match stg with
440 None ->
441 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 442 | Some x ->
34e49164
C
443 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
444 (promote_mcode x) (promote_mcode sem))
445 | Ast0.UnInit(stg,ty,id,sem) ->
446 let ty = typeC ty in
447 let id = ident id in
448 (match stg with
449 None ->
450 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
451 | Some x ->
452 mkres d (Ast0.UnInit(stg,ty,id,sem))
453 (promote_mcode x) (promote_mcode sem))
454 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
455 let name = ident name in
456 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
457 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
458 | Ast0.TyDecl(ty,sem) ->
459 let ty = typeC ty in
460 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
461 | Ast0.Typedef(stg,ty,id,sem) ->
462 let ty = typeC ty in
463 let id = typeC id in
464 mkres d (Ast0.Typedef(stg,ty,id,sem))
465 (promote_mcode stg) (promote_mcode sem)
466 | Ast0.DisjDecl(starter,decls,mids,ender) ->
467 let starter = bad_mcode starter in
468 let decls = List.map declaration decls in
469 let mids = List.map bad_mcode mids in
470 let ender = bad_mcode ender in
471 mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
472 (promote_mcode starter) (promote_mcode ender)
473 (get_all_start_info decls) (get_all_end_info decls)
474 | Ast0.Ddots(dots,whencode) ->
475 let dots = bad_mcode dots in
476 let ln = promote_mcode dots in
477 mkres d (Ast0.Ddots(dots,whencode)) ln ln
478 | Ast0.OptDecl(decl) ->
479 let decl = declaration decl in
480 mkres d (Ast0.OptDecl(declaration decl)) decl decl
481 | Ast0.UniqueDecl(decl) ->
482 let decl = declaration decl in
483 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
484
485(* --------------------------------------------------------------------- *)
486(* Initializer *)
487
488and is_init_dots i =
489 match Ast0.unwrap i with
490 Ast0.Idots(_,_) -> true
491 | _ -> false
faf9a90c 492
34e49164
C
493and initialiser i =
494 match Ast0.unwrap i with
113803cf
C
495 Ast0.MetaInit(name,_) as ut ->
496 let ln = promote_mcode name in mkres i ut ln ln
497 | Ast0.InitExpr(exp) ->
34e49164
C
498 let exp = expression exp in
499 mkres i (Ast0.InitExpr(exp)) exp exp
500 | Ast0.InitList(lb,initlist,rb) ->
501 let initlist =
502 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
503 mkres i (Ast0.InitList(lb,initlist,rb))
504 (promote_mcode lb) (promote_mcode rb)
113803cf
C
505 | Ast0.InitGccExt(designators,eq,ini) ->
506 let (delims,designators) = (* non empty due to parsing *)
507 List.split (List.map designator designators) in
34e49164 508 let ini = initialiser ini in
113803cf
C
509 mkres i (Ast0.InitGccExt(designators,eq,ini))
510 (promote_mcode (List.hd delims)) ini
34e49164
C
511 | Ast0.InitGccName(name,eq,ini) ->
512 let name = ident name in
513 let ini = initialiser ini in
514 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
34e49164
C
515 | Ast0.IComma(cm) as up ->
516 let ln = promote_mcode cm in mkres i up ln ln
517 | Ast0.Idots(dots,whencode) ->
518 let dots = bad_mcode dots in
519 let ln = promote_mcode dots in
520 mkres i (Ast0.Idots(dots,whencode)) ln ln
521 | Ast0.OptIni(ini) ->
522 let ini = initialiser ini in
523 mkres i (Ast0.OptIni(ini)) ini ini
524 | Ast0.UniqueIni(ini) ->
525 let ini = initialiser ini in
526 mkres i (Ast0.UniqueIni(ini)) ini ini
527
113803cf
C
528and designator = function
529 Ast0.DesignatorField(dot,id) ->
530 (dot,Ast0.DesignatorField(dot,ident id))
531 | Ast0.DesignatorIndex(lb,exp,rb) ->
532 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
533 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
534 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
535
34e49164
C
536and initialiser_list prev = dots is_init_dots prev initialiser
537
538(* for export *)
539and initialiser_dots x = dots is_init_dots None initialiser x
540
541(* --------------------------------------------------------------------- *)
542(* Parameter *)
543
544and is_param_dots p =
545 match Ast0.unwrap p with
546 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
547 | _ -> false
faf9a90c 548
34e49164
C
549and parameterTypeDef p =
550 match Ast0.unwrap p with
551 Ast0.VoidParam(ty) ->
552 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
553 | Ast0.Param(ty,Some id) ->
554 let id = ident id in
555 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
556 | Ast0.Param(ty,None) ->
557 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
558 | Ast0.MetaParam(name,_) as up ->
559 let ln = promote_mcode name in mkres p up ln ln
560 | Ast0.MetaParamList(name,_,_) as up ->
561 let ln = promote_mcode name in mkres p up ln ln
562 | Ast0.PComma(cm) ->
fc1ad971 563 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
564 let ln = promote_mcode cm in
565 mkres p (Ast0.PComma(cm)) ln ln
566 | Ast0.Pdots(dots) ->
567 let dots = bad_mcode dots in
568 let ln = promote_mcode dots in
569 mkres p (Ast0.Pdots(dots)) ln ln
570 | Ast0.Pcircles(dots) ->
571 let dots = bad_mcode dots in
572 let ln = promote_mcode dots in
573 mkres p (Ast0.Pcircles(dots)) ln ln
574 | Ast0.OptParam(param) ->
575 let res = parameterTypeDef param in
576 mkres p (Ast0.OptParam(res)) res res
577 | Ast0.UniqueParam(param) ->
578 let res = parameterTypeDef param in
579 mkres p (Ast0.UniqueParam(res)) res res
580
581and parameter_list prev = dots is_param_dots prev parameterTypeDef
582
583(* for export *)
584let parameter_dots x = dots is_param_dots None parameterTypeDef x
585
7f004419
C
586(* --------------------------------------------------------------------- *)
587
588let is_define_param_dots s =
589 match Ast0.unwrap s with
590 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
591 | _ -> false
592
593let rec define_param p =
594 match Ast0.unwrap p with
595 Ast0.DParam(id) ->
596 let id = ident id in mkres p (Ast0.DParam(id)) id id
597 | Ast0.DPComma(cm) ->
598 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
599 let ln = promote_mcode cm in
600 mkres p (Ast0.DPComma(cm)) ln ln
601 | Ast0.DPdots(dots) ->
602 let dots = bad_mcode dots in
603 let ln = promote_mcode dots in
604 mkres p (Ast0.DPdots(dots)) ln ln
605 | Ast0.DPcircles(dots) ->
606 let dots = bad_mcode dots in
607 let ln = promote_mcode dots in
608 mkres p (Ast0.DPcircles(dots)) ln ln
609 | Ast0.OptDParam(dp) ->
610 let res = define_param dp in
611 mkres p (Ast0.OptDParam(res)) res res
612 | Ast0.UniqueDParam(dp) ->
613 let res = define_param dp in
614 mkres p (Ast0.UniqueDParam(res)) res res
615
5636bb2c 616let define_parameters x id =
7f004419 617 match Ast0.unwrap x with
5636bb2c 618 Ast0.NoParams -> (x,id) (* no info, should be ignored *)
7f004419
C
619 | Ast0.DParams(lp,dp,rp) ->
620 let dp = dots is_define_param_dots None define_param dp in
621 let l = promote_mcode lp in
622 let r = promote_mcode rp in
5636bb2c 623 (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
7f004419 624
34e49164
C
625(* --------------------------------------------------------------------- *)
626(* Top-level code *)
627
628let is_stm_dots s =
629 match Ast0.unwrap s with
630 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
631 | _ -> false
faf9a90c 632
34e49164
C
633let rec statement s =
634 let res =
635 match Ast0.unwrap s with
636 Ast0.Decl((_,bef),decl) ->
637 let decl = declaration decl in
638 let left = promote_to_statement_start decl bef in
639 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
faf9a90c 640 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164
C
641 let body =
642 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
643 mkres s (Ast0.Seq(lbrace,body,rbrace))
644 (promote_mcode lbrace) (promote_mcode rbrace)
645 | Ast0.ExprStatement(exp,sem) ->
646 let exp = expression exp in
647 mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
648 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
649 let exp = expression exp in
650 let branch = statement branch in
651 let right = promote_to_statement branch aft in
652 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
653 (promote_mcode iff) right
654 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
655 let exp = expression exp in
656 let branch1 = statement branch1 in
657 let branch2 = statement branch2 in
658 let right = promote_to_statement branch2 aft in
659 mkres s
660 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
661 (Ast0.get_info right,aft)))
662 (promote_mcode iff) right
663 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
664 let exp = expression exp in
665 let body = statement body in
666 let right = promote_to_statement body aft in
667 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
668 (promote_mcode wh) right
669 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
670 let body = statement body in
671 let exp = expression exp in
672 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
673 (promote_mcode d) (promote_mcode sem)
674 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
675 let exp1 = get_option expression exp1 in
676 let exp2 = get_option expression exp2 in
677 let exp3 = get_option expression exp3 in
678 let body = statement body in
679 let right = promote_to_statement body aft in
680 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
681 (Ast0.get_info right,aft)))
682 (promote_mcode fr) right
683 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
684 let nm = ident nm in
685 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
686 let body = statement body in
687 let right = promote_to_statement body aft in
688 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
689 nm right
fc1ad971 690 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 691 let exp = expression exp in
fc1ad971
C
692 let decls =
693 dots is_stm_dots (Some(promote_mcode lb))
694 statement decls in
34e49164 695 let cases =
fc1ad971
C
696 dots (function _ -> false)
697 (if Ast0.undots decls = []
698 then (Some(promote_mcode lb))
699 else None (* not sure this is right, but not sure the case can
700 arise either *))
701 case_line cases in
34e49164 702 mkres s
fc1ad971 703 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164
C
704 (promote_mcode switch) (promote_mcode rb)
705 | Ast0.Break(br,sem) as us ->
706 mkres s us (promote_mcode br) (promote_mcode sem)
707 | Ast0.Continue(cont,sem) as us ->
708 mkres s us (promote_mcode cont) (promote_mcode sem)
709 | Ast0.Label(l,dd) ->
710 let l = ident l in
711 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
712 | Ast0.Goto(goto,id,sem) ->
713 let id = ident id in
faf9a90c 714 mkres s (Ast0.Goto(goto,id,sem))
34e49164
C
715 (promote_mcode goto) (promote_mcode sem)
716 | Ast0.Return(ret,sem) as us ->
717 mkres s us (promote_mcode ret) (promote_mcode sem)
718 | Ast0.ReturnExpr(ret,exp,sem) ->
719 let exp = expression exp in
faf9a90c 720 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164
C
721 (promote_mcode ret) (promote_mcode sem)
722 | Ast0.MetaStmt(name,_)
723 | Ast0.MetaStmtList(name,_) as us ->
724 let ln = promote_mcode name in mkres s us ln ln
725 | Ast0.Exp(exp) ->
726 let exp = expression exp in
727 mkres s (Ast0.Exp(exp)) exp exp
728 | Ast0.TopExp(exp) ->
729 let exp = expression exp in
730 mkres s (Ast0.TopExp(exp)) exp exp
731 | Ast0.Ty(ty) ->
732 let ty = typeC ty in
733 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
734 | Ast0.TopInit(init) ->
735 let init = initialiser init in
736 mkres s (Ast0.TopInit(init)) init init
34e49164
C
737 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
738 let starter = bad_mcode starter in
739 let mids = List.map bad_mcode mids in
740 let ender = bad_mcode ender in
741 let rec loop prevs = function
742 [] -> []
743 | stm::stms ->
744 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
745 statement stm)::
746 (loop (List.tl prevs) stms) in
747 let elems = loop (starter::mids) rule_elem_dots_list in
748 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
749 (promote_mcode starter) (promote_mcode ender)
750 (get_all_start_info elems) (get_all_end_info elems)
751 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
752 let starter = bad_mcode starter in
753 let ender = bad_mcode ender in
5636bb2c
C
754 let wrapper f =
755 match Ast0.get_mcode_mcodekind starter with
756 Ast0.MINUS _ ->
757 (* if minus, then all nest code has to be minus. This is
758 checked at the token level, in parse_cocci.ml. All nest code
759 is also unattachable. We strip the minus annotations from
760 the nest code because in the CTL another metavariable will
761 take care of removing all the code matched by the nest.
762 Without stripping the minus annotations, we would get a
763 double transformation. Perhaps there is a more elegant
764 way to do this in the CTL, but it is not easy, because of
765 the interaction with the whencode and the implementation of
766 plus *)
767 in_nest_count := !in_nest_count + 1;
768 let res = f() in
769 in_nest_count := !in_nest_count - 1;
770 res
771 | _ -> f() in
772 let rule_elem_dots =
773 wrapper
774 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
775 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
776 (promote_mcode starter) (promote_mcode ender)
777 | Ast0.Dots(dots,whencode) ->
778 let dots = bad_mcode dots in
779 let ln = promote_mcode dots in
780 mkres s (Ast0.Dots(dots,whencode)) ln ln
781 | Ast0.Circles(dots,whencode) ->
782 let dots = bad_mcode dots in
783 let ln = promote_mcode dots in
784 mkres s (Ast0.Circles(dots,whencode)) ln ln
785 | Ast0.Stars(dots,whencode) ->
786 let dots = bad_mcode dots in
787 let ln = promote_mcode dots in
788 mkres s (Ast0.Stars(dots,whencode)) ln ln
789 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
790 let fninfo =
791 List.map
792 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
793 fninfo in
794 let name = ident name in
795 let params = parameter_list (Some(promote_mcode lp)) params in
796 let body =
797 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
798 let left =
799 (* cases on what is leftmost *)
800 match fninfo with
801 [] -> promote_to_statement_start name bef
802 | Ast0.FStorage(stg)::_ ->
803 promote_to_statement_start (promote_mcode stg) bef
804 | Ast0.FType(ty)::_ ->
805 promote_to_statement_start ty bef
806 | Ast0.FInline(inline)::_ ->
807 promote_to_statement_start (promote_mcode inline) bef
808 | Ast0.FAttr(attr)::_ ->
809 promote_to_statement_start (promote_mcode attr) bef in
810 (* pretend it is one line before the start of the function, so that it
811 will catch things defined at top level. We assume that these will not
812 be defined on the same line as the function. This is a HACK.
813 A better approach would be to attach top_level things to this node,
814 and other things to the node after, but that would complicate
815 insert_plus, which doesn't distinguish between different mcodekinds *)
816 let res =
817 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
818 body,rbrace) in
819 (* have to do this test again, because of typing problems - can't save
820 the result, only use it *)
821 (match fninfo with
822 [] -> mkres s res name (promote_mcode rbrace)
823 | Ast0.FStorage(stg)::_ ->
824 mkres s res (promote_mcode stg) (promote_mcode rbrace)
825 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
826 | Ast0.FInline(inline)::_ ->
827 mkres s res (promote_mcode inline) (promote_mcode rbrace)
828 | Ast0.FAttr(attr)::_ ->
829 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 830
34e49164
C
831 | Ast0.Include(inc,stm) ->
832 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
833 | Ast0.Define(def,id,params,body) ->
5636bb2c
C
834 let (id,right) = full_ident id in
835 let (params,prev) = define_parameters params right in
836 let body = dots is_stm_dots (Some prev) statement body in
34e49164
C
837 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
838 | Ast0.OptStm(stm) ->
839 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
840 | Ast0.UniqueStm(stm) ->
841 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
842 Ast0.set_dots_bef_aft res
843 (match Ast0.get_dots_bef_aft res with
844 Ast0.NoDots -> Ast0.NoDots
845 | Ast0.AddingBetweenDots s ->
846 Ast0.AddingBetweenDots(statement s)
847 | Ast0.DroppingBetweenDots s ->
848 Ast0.DroppingBetweenDots(statement s))
849
850and case_line c =
851 match Ast0.unwrap c with
852 Ast0.Default(def,colon,code) ->
853 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
854 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
855 | Ast0.Case(case,exp,colon,code) ->
856 let exp = expression exp in
857 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
858 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
fc1ad971
C
859 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
860 let starter = bad_mcode starter in
861 let case_lines = List.map case_line case_lines in
862 let mids = List.map bad_mcode mids in
863 let ender = bad_mcode ender in
864 mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender))
865 (promote_mcode starter) (promote_mcode ender)
866 (get_all_start_info case_lines) (get_all_end_info case_lines)
34e49164
C
867 | Ast0.OptCase(case) ->
868 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
869
870and statement_dots x = dots is_stm_dots None statement x
faf9a90c 871
34e49164
C
872(* --------------------------------------------------------------------- *)
873(* Function declaration *)
faf9a90c 874
34e49164
C
875let top_level t =
876 match Ast0.unwrap t with
877 Ast0.FILEINFO(old_file,new_file) -> t
878 | Ast0.DECL(stmt) ->
879 let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
880 | Ast0.CODE(rule_elem_dots) ->
881 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
882 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
883 | Ast0.ERRORWORDS(exps) -> t
884 | Ast0.OTHER(_) -> failwith "eliminated by top_level"
faf9a90c 885
34e49164
C
886(* --------------------------------------------------------------------- *)
887(* Entry points *)
faf9a90c 888
978fd7e5 889let compute_lines attachable_or x =
5636bb2c 890 in_nest_count := 0;
978fd7e5
C
891 inherit_attachable := attachable_or;
892 List.map top_level x
893
894let compute_statement_lines attachable_or x =
5636bb2c 895 in_nest_count := 0;
978fd7e5
C
896 inherit_attachable := attachable_or;
897 statement x
898
899let compute_statement_dots_lines attachable_or x =
5636bb2c 900 in_nest_count := 0;
978fd7e5
C
901 inherit_attachable := attachable_or;
902 statement_dots x
faf9a90c 903