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