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