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