Release coccinelle-0.2.0
[bpt/coccinelle.git] / parsing_cocci / compute_lines.ml
CommitLineData
9f8e26f4
C
1(*
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
5 *
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
9 *
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
34e49164
C
23(* Computes starting and ending logical lines for statements and
24expressions. every node gets an index as well. *)
25
26module Ast0 = Ast0_cocci
27module Ast = Ast_cocci
faf9a90c 28
34e49164
C
29(* --------------------------------------------------------------------- *)
30(* Result *)
31
32let mkres x e left right =
33 let lstart = Ast0.get_info left in
34 let lend = Ast0.get_info right in
0708f913
C
35 let pos_info =
36 { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
37 Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
38 Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
39 Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
40 Ast0.column = lstart.Ast0.pos_info.Ast0.column;
708f4980 41 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset;} in
34e49164 42 let info =
0708f913 43 { Ast0.pos_info = pos_info;
34e49164
C
44 Ast0.attachable_start = lstart.Ast0.attachable_start;
45 Ast0.attachable_end = lend.Ast0.attachable_end;
46 Ast0.mcode_start = lstart.Ast0.mcode_start;
47 Ast0.mcode_end = lend.Ast0.mcode_end;
34e49164 48 (* only for tokens, not inherited upwards *)
0708f913 49 Ast0.strings_before = []; Ast0.strings_after = [] } in
34e49164
C
50 {x with Ast0.node = e; Ast0.info = info}
51
978fd7e5
C
52(* This looks like it is there to allow distribution of plus code
53over disjunctions. But this doesn't work with single_statement, as the
54plus code has not been distributed to the place that it expects. So the
55only reasonably easy solution seems to be to disallow distribution. *)
56(* inherit attachable is because single_statement doesn't work well when +
57code is attached outside an or, but this has to be allowed after
58isomorphisms have been introduced. So only set it to true then, or when we
59know that the code involved cannot contain a statement, ie it is a
60declaration. *)
61let inherit_attachable = ref false
34e49164
C
62let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) =
63 let lstart = Ast0.get_info left in
64 let lend = Ast0.get_info right in
0708f913
C
65 let pos_info =
66 { Ast0.line_start = lstart.Ast0.pos_info.Ast0.line_start;
67 Ast0.line_end = lend.Ast0.pos_info.Ast0.line_end;
68 Ast0.logical_start = lstart.Ast0.pos_info.Ast0.logical_start;
69 Ast0.logical_end = lend.Ast0.pos_info.Ast0.logical_end;
70 Ast0.column = lstart.Ast0.pos_info.Ast0.column;
71 Ast0.offset = lstart.Ast0.pos_info.Ast0.offset; } in
34e49164 72 let info =
0708f913 73 { Ast0.pos_info = pos_info;
978fd7e5
C
74 Ast0.attachable_start = if !inherit_attachable then astart else false;
75 Ast0.attachable_end = if !inherit_attachable then aend else false;
34e49164
C
76 Ast0.mcode_start = start_mcodes;
77 Ast0.mcode_end = end_mcodes;
34e49164
C
78 (* only for tokens, not inherited upwards *)
79 Ast0.strings_before = []; Ast0.strings_after = [] } in
80 {x with Ast0.node = e; Ast0.info = info}
81
82(* --------------------------------------------------------------------- *)
faf9a90c 83
34e49164
C
84let get_option fn = function
85 None -> None
86 | Some x -> Some (fn x)
faf9a90c 87
34e49164
C
88(* --------------------------------------------------------------------- *)
89(* --------------------------------------------------------------------- *)
90(* Mcode *)
91
708f4980 92let promote_mcode (_,_,info,mcodekind,_,_) =
34e49164
C
93 let new_info =
94 {info with
95 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
96 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
97
708f4980 98let promote_mcode_plus_one (_,_,info,mcodekind,_,_) =
0708f913
C
99 let new_pos_info =
100 {info.Ast0.pos_info with
101 Ast0.line_start = info.Ast0.pos_info.Ast0.line_start + 1;
102 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_start + 1;
103 Ast0.line_end = info.Ast0.pos_info.Ast0.line_end + 1;
104 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_end + 1; } in
34e49164
C
105 let new_info =
106 {info with
0708f913 107 Ast0.pos_info = new_pos_info;
34e49164
C
108 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
109 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
110
111let promote_to_statement stm mcodekind =
112 let info = Ast0.get_info stm in
0708f913
C
113 let new_pos_info =
114 {info.Ast0.pos_info with
115 Ast0.logical_start = info.Ast0.pos_info.Ast0.logical_end;
116 Ast0.line_start = info.Ast0.pos_info.Ast0.line_end; } in
34e49164
C
117 let new_info =
118 {info with
0708f913 119 Ast0.pos_info = new_pos_info;
34e49164
C
120 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
121 Ast0.attachable_start = true; Ast0.attachable_end = true} in
122 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
123
124let promote_to_statement_start stm mcodekind =
125 let info = Ast0.get_info stm in
0708f913
C
126 let new_pos_info =
127 {info.Ast0.pos_info with
128 Ast0.logical_end = info.Ast0.pos_info.Ast0.logical_start;
129 Ast0.line_end = info.Ast0.pos_info.Ast0.line_start; } in
34e49164
C
130 let new_info =
131 {info with
0708f913 132 Ast0.pos_info = new_pos_info;
34e49164
C
133 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
134 Ast0.attachable_start = true; Ast0.attachable_end = true} in
135 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
136
137(* mcode is good by default *)
708f4980 138let bad_mcode (t,a,info,mcodekind,pos,adj) =
34e49164
C
139 let new_info =
140 {info with Ast0.attachable_start = false; Ast0.attachable_end = false} in
708f4980 141 (t,a,new_info,mcodekind,pos,adj)
34e49164
C
142
143let get_all_start_info l =
144 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l,
145 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l))
146
147let get_all_end_info l =
148 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l,
149 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l))
150
151(* --------------------------------------------------------------------- *)
152(* Dots *)
153
154(* for the logline classification and the mcode field, on both sides, skip
155over initial minus dots, as they don't contribute anything *)
156let dot_list is_dots fn = function
157 [] -> failwith "dots should not be empty"
158 | l ->
159 let get_node l fn =
160 let first = List.hd l in
161 let chosen =
162 match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in
163 (* get the logline decorator and the mcodekind of the chosen node *)
164 fn (Ast0.get_info chosen) in
165 let forward = List.map fn l in
166 let backward = List.rev forward in
167 let (first_attachable,first_mcode) =
168 get_node forward
169 (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
170 let (last_attachable,last_mcode) =
171 get_node backward
172 (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in
173 let first = List.hd forward in
174 let last = List.hd backward in
175 let first_info =
176 { (Ast0.get_info first) with
177 Ast0.attachable_start = first_attachable;
178 Ast0.mcode_start = first_mcode } in
179 let last_info =
180 { (Ast0.get_info last) with
181 Ast0.attachable_end = last_attachable;
182 Ast0.mcode_end = last_mcode } in
183 let first = Ast0.set_info first first_info in
184 let last = Ast0.set_info last last_info in
185 (forward,first,last)
faf9a90c 186
34e49164
C
187let dots is_dots prev fn d =
188 match (prev,Ast0.unwrap d) with
189 (Some prev,Ast0.DOTS([])) ->
190 mkres d (Ast0.DOTS []) prev prev
191 | (None,Ast0.DOTS([])) ->
192 Ast0.set_info d
193 {(Ast0.get_info d)
194 with Ast0.attachable_start = false; Ast0.attachable_end = false}
195 | (_,Ast0.DOTS(x)) ->
196 let (l,lstart,lend) = dot_list is_dots fn x in
197 mkres d (Ast0.DOTS l) lstart lend
198 | (_,Ast0.CIRCLES(x)) ->
199 let (l,lstart,lend) = dot_list is_dots fn x in
200 mkres d (Ast0.CIRCLES l) lstart lend
201 | (_,Ast0.STARS(x)) ->
202 let (l,lstart,lend) = dot_list is_dots fn x in
203 mkres d (Ast0.STARS l) lstart lend
204
205(* --------------------------------------------------------------------- *)
206(* Identifier *)
faf9a90c 207
34e49164
C
208let rec ident i =
209 match Ast0.unwrap i with
951c7801
C
210 Ast0.Id(name) as ui ->
211 let name = promote_mcode name in mkres i ui name name
212 | Ast0.MetaId(name,_,_)
213 | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
214 let name = promote_mcode name in mkres i ui name name
215 | Ast0.OptIdent(id) ->
216 let id = ident id in mkres i (Ast0.OptIdent(id)) id id
217 | Ast0.UniqueIdent(id) ->
218 let id = ident id in mkres i (Ast0.UniqueIdent(id)) id id
faf9a90c 219
34e49164
C
220(* --------------------------------------------------------------------- *)
221(* Expression *)
222
223let is_exp_dots e =
224 match Ast0.unwrap e with
225 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
226 | _ -> false
227
228let rec expression e =
229 match Ast0.unwrap e with
230 Ast0.Ident(id) ->
231 let id = ident id in
232 mkres e (Ast0.Ident(id)) id id
233 | Ast0.Constant(const) as ue ->
234 let ln = promote_mcode const in
235 mkres e ue ln ln
236 | Ast0.FunCall(fn,lp,args,rp) ->
237 let fn = expression fn in
238 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
239 mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
240 | Ast0.Assignment(left,op,right,simple) ->
241 let left = expression left in
242 let right = expression right in
243 mkres e (Ast0.Assignment(left,op,right,simple)) left right
244 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
245 let exp1 = expression exp1 in
246 let exp2 = get_option expression exp2 in
247 let exp3 = expression exp3 in
248 mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
249 | Ast0.Postfix(exp,op) ->
250 let exp = expression exp in
251 mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
252 | Ast0.Infix(exp,op) ->
253 let exp = expression exp in
254 mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
255 | Ast0.Unary(exp,op) ->
256 let exp = expression exp in
257 mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
258 | Ast0.Binary(left,op,right) ->
259 let left = expression left in
260 let right = expression right in
261 mkres e (Ast0.Binary(left,op,right)) left right
262 | Ast0.Nested(left,op,right) ->
263 let left = expression left in
264 let right = expression right in
265 mkres e (Ast0.Nested(left,op,right)) left right
266 | Ast0.Paren(lp,exp,rp) ->
267 mkres e (Ast0.Paren(lp,expression exp,rp))
268 (promote_mcode lp) (promote_mcode rp)
269 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
270 let exp1 = expression exp1 in
271 let exp2 = expression exp2 in
272 mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
273 | Ast0.RecordAccess(exp,pt,field) ->
274 let exp = expression exp in
275 let field = ident field in
276 mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
277 | Ast0.RecordPtAccess(exp,ar,field) ->
278 let exp = expression exp in
279 let field = ident field in
280 mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
281 | Ast0.Cast(lp,ty,rp,exp) ->
282 let exp = expression exp in
283 mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
284 | Ast0.SizeOfExpr(szf,exp) ->
285 let exp = expression exp in
286 mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
287 | Ast0.SizeOfType(szf,lp,ty,rp) ->
faf9a90c 288 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
34e49164
C
289 (promote_mcode szf) (promote_mcode rp)
290 | Ast0.TypeExp(ty) ->
291 let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
292 | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
293 | Ast0.MetaExprList(name,_,_) as ue ->
294 let ln = promote_mcode name in mkres e ue ln ln
295 | Ast0.EComma(cm) ->
fc1ad971 296 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
297 let ln = promote_mcode cm in
298 mkres e (Ast0.EComma(cm)) ln ln
299 | Ast0.DisjExpr(starter,exps,mids,ender) ->
300 let starter = bad_mcode starter in
301 let exps = List.map expression exps in
302 let mids = List.map bad_mcode mids in
303 let ender = bad_mcode ender in
304 mkmultires e (Ast0.DisjExpr(starter,exps,mids,ender))
305 (promote_mcode starter) (promote_mcode ender)
306 (get_all_start_info exps) (get_all_end_info exps)
307 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
308 let exp_dots = dots is_exp_dots None expression exp_dots in
309 let starter = bad_mcode starter in
310 let ender = bad_mcode ender in
311 mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
312 (promote_mcode starter) (promote_mcode ender)
313 | Ast0.Edots(dots,whencode) ->
314 let dots = bad_mcode dots in
315 let ln = promote_mcode dots in
316 mkres e (Ast0.Edots(dots,whencode)) ln ln
317 | Ast0.Ecircles(dots,whencode) ->
318 let dots = bad_mcode dots in
319 let ln = promote_mcode dots in
320 mkres e (Ast0.Ecircles(dots,whencode)) ln ln
321 | Ast0.Estars(dots,whencode) ->
322 let dots = bad_mcode dots in
323 let ln = promote_mcode dots in
324 mkres e (Ast0.Estars(dots,whencode)) ln ln
325 | Ast0.OptExp(exp) ->
326 let exp = expression exp in
327 mkres e (Ast0.OptExp(exp)) exp exp
328 | Ast0.UniqueExp(exp) ->
329 let exp = expression exp in
330 mkres e (Ast0.UniqueExp(exp)) exp exp
331
332and expression_dots x = dots is_exp_dots None expression x
faf9a90c 333
34e49164
C
334(* --------------------------------------------------------------------- *)
335(* Types *)
faf9a90c 336
34e49164
C
337and typeC t =
338 match Ast0.unwrap t with
339 Ast0.ConstVol(cv,ty) ->
340 let ty = typeC ty in
341 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
faf9a90c
C
342 | Ast0.BaseType(ty,strings) as ut ->
343 let first = List.hd strings in
344 let last = List.hd (List.rev strings) in
345 mkres t ut (promote_mcode first) (promote_mcode last)
346 | Ast0.Signed(sgn,None) as ut ->
34e49164 347 mkres t ut (promote_mcode sgn) (promote_mcode sgn)
faf9a90c
C
348 | Ast0.Signed(sgn,Some ty) ->
349 let ty = typeC ty in
350 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
34e49164
C
351 | Ast0.Pointer(ty,star) ->
352 let ty = typeC ty in
353 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
354 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
355 let ty = typeC ty in
356 let params = parameter_list (Some(promote_mcode lp2)) params in
357 mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
358 ty (promote_mcode rp2)
359 | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
360 let ty = typeC ty in
361 let params = parameter_list (Some(promote_mcode lp1)) params in
362 let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
363 mkres t res ty (promote_mcode rp1)
364 | Ast0.FunctionType(None,lp1,params,rp1) ->
365 let params = parameter_list (Some(promote_mcode lp1)) params in
366 let res = Ast0.FunctionType(None,lp1,params,rp1) in
367 mkres t res (promote_mcode lp1) (promote_mcode rp1)
368 | Ast0.Array(ty,lb,size,rb) ->
369 let ty = typeC ty in
370 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
371 ty (promote_mcode rb)
faf9a90c
C
372 | Ast0.EnumName(kind,name) ->
373 let name = ident name in
374 mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name
34e49164
C
375 | Ast0.StructUnionName(kind,Some name) ->
376 let name = ident name in
377 mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
378 | Ast0.StructUnionName(kind,None) ->
379 let mc = promote_mcode kind in
380 mkres t (Ast0.StructUnionName(kind,None)) mc mc
381 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
382 let ty = typeC ty in
383 let decls =
384 dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
385 mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
386 | Ast0.TypeName(name) as ut ->
387 let ln = promote_mcode name in mkres t ut ln ln
388 | Ast0.MetaType(name,_) as ut ->
389 let ln = promote_mcode name in mkres t ut ln ln
390 | Ast0.DisjType(starter,types,mids,ender) ->
391 let starter = bad_mcode starter in
392 let types = List.map typeC types in
393 let mids = List.map bad_mcode mids in
394 let ender = bad_mcode ender in
395 mkmultires t (Ast0.DisjType(starter,types,mids,ender))
396 (promote_mcode starter) (promote_mcode ender)
397 (get_all_start_info types) (get_all_end_info types)
398 | Ast0.OptType(ty) ->
399 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
400 | Ast0.UniqueType(ty) ->
401 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
faf9a90c 402
34e49164
C
403(* --------------------------------------------------------------------- *)
404(* Variable declaration *)
405(* Even if the Cocci program specifies a list of declarations, they are
406 split out into multiple declarations of a single variable each. *)
407
408and is_decl_dots s =
409 match Ast0.unwrap s with
410 Ast0.Ddots(_,_) -> true
411 | _ -> false
faf9a90c 412
34e49164
C
413and declaration d =
414 match Ast0.unwrap d with
415 Ast0.Init(stg,ty,id,eq,exp,sem) ->
416 let ty = typeC ty in
417 let id = ident id in
418 let exp = initialiser exp in
419 (match stg with
420 None ->
421 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
faf9a90c 422 | Some x ->
34e49164
C
423 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
424 (promote_mcode x) (promote_mcode sem))
425 | Ast0.UnInit(stg,ty,id,sem) ->
426 let ty = typeC ty in
427 let id = ident id in
428 (match stg with
429 None ->
430 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
431 | Some x ->
432 mkres d (Ast0.UnInit(stg,ty,id,sem))
433 (promote_mcode x) (promote_mcode sem))
434 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
435 let name = ident name in
436 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
437 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
438 | Ast0.TyDecl(ty,sem) ->
439 let ty = typeC ty in
440 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
441 | Ast0.Typedef(stg,ty,id,sem) ->
442 let ty = typeC ty in
443 let id = typeC id in
444 mkres d (Ast0.Typedef(stg,ty,id,sem))
445 (promote_mcode stg) (promote_mcode sem)
446 | Ast0.DisjDecl(starter,decls,mids,ender) ->
447 let starter = bad_mcode starter in
448 let decls = List.map declaration decls in
449 let mids = List.map bad_mcode mids in
450 let ender = bad_mcode ender in
451 mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
452 (promote_mcode starter) (promote_mcode ender)
453 (get_all_start_info decls) (get_all_end_info decls)
454 | Ast0.Ddots(dots,whencode) ->
455 let dots = bad_mcode dots in
456 let ln = promote_mcode dots in
457 mkres d (Ast0.Ddots(dots,whencode)) ln ln
458 | Ast0.OptDecl(decl) ->
459 let decl = declaration decl in
460 mkres d (Ast0.OptDecl(declaration decl)) decl decl
461 | Ast0.UniqueDecl(decl) ->
462 let decl = declaration decl in
463 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
464
465(* --------------------------------------------------------------------- *)
466(* Initializer *)
467
468and is_init_dots i =
469 match Ast0.unwrap i with
470 Ast0.Idots(_,_) -> true
471 | _ -> false
faf9a90c 472
34e49164
C
473and initialiser i =
474 match Ast0.unwrap i with
113803cf
C
475 Ast0.MetaInit(name,_) as ut ->
476 let ln = promote_mcode name in mkres i ut ln ln
477 | Ast0.InitExpr(exp) ->
34e49164
C
478 let exp = expression exp in
479 mkres i (Ast0.InitExpr(exp)) exp exp
480 | Ast0.InitList(lb,initlist,rb) ->
481 let initlist =
482 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
483 mkres i (Ast0.InitList(lb,initlist,rb))
484 (promote_mcode lb) (promote_mcode rb)
113803cf
C
485 | Ast0.InitGccExt(designators,eq,ini) ->
486 let (delims,designators) = (* non empty due to parsing *)
487 List.split (List.map designator designators) in
34e49164 488 let ini = initialiser ini in
113803cf
C
489 mkres i (Ast0.InitGccExt(designators,eq,ini))
490 (promote_mcode (List.hd delims)) ini
34e49164
C
491 | Ast0.InitGccName(name,eq,ini) ->
492 let name = ident name in
493 let ini = initialiser ini in
494 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
34e49164
C
495 | Ast0.IComma(cm) as up ->
496 let ln = promote_mcode cm in mkres i up ln ln
497 | Ast0.Idots(dots,whencode) ->
498 let dots = bad_mcode dots in
499 let ln = promote_mcode dots in
500 mkres i (Ast0.Idots(dots,whencode)) ln ln
501 | Ast0.OptIni(ini) ->
502 let ini = initialiser ini in
503 mkres i (Ast0.OptIni(ini)) ini ini
504 | Ast0.UniqueIni(ini) ->
505 let ini = initialiser ini in
506 mkres i (Ast0.UniqueIni(ini)) ini ini
507
113803cf
C
508and designator = function
509 Ast0.DesignatorField(dot,id) ->
510 (dot,Ast0.DesignatorField(dot,ident id))
511 | Ast0.DesignatorIndex(lb,exp,rb) ->
512 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
513 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
514 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
515
34e49164
C
516and initialiser_list prev = dots is_init_dots prev initialiser
517
518(* for export *)
519and initialiser_dots x = dots is_init_dots None initialiser x
520
521(* --------------------------------------------------------------------- *)
522(* Parameter *)
523
524and is_param_dots p =
525 match Ast0.unwrap p with
526 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
527 | _ -> false
faf9a90c 528
34e49164
C
529and parameterTypeDef p =
530 match Ast0.unwrap p with
531 Ast0.VoidParam(ty) ->
532 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
533 | Ast0.Param(ty,Some id) ->
534 let id = ident id in
535 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
536 | Ast0.Param(ty,None) ->
537 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
538 | Ast0.MetaParam(name,_) as up ->
539 let ln = promote_mcode name in mkres p up ln ln
540 | Ast0.MetaParamList(name,_,_) as up ->
541 let ln = promote_mcode name in mkres p up ln ln
542 | Ast0.PComma(cm) ->
fc1ad971 543 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
34e49164
C
544 let ln = promote_mcode cm in
545 mkres p (Ast0.PComma(cm)) ln ln
546 | Ast0.Pdots(dots) ->
547 let dots = bad_mcode dots in
548 let ln = promote_mcode dots in
549 mkres p (Ast0.Pdots(dots)) ln ln
550 | Ast0.Pcircles(dots) ->
551 let dots = bad_mcode dots in
552 let ln = promote_mcode dots in
553 mkres p (Ast0.Pcircles(dots)) ln ln
554 | Ast0.OptParam(param) ->
555 let res = parameterTypeDef param in
556 mkres p (Ast0.OptParam(res)) res res
557 | Ast0.UniqueParam(param) ->
558 let res = parameterTypeDef param in
559 mkres p (Ast0.UniqueParam(res)) res res
560
561and parameter_list prev = dots is_param_dots prev parameterTypeDef
562
563(* for export *)
564let parameter_dots x = dots is_param_dots None parameterTypeDef x
565
7f004419
C
566(* --------------------------------------------------------------------- *)
567
568let is_define_param_dots s =
569 match Ast0.unwrap s with
570 Ast0.DPdots(_) | Ast0.DPcircles(_) -> true
571 | _ -> false
572
573let rec define_param p =
574 match Ast0.unwrap p with
575 Ast0.DParam(id) ->
576 let id = ident id in mkres p (Ast0.DParam(id)) id id
577 | Ast0.DPComma(cm) ->
578 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
579 let ln = promote_mcode cm in
580 mkres p (Ast0.DPComma(cm)) ln ln
581 | Ast0.DPdots(dots) ->
582 let dots = bad_mcode dots in
583 let ln = promote_mcode dots in
584 mkres p (Ast0.DPdots(dots)) ln ln
585 | Ast0.DPcircles(dots) ->
586 let dots = bad_mcode dots in
587 let ln = promote_mcode dots in
588 mkres p (Ast0.DPcircles(dots)) ln ln
589 | Ast0.OptDParam(dp) ->
590 let res = define_param dp in
591 mkres p (Ast0.OptDParam(res)) res res
592 | Ast0.UniqueDParam(dp) ->
593 let res = define_param dp in
594 mkres p (Ast0.UniqueDParam(res)) res res
595
596let define_parameters x =
597 match Ast0.unwrap x with
598 Ast0.NoParams -> x (* no info, should be ignored *)
599 | Ast0.DParams(lp,dp,rp) ->
600 let dp = dots is_define_param_dots None define_param dp in
601 let l = promote_mcode lp in
602 let r = promote_mcode rp in
603 mkres x (Ast0.DParams(lp,dp,rp)) l r
604
34e49164
C
605(* --------------------------------------------------------------------- *)
606(* Top-level code *)
607
608let is_stm_dots s =
609 match Ast0.unwrap s with
610 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
611 | _ -> false
faf9a90c 612
34e49164
C
613let rec statement s =
614 let res =
615 match Ast0.unwrap s with
616 Ast0.Decl((_,bef),decl) ->
617 let decl = declaration decl in
618 let left = promote_to_statement_start decl bef in
619 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
faf9a90c 620 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164
C
621 let body =
622 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
623 mkres s (Ast0.Seq(lbrace,body,rbrace))
624 (promote_mcode lbrace) (promote_mcode rbrace)
625 | Ast0.ExprStatement(exp,sem) ->
626 let exp = expression exp in
627 mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
628 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
629 let exp = expression exp in
630 let branch = statement branch in
631 let right = promote_to_statement branch aft in
632 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
633 (promote_mcode iff) right
634 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
635 let exp = expression exp in
636 let branch1 = statement branch1 in
637 let branch2 = statement branch2 in
638 let right = promote_to_statement branch2 aft in
639 mkres s
640 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
641 (Ast0.get_info right,aft)))
642 (promote_mcode iff) right
643 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
644 let exp = expression exp in
645 let body = statement body in
646 let right = promote_to_statement body aft in
647 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
648 (promote_mcode wh) right
649 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
650 let body = statement body in
651 let exp = expression exp in
652 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
653 (promote_mcode d) (promote_mcode sem)
654 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
655 let exp1 = get_option expression exp1 in
656 let exp2 = get_option expression exp2 in
657 let exp3 = get_option expression exp3 in
658 let body = statement body in
659 let right = promote_to_statement body aft in
660 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
661 (Ast0.get_info right,aft)))
662 (promote_mcode fr) right
663 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
664 let nm = ident nm in
665 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
666 let body = statement body in
667 let right = promote_to_statement body aft in
668 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
669 nm right
fc1ad971 670 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164 671 let exp = expression exp in
fc1ad971
C
672 let decls =
673 dots is_stm_dots (Some(promote_mcode lb))
674 statement decls in
34e49164 675 let cases =
fc1ad971
C
676 dots (function _ -> false)
677 (if Ast0.undots decls = []
678 then (Some(promote_mcode lb))
679 else None (* not sure this is right, but not sure the case can
680 arise either *))
681 case_line cases in
34e49164 682 mkres s
fc1ad971 683 (Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb))
34e49164
C
684 (promote_mcode switch) (promote_mcode rb)
685 | Ast0.Break(br,sem) as us ->
686 mkres s us (promote_mcode br) (promote_mcode sem)
687 | Ast0.Continue(cont,sem) as us ->
688 mkres s us (promote_mcode cont) (promote_mcode sem)
689 | Ast0.Label(l,dd) ->
690 let l = ident l in
691 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
692 | Ast0.Goto(goto,id,sem) ->
693 let id = ident id in
faf9a90c 694 mkres s (Ast0.Goto(goto,id,sem))
34e49164
C
695 (promote_mcode goto) (promote_mcode sem)
696 | Ast0.Return(ret,sem) as us ->
697 mkres s us (promote_mcode ret) (promote_mcode sem)
698 | Ast0.ReturnExpr(ret,exp,sem) ->
699 let exp = expression exp in
faf9a90c 700 mkres s (Ast0.ReturnExpr(ret,exp,sem))
34e49164
C
701 (promote_mcode ret) (promote_mcode sem)
702 | Ast0.MetaStmt(name,_)
703 | Ast0.MetaStmtList(name,_) as us ->
704 let ln = promote_mcode name in mkres s us ln ln
705 | Ast0.Exp(exp) ->
706 let exp = expression exp in
707 mkres s (Ast0.Exp(exp)) exp exp
708 | Ast0.TopExp(exp) ->
709 let exp = expression exp in
710 mkres s (Ast0.TopExp(exp)) exp exp
711 | Ast0.Ty(ty) ->
712 let ty = typeC ty in
713 mkres s (Ast0.Ty(ty)) ty ty
1be43e12
C
714 | Ast0.TopInit(init) ->
715 let init = initialiser init in
716 mkres s (Ast0.TopInit(init)) init init
34e49164
C
717 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
718 let starter = bad_mcode starter in
719 let mids = List.map bad_mcode mids in
720 let ender = bad_mcode ender in
721 let rec loop prevs = function
722 [] -> []
723 | stm::stms ->
724 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
725 statement stm)::
726 (loop (List.tl prevs) stms) in
727 let elems = loop (starter::mids) rule_elem_dots_list in
728 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
729 (promote_mcode starter) (promote_mcode ender)
730 (get_all_start_info elems) (get_all_end_info elems)
731 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
732 let starter = bad_mcode starter in
733 let ender = bad_mcode ender in
734 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
735 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
736 (promote_mcode starter) (promote_mcode ender)
737 | Ast0.Dots(dots,whencode) ->
738 let dots = bad_mcode dots in
739 let ln = promote_mcode dots in
740 mkres s (Ast0.Dots(dots,whencode)) ln ln
741 | Ast0.Circles(dots,whencode) ->
742 let dots = bad_mcode dots in
743 let ln = promote_mcode dots in
744 mkres s (Ast0.Circles(dots,whencode)) ln ln
745 | Ast0.Stars(dots,whencode) ->
746 let dots = bad_mcode dots in
747 let ln = promote_mcode dots in
748 mkres s (Ast0.Stars(dots,whencode)) ln ln
749 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
750 let fninfo =
751 List.map
752 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
753 fninfo in
754 let name = ident name in
755 let params = parameter_list (Some(promote_mcode lp)) params in
756 let body =
757 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
758 let left =
759 (* cases on what is leftmost *)
760 match fninfo with
761 [] -> promote_to_statement_start name bef
762 | Ast0.FStorage(stg)::_ ->
763 promote_to_statement_start (promote_mcode stg) bef
764 | Ast0.FType(ty)::_ ->
765 promote_to_statement_start ty bef
766 | Ast0.FInline(inline)::_ ->
767 promote_to_statement_start (promote_mcode inline) bef
768 | Ast0.FAttr(attr)::_ ->
769 promote_to_statement_start (promote_mcode attr) bef in
770 (* pretend it is one line before the start of the function, so that it
771 will catch things defined at top level. We assume that these will not
772 be defined on the same line as the function. This is a HACK.
773 A better approach would be to attach top_level things to this node,
774 and other things to the node after, but that would complicate
775 insert_plus, which doesn't distinguish between different mcodekinds *)
776 let res =
777 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
778 body,rbrace) in
779 (* have to do this test again, because of typing problems - can't save
780 the result, only use it *)
781 (match fninfo with
782 [] -> mkres s res name (promote_mcode rbrace)
783 | Ast0.FStorage(stg)::_ ->
784 mkres s res (promote_mcode stg) (promote_mcode rbrace)
785 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
786 | Ast0.FInline(inline)::_ ->
787 mkres s res (promote_mcode inline) (promote_mcode rbrace)
788 | Ast0.FAttr(attr)::_ ->
789 mkres s res (promote_mcode attr) (promote_mcode rbrace))
faf9a90c 790
34e49164
C
791 | Ast0.Include(inc,stm) ->
792 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
793 | Ast0.Define(def,id,params,body) ->
794 let id = ident id in
7f004419 795 let params = define_parameters params in
34e49164
C
796 let body = dots is_stm_dots None statement body in
797 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
798 | Ast0.OptStm(stm) ->
799 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
800 | Ast0.UniqueStm(stm) ->
801 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
802 Ast0.set_dots_bef_aft res
803 (match Ast0.get_dots_bef_aft res with
804 Ast0.NoDots -> Ast0.NoDots
805 | Ast0.AddingBetweenDots s ->
806 Ast0.AddingBetweenDots(statement s)
807 | Ast0.DroppingBetweenDots s ->
808 Ast0.DroppingBetweenDots(statement s))
809
810and case_line c =
811 match Ast0.unwrap c with
812 Ast0.Default(def,colon,code) ->
813 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
814 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
815 | Ast0.Case(case,exp,colon,code) ->
816 let exp = expression exp in
817 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
818 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
fc1ad971
C
819 | Ast0.DisjCase(starter,case_lines,mids,ender) ->
820 let starter = bad_mcode starter in
821 let case_lines = List.map case_line case_lines in
822 let mids = List.map bad_mcode mids in
823 let ender = bad_mcode ender in
824 mkmultires c (Ast0.DisjCase(starter,case_lines,mids,ender))
825 (promote_mcode starter) (promote_mcode ender)
826 (get_all_start_info case_lines) (get_all_end_info case_lines)
34e49164
C
827 | Ast0.OptCase(case) ->
828 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
829
830and statement_dots x = dots is_stm_dots None statement x
faf9a90c 831
34e49164
C
832(* --------------------------------------------------------------------- *)
833(* Function declaration *)
faf9a90c 834
34e49164
C
835let top_level t =
836 match Ast0.unwrap t with
837 Ast0.FILEINFO(old_file,new_file) -> t
838 | Ast0.DECL(stmt) ->
839 let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
840 | Ast0.CODE(rule_elem_dots) ->
841 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
842 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
843 | Ast0.ERRORWORDS(exps) -> t
844 | Ast0.OTHER(_) -> failwith "eliminated by top_level"
faf9a90c 845
34e49164
C
846(* --------------------------------------------------------------------- *)
847(* Entry points *)
faf9a90c 848
978fd7e5
C
849let compute_lines attachable_or x =
850 inherit_attachable := attachable_or;
851 List.map top_level x
852
853let compute_statement_lines attachable_or x =
854 inherit_attachable := attachable_or;
855 statement x
856
857let compute_statement_dots_lines attachable_or x =
858 inherit_attachable := attachable_or;
859 statement_dots x
faf9a90c 860