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