- Try to do better pretty printing when array elements are individually
[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
abad11c5 840 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft,adj)) ->
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
abad11c5
C
847 mkres s
848 (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft,adj)))
34e49164 849 (promote_mcode iff) right
abad11c5 850 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft,adj)) ->
8babbc8f
C
851 let iff = normal_mcode iff in
852 let lp = normal_mcode lp in
34e49164 853 let exp = expression exp in
8babbc8f 854 let rp = normal_mcode rp in
34e49164 855 let branch1 = statement branch1 in
8babbc8f 856 let els = normal_mcode els in
34e49164
C
857 let branch2 = statement branch2 in
858 let right = promote_to_statement branch2 aft in
859 mkres s
860 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
abad11c5 861 (Ast0.get_info right,aft,adj)))
34e49164 862 (promote_mcode iff) right
abad11c5 863 | Ast0.While(wh,lp,exp,rp,body,(_,aft,adj)) ->
8babbc8f
C
864 let wh = normal_mcode wh in
865 let lp = normal_mcode lp in
34e49164 866 let exp = expression exp in
8babbc8f 867 let rp = normal_mcode rp in
34e49164
C
868 let body = statement body in
869 let right = promote_to_statement body aft in
abad11c5 870 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft,adj)))
34e49164
C
871 (promote_mcode wh) right
872 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
8babbc8f 873 let d = normal_mcode d in
34e49164 874 let body = statement body in
8babbc8f
C
875 let wh = normal_mcode wh in
876 let lp = normal_mcode lp in
34e49164 877 let exp = expression exp in
8babbc8f 878 let rp = normal_mcode rp in
34e49164
C
879 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
880 (promote_mcode d) (promote_mcode sem)
abad11c5 881 | Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,(_,aft,adj)) ->
8babbc8f
C
882 let fr = normal_mcode fr in
883 let lp = normal_mcode lp in
755320b0
C
884 let first =
885 match Ast0.unwrap first with
886 Ast0.ForExp(None,sem1) ->
887 let sem1 = normal_mcode sem1 in
888 mkres first (Ast0.ForExp(None,sem1))
889 (promote_mcode sem1) (promote_mcode sem1)
890 | Ast0.ForExp(Some exp1,sem1) ->
891 let exp1 = expression exp1 in
892 let sem1 = normal_mcode sem1 in
893 mkres first (Ast0.ForExp(Some exp1,sem1))
894 exp1 (promote_mcode sem1)
895 | Ast0.ForDecl((_,bef),decl) ->
896 let decl = declaration decl in
897 let left = promote_to_statement_start decl bef in
898 mkres first (Ast0.ForDecl ((Ast0.get_info left,bef),decl))
899 decl decl in
34e49164 900 let exp2 = get_option expression exp2 in
8babbc8f 901 let sem2 = normal_mcode sem2 in
34e49164 902 let exp3 = get_option expression exp3 in
8babbc8f 903 let rp = normal_mcode rp in
34e49164
C
904 let body = statement body in
905 let right = promote_to_statement body aft in
755320b0 906 mkres s (Ast0.For(fr,lp,first,exp2,sem2,exp3,rp,body,
abad11c5 907 (Ast0.get_info right,aft,adj)))
34e49164 908 (promote_mcode fr) right
abad11c5 909 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft,adj)) ->
34e49164 910 let nm = ident nm in
8babbc8f 911 let lp = normal_mcode lp in
34e49164 912 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
8babbc8f 913 let rp = normal_mcode rp in
34e49164
C
914 let body = statement body in
915 let right = promote_to_statement body aft in
abad11c5
C
916 mkres s
917 (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft,adj)))
34e49164 918 nm right
fc1ad971 919 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
8babbc8f
C
920 let switch = normal_mcode switch in
921 let lp = normal_mcode lp in
34e49164 922 let exp = expression exp in
8babbc8f
C
923 let rp = normal_mcode rp in
924 let lb = normal_mcode lb in
fc1ad971
C
925 let decls =
926 dots is_stm_dots (Some(promote_mcode lb))
927 statement decls in
34e49164 928 let cases =
fc1ad971
C
929 dots (function _ -> false)
930 (if Ast0.undots decls = []
931 then (Some(promote_mcode lb))
932 else None (* not sure this is right, but not sure the case can
933 arise either *))
934 case_line cases in
8babbc8f 935 let rb = normal_mcode rb in
34e49164 936 mkres s
fc1ad971 937 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164 938 (promote_mcode switch) (promote_mcode rb)
8babbc8f
C
939 | Ast0.Break(br,sem) ->
940 let br = normal_mcode br in
941 let sem = normal_mcode sem in
942 mkres s (Ast0.Break(br,sem)) (promote_mcode br) (promote_mcode sem)
943 | Ast0.Continue(cont,sem) ->
944 let cont = normal_mcode cont in
945 let sem = normal_mcode sem in
946 mkres s (Ast0.Continue(cont,sem))
947 (promote_mcode cont) (promote_mcode sem)
34e49164
C
948 | Ast0.Label(l,dd) ->
949 let l = ident l in
8babbc8f 950 let dd = normal_mcode dd in
34e49164
C
951 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
952 | Ast0.Goto(goto,id,sem) ->
8babbc8f 953 let goto = normal_mcode goto in
34e49164 954 let id = ident id in
8babbc8f 955 let sem = normal_mcode sem in
faf9a90c 956 mkres s (Ast0.Goto(goto,id,sem))
34e49164 957 (promote_mcode goto) (promote_mcode sem)
8babbc8f
C
958 | Ast0.Return(ret,sem) ->
959 let ret = normal_mcode ret in
960 let sem = normal_mcode sem in
961 mkres s (Ast0.Return(ret,sem)) (promote_mcode ret) (promote_mcode sem)
34e49164 962 | Ast0.ReturnExpr(ret,exp,sem) ->
8babbc8f 963 let ret = normal_mcode ret in
34e49164 964 let exp = expression exp in
8babbc8f 965 let sem = normal_mcode sem in
faf9a90c 966 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164 967 (promote_mcode ret) (promote_mcode sem)
8babbc8f
C
968 | Ast0.MetaStmt(name,a) ->
969 let ln = promote_mcode name in
970 mkres s (Ast0.MetaStmt(name,a)) ln ln
971 | Ast0.MetaStmtList(name,a) ->
972 let ln = promote_mcode name in
973 mkres s (Ast0.MetaStmtList(name,a)) ln ln
34e49164
C
974 | Ast0.Exp(exp) ->
975 let exp = expression exp in
976 mkres s (Ast0.Exp(exp)) exp exp
977 | Ast0.TopExp(exp) ->
978 let exp = expression exp in
979 mkres s (Ast0.TopExp(exp)) exp exp
980 | Ast0.Ty(ty) ->
981 let ty = typeC ty in
982 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
983 | Ast0.TopInit(init) ->
984 let init = initialiser init in
985 mkres s (Ast0.TopInit(init)) init init
34e49164
C
986 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
987 let starter = bad_mcode starter in
988 let mids = List.map bad_mcode mids in
989 let ender = bad_mcode ender in
990 let rec loop prevs = function
991 [] -> []
992 | stm::stms ->
993 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
994 statement stm)::
995 (loop (List.tl prevs) stms) in
996 let elems = loop (starter::mids) rule_elem_dots_list in
997 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
998 (promote_mcode starter) (promote_mcode ender)
999 (get_all_start_info elems) (get_all_end_info elems)
1000 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
1001 let starter = bad_mcode starter in
1002 let ender = bad_mcode ender in
5636bb2c
C
1003 let wrapper f =
1004 match Ast0.get_mcode_mcodekind starter with
1005 Ast0.MINUS _ ->
1006 (* if minus, then all nest code has to be minus. This is
1007 checked at the token level, in parse_cocci.ml. All nest code
1008 is also unattachable. We strip the minus annotations from
1009 the nest code because in the CTL another metavariable will
1010 take care of removing all the code matched by the nest.
1011 Without stripping the minus annotations, we would get a
1012 double transformation. Perhaps there is a more elegant
1013 way to do this in the CTL, but it is not easy, because of
1014 the interaction with the whencode and the implementation of
1015 plus *)
1016 in_nest_count := !in_nest_count + 1;
1017 let res = f() in
1018 in_nest_count := !in_nest_count - 1;
1019 res
1020 | _ -> f() in
1021 let rule_elem_dots =
1022 wrapper
1023 (function _ -> dots is_stm_dots None statement rule_elem_dots) in
34e49164
C
1024 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
1025 (promote_mcode starter) (promote_mcode ender)
1026 | Ast0.Dots(dots,whencode) ->
1027 let dots = bad_mcode dots in
1028 let ln = promote_mcode dots in
1029 mkres s (Ast0.Dots(dots,whencode)) ln ln
1030 | Ast0.Circles(dots,whencode) ->
1031 let dots = bad_mcode dots in
1032 let ln = promote_mcode dots in
1033 mkres s (Ast0.Circles(dots,whencode)) ln ln
1034 | Ast0.Stars(dots,whencode) ->
1035 let dots = bad_mcode dots in
1036 let ln = promote_mcode dots in
1037 mkres s (Ast0.Stars(dots,whencode)) ln ln
1038 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
1039 let fninfo =
1040 List.map
1041 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
1042 fninfo in
1043 let name = ident name in
8babbc8f 1044 let lp = normal_mcode lp in
34e49164 1045 let params = parameter_list (Some(promote_mcode lp)) params in
8babbc8f
C
1046 let rp = normal_mcode rp in
1047 let lbrace = normal_mcode lbrace in
34e49164
C
1048 let body =
1049 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
8babbc8f 1050 let rbrace = normal_mcode rbrace in
34e49164
C
1051 let left =
1052 (* cases on what is leftmost *)
1053 match fninfo with
1054 [] -> promote_to_statement_start name bef
1055 | Ast0.FStorage(stg)::_ ->
1056 promote_to_statement_start (promote_mcode stg) bef
1057 | Ast0.FType(ty)::_ ->
1058 promote_to_statement_start ty bef
1059 | Ast0.FInline(inline)::_ ->
1060 promote_to_statement_start (promote_mcode inline) bef
1061 | Ast0.FAttr(attr)::_ ->
1062 promote_to_statement_start (promote_mcode attr) bef in
1063 (* pretend it is one line before the start of the function, so that it
1064 will catch things defined at top level. We assume that these will not
1065 be defined on the same line as the function. This is a HACK.
1066 A better approach would be to attach top_level things to this node,
1067 and other things to the node after, but that would complicate
1068 insert_plus, which doesn't distinguish between different mcodekinds *)
1069 let res =
1070 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
1071 body,rbrace) in
1072 (* have to do this test again, because of typing problems - can't save
1073 the result, only use it *)
1074 (match fninfo with
1075 [] -> mkres s res name (promote_mcode rbrace)
1076 | Ast0.FStorage(stg)::_ ->
1077 mkres s res (promote_mcode stg) (promote_mcode rbrace)
1078 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
1079 | Ast0.FInline(inline)::_ ->
1080 mkres s res (promote_mcode inline) (promote_mcode rbrace)
1081 | Ast0.FAttr(attr)::_ ->
1082 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 1083
34e49164 1084 | Ast0.Include(inc,stm) ->
8babbc8f
C
1085 let inc = normal_mcode inc in
1086 let stm = normal_mcode stm in
34e49164 1087 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
3a314143 1088 | Ast0.Undef(def,id) ->
8babbc8f 1089 let def = normal_mcode def in
d3f655c6 1090 let id = ident id in
3a314143 1091 mkres s (Ast0.Undef(def,id)) (promote_mcode def) id
34e49164 1092 | Ast0.Define(def,id,params,body) ->
8babbc8f 1093 let def = normal_mcode def in
5636bb2c 1094 let (id,right) = full_ident id in
d3f655c6
C
1095 (match right with
1096 None -> failwith "no disj id for #define"
1097 | Some right ->
1098 let (params,prev) = define_parameters params right in
1099 let body = dots is_stm_dots (Some prev) statement body in
1100 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body)
34e49164
C
1101 | Ast0.OptStm(stm) ->
1102 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
1103 | Ast0.UniqueStm(stm) ->
17ba0788
C
1104 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm
1105 | Ast0.AsStmt _ -> failwith "not possible" in
34e49164
C
1106 Ast0.set_dots_bef_aft res
1107 (match Ast0.get_dots_bef_aft res with
1108 Ast0.NoDots -> Ast0.NoDots
1109 | Ast0.AddingBetweenDots s ->
1110 Ast0.AddingBetweenDots(statement s)
1111 | Ast0.DroppingBetweenDots s ->
1112 Ast0.DroppingBetweenDots(statement s))
1113
1114and case_line c =
1115 match Ast0.unwrap c with
1116 Ast0.Default(def,colon,code) ->
8babbc8f
C
1117 let def = normal_mcode def in
1118 let colon = normal_mcode colon in
34e49164
C
1119 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
1120 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
1121 | Ast0.Case(case,exp,colon,code) ->
8babbc8f 1122 let case = normal_mcode case in
34e49164 1123 let exp = expression exp in
8babbc8f 1124 let colon = normal_mcode colon in
34e49164
C
1125 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
1126 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
fc1ad971 1127 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
d3f655c6
C
1128 do_disj c starter case_lines mids ender case_line
1129 (fun starter case_lines mids ender ->
1130 Ast0.DisjCase(starter,case_lines,mids,ender))
34e49164
C
1131 | Ast0.OptCase(case) ->
1132 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
1133
1134and statement_dots x = dots is_stm_dots None statement x
faf9a90c 1135
34e49164
C
1136(* --------------------------------------------------------------------- *)
1137(* Function declaration *)
faf9a90c 1138
34e49164
C
1139let top_level t =
1140 match Ast0.unwrap t with
1141 Ast0.FILEINFO(old_file,new_file) -> t
65038c61
C
1142 | Ast0.NONDECL(stmt) ->
1143 let stmt = statement stmt in mkres t (Ast0.NONDECL(stmt)) stmt stmt
34e49164
C
1144 | Ast0.CODE(rule_elem_dots) ->
1145 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
1146 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
1147 | Ast0.ERRORWORDS(exps) -> t
65038c61 1148 | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level"
faf9a90c 1149
34e49164
C
1150(* --------------------------------------------------------------------- *)
1151(* Entry points *)
faf9a90c 1152
978fd7e5 1153let compute_lines attachable_or x =
5636bb2c 1154 in_nest_count := 0;
978fd7e5
C
1155 inherit_attachable := attachable_or;
1156 List.map top_level x
1157
1158let compute_statement_lines attachable_or x =
5636bb2c 1159 in_nest_count := 0;
978fd7e5
C
1160 inherit_attachable := attachable_or;
1161 statement x
1162
1163let compute_statement_dots_lines attachable_or x =
5636bb2c 1164 in_nest_count := 0;
978fd7e5
C
1165 inherit_attachable := attachable_or;
1166 statement_dots x
faf9a90c 1167