Coccinelle release 1.0.0-rc3
[bpt/coccinelle.git] / parsing_cocci / compute_lines.ml
CommitLineData
f537ebc4
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;
8babbc8f 52 (* not clear that the next two lines serve any purpose *)
5636bb2c
C
53 Ast0.attachable_start = check_attachable lstart.Ast0.attachable_start;
54 Ast0.attachable_end = check_attachable lend.Ast0.attachable_end;
34e49164
C
55 Ast0.mcode_start = lstart.Ast0.mcode_start;
56 Ast0.mcode_end = lend.Ast0.mcode_end;
34e49164 57 (* only for tokens, not inherited upwards *)
0708f913 58 Ast0.strings_before = []; Ast0.strings_after = [] } in
34e49164
C
59 {x with Ast0.node = e; Ast0.info = info}
60
978fd7e5
C
61(* This looks like it is there to allow distribution of plus code
62over disjunctions. But this doesn't work with single_statement, as the
63plus code has not been distributed to the place that it expects. So the
64only reasonably easy solution seems to be to disallow distribution. *)
65(* inherit attachable is because single_statement doesn't work well when +
66code is attached outside an or, but this has to be allowed after
67isomorphisms have been introduced. So only set it to true then, or when we
68know that the code involved cannot contain a statement, ie it is a
69declaration. *)
70let inherit_attachable = ref false
34e49164
C
71let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) =
72 let lstart = Ast0.get_info left in
73 let lend = Ast0.get_info right in
0708f913
C
74 let pos_info =
75 { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
76 Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
77 Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
78 Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
79 Ast0.column = lstart.Ast0.pos_info.Ast0.column;
80 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in
34e49164 81 let info =
0708f913 82 { Ast0.pos_info = pos_info;
5636bb2c
C
83 Ast0.attachable_start =
84 check_attachable (if !inherit_attachable then astart else false);
85 Ast0.attachable_end =
86 check_attachable (if !inherit_attachable then aend else false);
34e49164
C
87 Ast0.mcode_start = start_mcodes;
88 Ast0.mcode_end = end_mcodes;
34e49164
C
89 (* only for tokens, not inherited upwards *)
90 Ast0.strings_before = []; Ast0.strings_after = [] } in
91 {x with Ast0.node = e; Ast0.info = info}
92
93(* --------------------------------------------------------------------- *)
faf9a90c 94
34e49164
C
95let get_option fn = function
96 None -> None
97 | Some x -> Some (fn x)
faf9a90c 98
34e49164
C
99(* --------------------------------------------------------------------- *)
100(* --------------------------------------------------------------------- *)
101(* Mcode *)
102
708f4980 103let promote_mcode (_,_,info,mcodekind,_,_) =
34e49164
C
104 let new_info =
105 {info with
106 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
107 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
108
708f4980 109let promote_mcode_plus_one (_,_,info,mcodekind,_,_) =
ae4735db 110 let new_pos_info =
0708f913
C
111 {info.Ast0.pos_info with
112 Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1;
113 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1;
114 Ast0.line_end = info.Ast0.pos_info.Ast0.line_end + 1;
115 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_end + 1; } in
34e49164
C
116 let new_info =
117 {info with
0708f913 118 Ast0.pos_info = new_pos_info;
34e49164
C
119 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
120 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
121
122let promote_to_statement stm mcodekind =
123 let info = Ast0.get_info stm in
0708f913
C
124 let new_pos_info =
125 {info.Ast0.pos_info with
126 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_end;
127 Ast0.line_start = info.Ast0.pos_info.Ast0.line_end; } in
34e49164
C
128 let new_info =
129 {info with
0708f913 130 Ast0.pos_info = new_pos_info;
34e49164 131 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
132 Ast0.attachable_start = check_attachable true;
133 Ast0.attachable_end = check_attachable true} in
34e49164
C
134 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
135
136let promote_to_statement_start stm mcodekind =
137 let info = Ast0.get_info stm in
0708f913
C
138 let new_pos_info =
139 {info.Ast0.pos_info with
140 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_start;
141 Ast0.line_end = info.Ast0.pos_info.Ast0.line_start; } in
34e49164
C
142 let new_info =
143 {info with
0708f913 144 Ast0.pos_info = new_pos_info;
34e49164 145 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
5636bb2c
C
146 Ast0.attachable_start = check_attachable true;
147 Ast0.attachable_end = check_attachable true} in
34e49164
C
148 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
149
150(* mcode is good by default *)
708f4980 151let bad_mcode (t,a,info,mcodekind,pos,adj) =
34e49164 152 let new_info =
5636bb2c
C
153 {info with
154 Ast0.attachable_start = check_attachable false;
155 Ast0.attachable_end = check_attachable false} in
708f4980 156 (t,a,new_info,mcodekind,pos,adj)
34e49164 157
8babbc8f
C
158let normal_mcode (t,a,info,mcodekind,pos,adj) =
159 let new_info =
160 if !in_nest_count > 0
161 then
162 {info with
163 Ast0.attachable_start = check_attachable false;
164 Ast0.attachable_end = check_attachable false}
165 else info in
166 (t,a,new_info,mcodekind,pos,adj)
167
34e49164
C
168let get_all_start_info l =
169 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l,
170 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l))
171
172let get_all_end_info l =
173 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l,
174 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l))
175
176(* --------------------------------------------------------------------- *)
177(* Dots *)
178
179(* for the logline classification and the mcode field, on both sides, skip
180over initial minus dots, as they don't contribute anything *)
181let dot_list is_dots fn = function
182 [] -> failwith "dots should not be empty"
183 | l ->
184 let get_node l fn =
185 let first = List.hd l in
186 let chosen =
187 match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in
188 (* get the logline decorator and the mcodekind of the chosen node *)
189 fn (Ast0.get_info chosen) in
190 let forward = List.map fn l in
191 let backward = List.rev forward in
192 let (first_attachable,first_mcode) =
193 get_node forward
194 (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
195 let (last_attachable,last_mcode) =
196 get_node backward
197 (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in
198 let first = List.hd forward in
199 let last = List.hd backward in
200 let first_info =
201 { (Ast0.get_info first) with
5636bb2c 202 Ast0.attachable_start = check_attachable first_attachable;
34e49164
C
203 Ast0.mcode_start = first_mcode } in
204 let last_info =
205 { (Ast0.get_info last) with
5636bb2c 206 Ast0.attachable_end = check_attachable last_attachable;
34e49164
C
207 Ast0.mcode_end = last_mcode } in
208 let first = Ast0.set_info first first_info in
209 let last = Ast0.set_info last last_info in
210 (forward,first,last)
faf9a90c 211
34e49164
C
212let dots is_dots prev fn d =
213 match (prev,Ast0.unwrap d) with
214 (Some prev,Ast0.DOTS([])) ->
215 mkres d (Ast0.DOTS []) prev prev
216 | (None,Ast0.DOTS([])) ->
217 Ast0.set_info d
218 {(Ast0.get_info d)
5636bb2c
C
219 with
220 Ast0.attachable_start = check_attachable false;
221 Ast0.attachable_end = check_attachable false}
34e49164
C
222 | (_,Ast0.DOTS(x)) ->
223 let (l,lstart,lend) = dot_list is_dots fn x in
224 mkres d (Ast0.DOTS l) lstart lend
225 | (_,Ast0.CIRCLES(x)) ->
226 let (l,lstart,lend) = dot_list is_dots fn x in
227 mkres d (Ast0.CIRCLES l) lstart lend
228 | (_,Ast0.STARS(x)) ->
229 let (l,lstart,lend) = dot_list is_dots fn x in
230 mkres d (Ast0.STARS l) lstart lend
231
d3f655c6
C
232(* --------------------------------------------------------------------- *)
233(* Disjunctions *)
234
235let do_disj e starter xs mids ender processor rebuilder =
236 let starter = bad_mcode starter in
237 let xs = List.map processor xs in
238 let mids = List.map bad_mcode mids in
239 let ender = bad_mcode ender in
240 mkmultires e (rebuilder starter xs mids ender)
241 (promote_mcode starter) (promote_mcode ender)
242 (get_all_start_info xs) (get_all_end_info xs)
243
34e49164
C
244(* --------------------------------------------------------------------- *)
245(* Identifier *)
faf9a90c 246
5636bb2c
C
247(* for #define name, with no value, to compute right side *)
248let mkidres a b c d r = (mkres a b c d,r)
249
250let rec full_ident i =
34e49164 251 match Ast0.unwrap i with
8babbc8f
C
252 Ast0.Id(nm) ->
253 let nm = normal_mcode nm in
254 let name = promote_mcode nm in
255 mkidres i (Ast0.Id(nm)) name name (Some name)
256 | Ast0.MetaId(nm,a,b,c) ->
257 let nm = normal_mcode nm in
258 let name = promote_mcode nm in
259 mkidres i (Ast0.MetaId(nm,a,b,c)) name name (Some name)
260 | Ast0.MetaFunc(nm,a,b) ->
261 let nm = normal_mcode nm in
262 let name = promote_mcode nm in
263 mkidres i (Ast0.MetaFunc(nm,a,b)) name name (Some name)
264 | Ast0.MetaLocalFunc(nm,a,b) ->
265 let nm = normal_mcode nm in
266 let name = promote_mcode nm in
267 mkidres i (Ast0.MetaLocalFunc(nm,a,b)) name name (Some name)
d3f655c6
C
268 | Ast0.DisjId(starter,ids,mids,ender) ->
269 let res =
270 do_disj i starter ids mids ender ident
271 (fun starter ids mids ender ->
272 Ast0.DisjId(starter,ids,mids,ender)) in
273 (res,None)
274 | Ast0.OptIdent(id) ->
275 let (id,r) = full_ident id in mkidres i (Ast0.OptIdent(id)) id id r
276 | Ast0.UniqueIdent(id) ->
277 let (id,r) = full_ident id in mkidres i (Ast0.UniqueIdent(id)) id id r
5636bb2c 278and ident i = let (id,_) = full_ident i in id
faf9a90c 279
34e49164
C
280(* --------------------------------------------------------------------- *)
281(* Expression *)
282
283let is_exp_dots e =
284 match Ast0.unwrap e with
285 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
286 | _ -> false
287
288let rec expression e =
289 match Ast0.unwrap e with
290 Ast0.Ident(id) ->
291 let id = ident id in
292 mkres e (Ast0.Ident(id)) id id
8babbc8f
C
293 | Ast0.Constant(const) ->
294 let const = normal_mcode const in
34e49164 295 let ln = promote_mcode const in
8babbc8f 296 mkres e (Ast0.Constant(const)) ln ln
34e49164
C
297 | Ast0.FunCall(fn,lp,args,rp) ->
298 let fn = expression fn in
8babbc8f
C
299 let lp = normal_mcode lp in
300 let rp = normal_mcode rp in
34e49164
C
301 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
302 mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
303 | Ast0.Assignment(left,op,right,simple) ->
304 let left = expression left in
8babbc8f 305 let op = normal_mcode op in
34e49164
C
306 let right = expression right in
307 mkres e (Ast0.Assignment(left,op,right,simple)) left right
308 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
309 let exp1 = expression exp1 in
8babbc8f 310 let why = normal_mcode why in
34e49164 311 let exp2 = get_option expression exp2 in
8babbc8f 312 let colon = normal_mcode colon in
34e49164
C
313 let exp3 = expression exp3 in
314 mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
315 | Ast0.Postfix(exp,op) ->
316 let exp = expression exp in
8babbc8f 317 let op = normal_mcode op in
34e49164
C
318 mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
319 | Ast0.Infix(exp,op) ->
320 let exp = expression exp in
8babbc8f 321 let op = normal_mcode op in
34e49164
C
322 mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
323 | Ast0.Unary(exp,op) ->
324 let exp = expression exp in
8babbc8f 325 let op = normal_mcode op in
34e49164
C
326 mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
327 | Ast0.Binary(left,op,right) ->
328 let left = expression left in
8babbc8f 329 let op = normal_mcode op in
34e49164
C
330 let right = expression right in
331 mkres e (Ast0.Binary(left,op,right)) left right
332 | Ast0.Nested(left,op,right) ->
333 let left = expression left in
8babbc8f 334 let op = normal_mcode op in
34e49164
C
335 let right = expression right in
336 mkres e (Ast0.Nested(left,op,right)) left right
337 | Ast0.Paren(lp,exp,rp) ->
8babbc8f
C
338 let lp = normal_mcode lp in
339 let rp = normal_mcode rp in
34e49164
C
340 mkres e (Ast0.Paren(lp,expression exp,rp))
341 (promote_mcode lp) (promote_mcode rp)
342 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
343 let exp1 = expression exp1 in
8babbc8f 344 let lb = normal_mcode lb in
34e49164 345 let exp2 = expression exp2 in
8babbc8f 346 let rb = normal_mcode rb in
34e49164
C
347 mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
348 | Ast0.RecordAccess(exp,pt,field) ->
349 let exp = expression exp in
8babbc8f 350 let pt = normal_mcode pt in
34e49164
C
351 let field = ident field in
352 mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
353 | Ast0.RecordPtAccess(exp,ar,field) ->
354 let exp = expression exp in
8babbc8f 355 let ar = normal_mcode ar in
34e49164
C
356 let field = ident field in
357 mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
358 | Ast0.Cast(lp,ty,rp,exp) ->
8babbc8f 359 let lp = normal_mcode lp in
34e49164 360 let exp = expression exp in
8babbc8f 361 let rp = normal_mcode rp in
34e49164
C
362 mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
363 | Ast0.SizeOfExpr(szf,exp) ->
8babbc8f 364 let szf = normal_mcode szf in
34e49164
C
365 let exp = expression exp in
366 mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
367 | Ast0.SizeOfType(szf,lp,ty,rp) ->
8babbc8f
C
368 let szf = normal_mcode szf in
369 let lp = normal_mcode lp in
370 let rp = normal_mcode rp in
faf9a90c 371 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
34e49164
C
372 (promote_mcode szf) (promote_mcode rp)
373 | Ast0.TypeExp(ty) ->
374 let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
8babbc8f
C
375 | Ast0.MetaErr(name,a,b) ->
376 let name = normal_mcode name in
377 let ln = promote_mcode name in
378 mkres e (Ast0.MetaErr(name,a,b)) ln ln
379 | Ast0.MetaExpr(name,a,b,c,d) ->
380 let name = normal_mcode name in
381 let ln = promote_mcode name in
382 mkres e (Ast0.MetaExpr(name,a,b,c,d)) ln ln
383 | Ast0.MetaExprList(name,a,b) ->
384 let name = normal_mcode name in
385 let ln = promote_mcode name in
386 mkres e (Ast0.MetaExprList(name,a,b)) ln ln
34e49164 387 | Ast0.EComma(cm) ->
fc1ad971 388 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
8babbc8f 389 let cm = normal_mcode cm in
34e49164
C
390 let ln = promote_mcode cm in
391 mkres e (Ast0.EComma(cm)) ln ln
392 | Ast0.DisjExpr(starter,exps,mids,ender) ->
d3f655c6
C
393 do_disj e starter exps mids ender expression
394 (fun starter exps mids ender -> Ast0.DisjExpr(starter,exps,mids,ender))
34e49164 395 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
8babbc8f
C
396 (* See explanation on Nest *)
397 let wrapper f =
398 match Ast0.get_mcode_mcodekind starter with
399 Ast0.MINUS _ ->
400 in_nest_count := !in_nest_count + 1;
401 let res = f() in
402 in_nest_count := !in_nest_count - 1;
403 res
404 | _ -> f() in
405 let exp_dots =
406 wrapper (function _ -> dots is_exp_dots None expression exp_dots) in
34e49164
C
407 let starter = bad_mcode starter in
408 let ender = bad_mcode ender in
409 mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
410 (promote_mcode starter) (promote_mcode ender)
411 | Ast0.Edots(dots,whencode) ->
412 let dots = bad_mcode dots in
413 let ln = promote_mcode dots in
414 mkres e (Ast0.Edots(dots,whencode)) ln ln
415 | Ast0.Ecircles(dots,whencode) ->
416 let dots = bad_mcode dots in
417 let ln = promote_mcode dots in
418 mkres e (Ast0.Ecircles(dots,whencode)) ln ln
419 | Ast0.Estars(dots,whencode) ->
420 let dots = bad_mcode dots in
421 let ln = promote_mcode dots in
422 mkres e (Ast0.Estars(dots,whencode)) ln ln
423 | Ast0.OptExp(exp) ->
424 let exp = expression exp in
425 mkres e (Ast0.OptExp(exp)) exp exp
426 | Ast0.UniqueExp(exp) ->
427 let exp = expression exp in
428 mkres e (Ast0.UniqueExp(exp)) exp exp
429
430and expression_dots x = dots is_exp_dots None expression x
faf9a90c 431
34e49164
C
432(* --------------------------------------------------------------------- *)
433(* Types *)
faf9a90c 434
34e49164
C
435and typeC t =
436 match Ast0.unwrap t with
437 Ast0.ConstVol(cv,ty) ->
8babbc8f 438 let cv = normal_mcode cv in
34e49164
C
439 let ty = typeC ty in
440 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
8babbc8f
C
441 | Ast0.BaseType(ty,strings) ->
442 let strings = List.map normal_mcode strings in
faf9a90c
C
443 let first = List.hd strings in
444 let last = List.hd (List.rev strings) in
8babbc8f
C
445 mkres t (Ast0.BaseType(ty,strings))
446 (promote_mcode first) (promote_mcode last)
447 | Ast0.Signed(sgn,None) ->
448 let sgn = normal_mcode sgn in
449 mkres t (Ast0.Signed(sgn,None)) (promote_mcode sgn) (promote_mcode sgn)
faf9a90c 450 | Ast0.Signed(sgn,Some ty) ->
8babbc8f 451 let sgn = normal_mcode sgn in
faf9a90c
C
452 let ty = typeC ty in
453 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
34e49164
C
454 | Ast0.Pointer(ty,star) ->
455 let ty = typeC ty in
8babbc8f 456 let star = normal_mcode star in
34e49164
C
457 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
458 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
459 let ty = typeC ty in
8babbc8f
C
460 let lp1 = normal_mcode lp1 in
461 let star = normal_mcode star in
462 let rp1 = normal_mcode rp1 in
463 let lp2 = normal_mcode lp2 in
34e49164 464 let params = parameter_list (Some(promote_mcode lp2)) params in
8babbc8f 465 let rp2 = normal_mcode rp2 in
34e49164
C
466 mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
467 ty (promote_mcode rp2)
468 | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
469 let ty = typeC ty in
8babbc8f 470 let lp1 = normal_mcode lp1 in
34e49164 471 let params = parameter_list (Some(promote_mcode lp1)) params in
8babbc8f 472 let rp1 = normal_mcode rp1 in
34e49164
C
473 let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
474 mkres t res ty (promote_mcode rp1)
475 | Ast0.FunctionType(None,lp1,params,rp1) ->
8babbc8f 476 let lp1 = normal_mcode lp1 in
34e49164 477 let params = parameter_list (Some(promote_mcode lp1)) params in
8babbc8f 478 let rp1 = normal_mcode rp1 in
34e49164
C
479 let res = Ast0.FunctionType(None,lp1,params,rp1) in
480 mkres t res (promote_mcode lp1) (promote_mcode rp1)
481 | Ast0.Array(ty,lb,size,rb) ->
482 let ty = typeC ty in
8babbc8f
C
483 let lb = normal_mcode lb in
484 let rb = normal_mcode rb in
34e49164
C
485 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
486 ty (promote_mcode rb)
c491d8ee 487 | Ast0.EnumName(kind,Some name) ->
8babbc8f 488 let kind = normal_mcode kind in
faf9a90c 489 let name = ident name in
c491d8ee
C
490 mkres t (Ast0.EnumName(kind,Some name)) (promote_mcode kind) name
491 | Ast0.EnumName(kind,None) ->
8babbc8f 492 let kind = normal_mcode kind in
c491d8ee
C
493 let mc = promote_mcode kind in
494 mkres t (Ast0.EnumName(kind,None)) mc mc
495 | Ast0.EnumDef(ty,lb,ids,rb) ->
496 let ty = typeC ty in
8babbc8f 497 let lb = normal_mcode lb in
c491d8ee 498 let ids = dots is_exp_dots (Some(promote_mcode lb)) expression ids in
8babbc8f 499 let rb = normal_mcode rb in
c491d8ee 500 mkres t (Ast0.EnumDef(ty,lb,ids,rb)) ty (promote_mcode rb)
34e49164 501 | Ast0.StructUnionName(kind,Some name) ->
8babbc8f 502 let kind = normal_mcode kind in
34e49164
C
503 let name = ident name in
504 mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
505 | Ast0.StructUnionName(kind,None) ->
8babbc8f 506 let kind = normal_mcode kind in
34e49164
C
507 let mc = promote_mcode kind in
508 mkres t (Ast0.StructUnionName(kind,None)) mc mc
509 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
510 let ty = typeC ty in
8babbc8f 511 let lb = normal_mcode lb in
34e49164
C
512 let decls =
513 dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
8babbc8f 514 let rb = normal_mcode rb in
34e49164 515 mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
8babbc8f
C
516 | Ast0.TypeName(name) ->
517 let name = normal_mcode name in
518 let ln = promote_mcode name in
519 mkres t (Ast0.TypeName(name)) ln ln
520 | Ast0.MetaType(name,a) ->
521 let name = normal_mcode name in
522 let ln = promote_mcode name in
523 mkres t (Ast0.MetaType(name,a)) ln ln
34e49164 524 | Ast0.DisjType(starter,types,mids,ender) ->
d3f655c6
C
525 do_disj t starter types mids ender typeC
526 (fun starter types mids ender ->
527 Ast0.DisjType(starter,types,mids,ender))
34e49164
C
528 | Ast0.OptType(ty) ->
529 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
530 | Ast0.UniqueType(ty) ->
531 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
faf9a90c 532
34e49164
C
533(* --------------------------------------------------------------------- *)
534(* Variable declaration *)
535(* Even if the Cocci program specifies a list of declarations, they are
536 split out into multiple declarations of a single variable each. *)
537
538and is_decl_dots s =
539 match Ast0.unwrap s with
540 Ast0.Ddots(_,_) -> true
541 | _ -> false
faf9a90c 542
34e49164
C
543and declaration d =
544 match Ast0.unwrap d with
8babbc8f
C
545 Ast0.MetaDecl(name,a) ->
546 let name = normal_mcode name in
547 let ln = promote_mcode name in
548 mkres d (Ast0.MetaDecl(name,a)) ln ln
549 | Ast0.MetaField(name,a) ->
550 let name = normal_mcode name in
551 let ln = promote_mcode name in
552 mkres d (Ast0.MetaField(name,a)) ln ln
553 | Ast0.MetaFieldList(name,a,b) ->
554 let name = normal_mcode name in
555 let ln = promote_mcode name in
556 mkres d (Ast0.MetaFieldList(name,a,b)) ln ln
413ffc02 557 | Ast0.Init(stg,ty,id,eq,exp,sem) ->
34e49164
C
558 let ty = typeC ty in
559 let id = ident id in
8babbc8f 560 let eq = normal_mcode eq in
34e49164 561 let exp = initialiser exp in
8babbc8f 562 let sem = normal_mcode sem in
34e49164
C
563 (match stg with
564 None ->
565 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 566 | Some x ->
8babbc8f 567 let stg = Some (normal_mcode x) in
34e49164
C
568 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
569 (promote_mcode x) (promote_mcode sem))
570 | Ast0.UnInit(stg,ty,id,sem) ->
571 let ty = typeC ty in
572 let id = ident id in
8babbc8f 573 let sem = normal_mcode sem in
34e49164
C
574 (match stg with
575 None ->
576 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
577 | Some x ->
8babbc8f 578 let stg = Some (normal_mcode x) in
34e49164
C
579 mkres d (Ast0.UnInit(stg,ty,id,sem))
580 (promote_mcode x) (promote_mcode sem))
581 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
582 let name = ident name in
8babbc8f 583 let lp = normal_mcode lp in
34e49164 584 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
8babbc8f
C
585 let rp = normal_mcode rp in
586 let sem = normal_mcode sem in
34e49164
C
587 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
588 | Ast0.TyDecl(ty,sem) ->
589 let ty = typeC ty in
8babbc8f 590 let sem = normal_mcode sem in
34e49164
C
591 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
592 | Ast0.Typedef(stg,ty,id,sem) ->
8babbc8f 593 let stg = normal_mcode stg in
34e49164
C
594 let ty = typeC ty in
595 let id = typeC id in
8babbc8f 596 let sem = normal_mcode sem in
34e49164
C
597 mkres d (Ast0.Typedef(stg,ty,id,sem))
598 (promote_mcode stg) (promote_mcode sem)
599 | Ast0.DisjDecl(starter,decls,mids,ender) ->
d3f655c6
C
600 do_disj d starter decls mids ender declaration
601 (fun starter decls mids ender ->
602 Ast0.DisjDecl(starter,decls,mids,ender))
34e49164
C
603 | Ast0.Ddots(dots,whencode) ->
604 let dots = bad_mcode dots in
605 let ln = promote_mcode dots in
606 mkres d (Ast0.Ddots(dots,whencode)) ln ln
607 | Ast0.OptDecl(decl) ->
608 let decl = declaration decl in
609 mkres d (Ast0.OptDecl(declaration decl)) decl decl
610 | Ast0.UniqueDecl(decl) ->
611 let decl = declaration decl in
612 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
613
614(* --------------------------------------------------------------------- *)
615(* Initializer *)
616
617and is_init_dots i =
618 match Ast0.unwrap i with
619 Ast0.Idots(_,_) -> true
620 | _ -> false
faf9a90c 621
34e49164
C
622and initialiser i =
623 match Ast0.unwrap i with
8babbc8f
C
624 Ast0.MetaInit(name,a) ->
625 let name = normal_mcode name in
626 let ln = promote_mcode name in
627 mkres i (Ast0.MetaInit(name,a)) ln ln
628 | Ast0.MetaInitList(name,a,b) ->
629 let name = normal_mcode name in
630 let ln = promote_mcode name in
631 mkres i (Ast0.MetaInitList(name,a,b)) ln ln
113803cf 632 | Ast0.InitExpr(exp) ->
34e49164
C
633 let exp = expression exp in
634 mkres i (Ast0.InitExpr(exp)) exp exp
c491d8ee 635 | Ast0.InitList(lb,initlist,rb,ordered) ->
8babbc8f 636 let lb = normal_mcode lb in
34e49164
C
637 let initlist =
638 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
8babbc8f 639 let rb = normal_mcode rb in
c491d8ee 640 mkres i (Ast0.InitList(lb,initlist,rb,ordered))
34e49164 641 (promote_mcode lb) (promote_mcode rb)
113803cf
C
642 | Ast0.InitGccExt(designators,eq,ini) ->
643 let (delims,designators) = (* non empty due to parsing *)
644 List.split (List.map designator designators) in
8babbc8f 645 let eq = normal_mcode eq in
34e49164 646 let ini = initialiser ini in
113803cf
C
647 mkres i (Ast0.InitGccExt(designators,eq,ini))
648 (promote_mcode (List.hd delims)) ini
34e49164
C
649 | Ast0.InitGccName(name,eq,ini) ->
650 let name = ident name in
8babbc8f 651 let eq = normal_mcode eq in
34e49164
C
652 let ini = initialiser ini in
653 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
8babbc8f
C
654 | Ast0.IComma(cm) ->
655 let cm = normal_mcode cm in
656 let ln = promote_mcode cm in
657 mkres i (Ast0.IComma(cm)) ln ln
34e49164
C
658 | Ast0.Idots(dots,whencode) ->
659 let dots = bad_mcode dots in
660 let ln = promote_mcode dots in
661 mkres i (Ast0.Idots(dots,whencode)) ln ln
662 | Ast0.OptIni(ini) ->
663 let ini = initialiser ini in
664 mkres i (Ast0.OptIni(ini)) ini ini
665 | Ast0.UniqueIni(ini) ->
666 let ini = initialiser ini in
667 mkres i (Ast0.UniqueIni(ini)) ini ini
668
113803cf
C
669and designator = function
670 Ast0.DesignatorField(dot,id) ->
8babbc8f 671 let dot = normal_mcode dot in
113803cf
C
672 (dot,Ast0.DesignatorField(dot,ident id))
673 | Ast0.DesignatorIndex(lb,exp,rb) ->
8babbc8f
C
674 let lb = normal_mcode lb in
675 let rb = normal_mcode rb in
113803cf
C
676 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
677 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
8babbc8f
C
678 let lb = normal_mcode lb in
679 let dots = normal_mcode dots in
680 let rb = normal_mcode rb in
113803cf
C
681 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
682
34e49164
C
683and initialiser_list prev = dots is_init_dots prev initialiser
684
685(* for export *)
686and initialiser_dots x = dots is_init_dots None initialiser x
687
688(* --------------------------------------------------------------------- *)
689(* Parameter *)
690
691and is_param_dots p =
692 match Ast0.unwrap p with
693 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
694 | _ -> false
faf9a90c 695
34e49164
C
696and parameterTypeDef p =
697 match Ast0.unwrap p with
698 Ast0.VoidParam(ty) ->
699 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
700 | Ast0.Param(ty,Some id) ->
701 let id = ident id in
702 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
703 | Ast0.Param(ty,None) ->
704 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
8babbc8f
C
705 | Ast0.MetaParam(name,a) ->
706 let name = normal_mcode name in
707 let ln = promote_mcode name in
708 mkres p (Ast0.MetaParam(name,a)) ln ln
709 | Ast0.MetaParamList(name,a,b) ->
710 let name = normal_mcode name in
711 let ln = promote_mcode name in
712 mkres p (Ast0.MetaParamList(name,a,b)) ln ln
34e49164 713 | Ast0.PComma(cm) ->
fc1ad971 714 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
8babbc8f 715 let cm = normal_mcode cm in
34e49164
C
716 let ln = promote_mcode cm in
717 mkres p (Ast0.PComma(cm)) ln ln
718 | Ast0.Pdots(dots) ->
719 let dots = bad_mcode dots in
720 let ln = promote_mcode dots in
721 mkres p (Ast0.Pdots(dots)) ln ln
722 | Ast0.Pcircles(dots) ->
723 let dots = bad_mcode dots in
724 let ln = promote_mcode dots in
725 mkres p (Ast0.Pcircles(dots)) ln ln
726 | Ast0.OptParam(param) ->
727 let res = parameterTypeDef param in
728 mkres p (Ast0.OptParam(res)) res res
729 | Ast0.UniqueParam(param) ->
730 let res = parameterTypeDef param in
731 mkres p (Ast0.UniqueParam(res)) res res
732
733and parameter_list prev = dots is_param_dots prev parameterTypeDef
734
735(* for export *)
736let parameter_dots x = dots is_param_dots None parameterTypeDef x
737
7f004419
C
738(* --------------------------------------------------------------------- *)
739
740let is_define_param_dots s =
741 match Ast0.unwrap s with
742 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
743 | _ -> false
744
745let rec define_param p =
746 match Ast0.unwrap p with
747 Ast0.DParam(id) ->
748 let id = ident id in mkres p (Ast0.DParam(id)) id id
749 | Ast0.DPComma(cm) ->
750 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
8babbc8f 751 let cm = normal_mcode cm in
7f004419
C
752 let ln = promote_mcode cm in
753 mkres p (Ast0.DPComma(cm)) ln ln
754 | Ast0.DPdots(dots) ->
755 let dots = bad_mcode dots in
756 let ln = promote_mcode dots in
757 mkres p (Ast0.DPdots(dots)) ln ln
758 | Ast0.DPcircles(dots) ->
759 let dots = bad_mcode dots in
760 let ln = promote_mcode dots in
761 mkres p (Ast0.DPcircles(dots)) ln ln
762 | Ast0.OptDParam(dp) ->
763 let res = define_param dp in
764 mkres p (Ast0.OptDParam(res)) res res
765 | Ast0.UniqueDParam(dp) ->
766 let res = define_param dp in
767 mkres p (Ast0.UniqueDParam(res)) res res
768
5636bb2c 769let define_parameters x id =
7f004419 770 match Ast0.unwrap x with
5636bb2c 771 Ast0.NoParams -> (x,id) (* no info, should be ignored *)
7f004419 772 | Ast0.DParams(lp,dp,rp) ->
8babbc8f 773 let lp = normal_mcode lp in
7f004419 774 let dp = dots is_define_param_dots None define_param dp in
8babbc8f 775 let rp = normal_mcode rp in
7f004419
C
776 let l = promote_mcode lp in
777 let r = promote_mcode rp in
5636bb2c 778 (mkres x (Ast0.DParams(lp,dp,rp)) l r, r)
7f004419 779
34e49164
C
780(* --------------------------------------------------------------------- *)
781(* Top-level code *)
782
783let is_stm_dots s =
784 match Ast0.unwrap s with
785 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
786 | _ -> false
faf9a90c 787
34e49164
C
788let rec statement s =
789 let res =
790 match Ast0.unwrap s with
791 Ast0.Decl((_,bef),decl) ->
792 let decl = declaration decl in
793 let left = promote_to_statement_start decl bef in
794 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
faf9a90c 795 | Ast0.Seq(lbrace,body,rbrace) ->
8babbc8f 796 let lbrace = normal_mcode lbrace in
34e49164
C
797 let body =
798 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
8babbc8f 799 let rbrace = normal_mcode rbrace in
34e49164
C
800 mkres s (Ast0.Seq(lbrace,body,rbrace))
801 (promote_mcode lbrace) (promote_mcode rbrace)
8babbc8f 802 | Ast0.ExprStatement(Some exp,sem) ->
34e49164 803 let exp = expression exp in
8babbc8f
C
804 let sem = normal_mcode sem in
805 mkres s (Ast0.ExprStatement(Some exp,sem)) exp (promote_mcode sem)
806 | Ast0.ExprStatement(None,sem) ->
807 let sem = normal_mcode sem in
808 let promoted_sem = promote_mcode sem in
809 mkres s (Ast0.ExprStatement(None,sem)) promoted_sem promoted_sem
34e49164 810 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
8babbc8f
C
811 let iff = normal_mcode iff in
812 let lp = normal_mcode lp in
34e49164 813 let exp = expression exp in
8babbc8f 814 let rp = normal_mcode rp in
34e49164
C
815 let branch = statement branch in
816 let right = promote_to_statement branch aft in
817 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
818 (promote_mcode iff) right
819 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
8babbc8f
C
820 let iff = normal_mcode iff in
821 let lp = normal_mcode lp in
34e49164 822 let exp = expression exp in
8babbc8f 823 let rp = normal_mcode rp in
34e49164 824 let branch1 = statement branch1 in
8babbc8f 825 let els = normal_mcode els in
34e49164
C
826 let branch2 = statement branch2 in
827 let right = promote_to_statement branch2 aft in
828 mkres s
829 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
830 (Ast0.get_info right,aft)))
831 (promote_mcode iff) right
832 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
8babbc8f
C
833 let wh = normal_mcode wh in
834 let lp = normal_mcode lp in
34e49164 835 let exp = expression exp in
8babbc8f 836 let rp = normal_mcode rp in
34e49164
C
837 let body = statement body in
838 let right = promote_to_statement body aft in
839 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
840 (promote_mcode wh) right
841 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
8babbc8f 842 let d = normal_mcode d in
34e49164 843 let body = statement body in
8babbc8f
C
844 let wh = normal_mcode wh in
845 let lp = normal_mcode lp in
34e49164 846 let exp = expression exp in
8babbc8f 847 let rp = normal_mcode rp in
34e49164
C
848 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
849 (promote_mcode d) (promote_mcode sem)
850 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
8babbc8f
C
851 let fr = normal_mcode fr in
852 let lp = normal_mcode lp in
34e49164 853 let exp1 = get_option expression exp1 in
8babbc8f 854 let sem1 = normal_mcode sem1 in
34e49164 855 let exp2 = get_option expression exp2 in
8babbc8f 856 let sem2 = normal_mcode sem2 in
34e49164 857 let exp3 = get_option expression exp3 in
8babbc8f 858 let rp = normal_mcode rp in
34e49164
C
859 let body = statement body in
860 let right = promote_to_statement body aft in
861 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
862 (Ast0.get_info right,aft)))
863 (promote_mcode fr) right
864 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
865 let nm = ident nm in
8babbc8f 866 let lp = normal_mcode lp in
34e49164 867 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
8babbc8f 868 let rp = normal_mcode rp in
34e49164
C
869 let body = statement body in
870 let right = promote_to_statement body aft in
871 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
872 nm right
fc1ad971 873 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
8babbc8f
C
874 let switch = normal_mcode switch in
875 let lp = normal_mcode lp in
34e49164 876 let exp = expression exp in
8babbc8f
C
877 let rp = normal_mcode rp in
878 let lb = normal_mcode lb in
fc1ad971
C
879 let decls =
880 dots is_stm_dots (Some(promote_mcode lb))
881 statement decls in
34e49164 882 let cases =
fc1ad971
C
883 dots (function _ -> false)
884 (if Ast0.undots decls = []
885 then (Some(promote_mcode lb))
886 else None (* not sure this is right, but not sure the case can
887 arise either *))
888 case_line cases in
8babbc8f 889 let rb = normal_mcode rb in
34e49164 890 mkres s
fc1ad971 891 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164 892 (promote_mcode switch) (promote_mcode rb)
8babbc8f
C
893 | Ast0.Break(br,sem) ->
894 let br = normal_mcode br in
895 let sem = normal_mcode sem in
896 mkres s (Ast0.Break(br,sem)) (promote_mcode br) (promote_mcode sem)
897 | Ast0.Continue(cont,sem) ->
898 let cont = normal_mcode cont in
899 let sem = normal_mcode sem in
900 mkres s (Ast0.Continue(cont,sem))
901 (promote_mcode cont) (promote_mcode sem)
34e49164
C
902 | Ast0.Label(l,dd) ->
903 let l = ident l in
8babbc8f 904 let dd = normal_mcode dd in
34e49164
C
905 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
906 | Ast0.Goto(goto,id,sem) ->
8babbc8f 907 let goto = normal_mcode goto in
34e49164 908 let id = ident id in
8babbc8f 909 let sem = normal_mcode sem in
faf9a90c 910 mkres s (Ast0.Goto(goto,id,sem))
34e49164 911 (promote_mcode goto) (promote_mcode sem)
8babbc8f
C
912 | Ast0.Return(ret,sem) ->
913 let ret = normal_mcode ret in
914 let sem = normal_mcode sem in
915 mkres s (Ast0.Return(ret,sem)) (promote_mcode ret) (promote_mcode sem)
34e49164 916 | Ast0.ReturnExpr(ret,exp,sem) ->
8babbc8f 917 let ret = normal_mcode ret in
34e49164 918 let exp = expression exp in
8babbc8f 919 let sem = normal_mcode sem in
faf9a90c 920 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164 921 (promote_mcode ret) (promote_mcode sem)
8babbc8f
C
922 | Ast0.MetaStmt(name,a) ->
923 let ln = promote_mcode name in
924 mkres s (Ast0.MetaStmt(name,a)) ln ln
925 | Ast0.MetaStmtList(name,a) ->
926 let ln = promote_mcode name in
927 mkres s (Ast0.MetaStmtList(name,a)) ln ln
34e49164
C
928 | Ast0.Exp(exp) ->
929 let exp = expression exp in
930 mkres s (Ast0.Exp(exp)) exp exp
931 | Ast0.TopExp(exp) ->
932 let exp = expression exp in
933 mkres s (Ast0.TopExp(exp)) exp exp
934 | Ast0.Ty(ty) ->
935 let ty = typeC ty in
936 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
937 | Ast0.TopInit(init) ->
938 let init = initialiser init in
939 mkres s (Ast0.TopInit(init)) init init
34e49164
C
940 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
941 let starter = bad_mcode starter in
942 let mids = List.map bad_mcode mids in
943 let ender = bad_mcode ender in
944 let rec loop prevs = function
945 [] -> []
946 | stm::stms ->
947 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
948 statement stm)::
949 (loop (List.tl prevs) stms) in
950 let elems = loop (starter::mids) rule_elem_dots_list in
951 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
952 (promote_mcode starter) (promote_mcode ender)
953 (get_all_start_info elems) (get_all_end_info elems)
954 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
955 let starter = bad_mcode starter in
956 let ender = bad_mcode ender in
5636bb2c
C
957 let wrapper f =
958 match Ast0.get_mcode_mcodekind starter with
959 Ast0.MINUS _ ->
960 (* if minus, then all nest code has to be minus. This is
961 checked at the token level, in parse_cocci.ml. All nest code
962 is also unattachable. We strip the minus annotations from
963 the nest code because in the CTL another metavariable will
964 take care of removing all the code matched by the nest.
965 Without stripping the minus annotations, we would get a
966 double transformation. Perhaps there is a more elegant
967 way to do this in the CTL, but it is not easy, because of
968 the interaction with the whencode and the implementation of
969 plus *)
970 in_nest_count := !in_nest_count + 1;
971 let res = f() in
972 in_nest_count := !in_nest_count - 1;
973 res
974 | _ -> f() in
975 let rule_elem_dots =
976 wrapper
977 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
978 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
979 (promote_mcode starter) (promote_mcode ender)
980 | Ast0.Dots(dots,whencode) ->
981 let dots = bad_mcode dots in
982 let ln = promote_mcode dots in
983 mkres s (Ast0.Dots(dots,whencode)) ln ln
984 | Ast0.Circles(dots,whencode) ->
985 let dots = bad_mcode dots in
986 let ln = promote_mcode dots in
987 mkres s (Ast0.Circles(dots,whencode)) ln ln
988 | Ast0.Stars(dots,whencode) ->
989 let dots = bad_mcode dots in
990 let ln = promote_mcode dots in
991 mkres s (Ast0.Stars(dots,whencode)) ln ln
992 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
993 let fninfo =
994 List.map
995 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
996 fninfo in
997 let name = ident name in
8babbc8f 998 let lp = normal_mcode lp in
34e49164 999 let params = parameter_list (Some(promote_mcode lp)) params in
8babbc8f
C
1000 let rp = normal_mcode rp in
1001 let lbrace = normal_mcode lbrace in
34e49164
C
1002 let body =
1003 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
8babbc8f 1004 let rbrace = normal_mcode rbrace in
34e49164
C
1005 let left =
1006 (* cases on what is leftmost *)
1007 match fninfo with
1008 [] -> promote_to_statement_start name bef
1009 | Ast0.FStorage(stg)::_ ->
1010 promote_to_statement_start (promote_mcode stg) bef
1011 | Ast0.FType(ty)::_ ->
1012 promote_to_statement_start ty bef
1013 | Ast0.FInline(inline)::_ ->
1014 promote_to_statement_start (promote_mcode inline) bef
1015 | Ast0.FAttr(attr)::_ ->
1016 promote_to_statement_start (promote_mcode attr) bef in
1017 (* pretend it is one line before the start of the function, so that it
1018 will catch things defined at top level. We assume that these will not
1019 be defined on the same line as the function. This is a HACK.
1020 A better approach would be to attach top_level things to this node,
1021 and other things to the node after, but that would complicate
1022 insert_plus, which doesn't distinguish between different mcodekinds *)
1023 let res =
1024 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
1025 body,rbrace) in
1026 (* have to do this test again, because of typing problems - can't save
1027 the result, only use it *)
1028 (match fninfo with
1029 [] -> mkres s res name (promote_mcode rbrace)
1030 | Ast0.FStorage(stg)::_ ->
1031 mkres s res (promote_mcode stg) (promote_mcode rbrace)
1032 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
1033 | Ast0.FInline(inline)::_ ->
1034 mkres s res (promote_mcode inline) (promote_mcode rbrace)
1035 | Ast0.FAttr(attr)::_ ->
1036 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 1037
34e49164 1038 | Ast0.Include(inc,stm) ->
8babbc8f
C
1039 let inc = normal_mcode inc in
1040 let stm = normal_mcode stm in
34e49164 1041 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
3a314143 1042 | Ast0.Undef(def,id) ->
8babbc8f 1043 let def = normal_mcode def in
d3f655c6 1044 let id = ident id in
3a314143 1045 mkres s (Ast0.Undef(def,id)) (promote_mcode def) id
34e49164 1046 | Ast0.Define(def,id,params,body) ->
8babbc8f 1047 let def = normal_mcode def in
5636bb2c 1048 let (id,right) = full_ident id in
d3f655c6
C
1049 (match right with
1050 None -> failwith "no disj id for #define"
1051 | Some right ->
1052 let (params,prev) = define_parameters params right in
1053 let body = dots is_stm_dots (Some prev) statement body in
1054 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body)
34e49164
C
1055 | Ast0.OptStm(stm) ->
1056 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
1057 | Ast0.UniqueStm(stm) ->
1058 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
1059 Ast0.set_dots_bef_aft res
1060 (match Ast0.get_dots_bef_aft res with
1061 Ast0.NoDots -> Ast0.NoDots
1062 | Ast0.AddingBetweenDots s ->
1063 Ast0.AddingBetweenDots(statement s)
1064 | Ast0.DroppingBetweenDots s ->
1065 Ast0.DroppingBetweenDots(statement s))
1066
1067and case_line c =
1068 match Ast0.unwrap c with
1069 Ast0.Default(def,colon,code) ->
8babbc8f
C
1070 let def = normal_mcode def in
1071 let colon = normal_mcode colon in
34e49164
C
1072 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
1073 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
1074 | Ast0.Case(case,exp,colon,code) ->
8babbc8f 1075 let case = normal_mcode case in
34e49164 1076 let exp = expression exp in
8babbc8f 1077 let colon = normal_mcode colon in
34e49164
C
1078 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
1079 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
fc1ad971 1080 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
d3f655c6
C
1081 do_disj c starter case_lines mids ender case_line
1082 (fun starter case_lines mids ender ->
1083 Ast0.DisjCase(starter,case_lines,mids,ender))
34e49164
C
1084 | Ast0.OptCase(case) ->
1085 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
1086
1087and statement_dots x = dots is_stm_dots None statement x
faf9a90c 1088
34e49164
C
1089(* --------------------------------------------------------------------- *)
1090(* Function declaration *)
faf9a90c 1091
34e49164
C
1092let top_level t =
1093 match Ast0.unwrap t with
1094 Ast0.FILEINFO(old_file,new_file) -> t
65038c61
C
1095 | Ast0.NONDECL(stmt) ->
1096 let stmt = statement stmt in mkres t (Ast0.NONDECL(stmt)) stmt stmt
34e49164
C
1097 | Ast0.CODE(rule_elem_dots) ->
1098 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
1099 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
1100 | Ast0.ERRORWORDS(exps) -> t
65038c61 1101 | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level"
faf9a90c 1102
34e49164
C
1103(* --------------------------------------------------------------------- *)
1104(* Entry points *)
faf9a90c 1105
978fd7e5 1106let compute_lines attachable_or x =
5636bb2c 1107 in_nest_count := 0;
978fd7e5
C
1108 inherit_attachable := attachable_or;
1109 List.map top_level x
1110
1111let compute_statement_lines attachable_or x =
5636bb2c 1112 in_nest_count := 0;
978fd7e5
C
1113 inherit_attachable := attachable_or;
1114 statement x
1115
1116let compute_statement_dots_lines attachable_or x =
5636bb2c 1117 in_nest_count := 0;
978fd7e5
C
1118 inherit_attachable := attachable_or;
1119 statement_dots x
faf9a90c 1120