2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
23 (* Computes starting and ending logical lines for statements and
24 expressions. every node gets an index as well. *)
26 module Ast0 = Ast0_cocci
27 module Ast = Ast_cocci
29 (* --------------------------------------------------------------------- *)
32 let mkres x e left right =
33 let lstart = Ast0.get_info left in
34 let lend = Ast0.get_info right in
36 { Ast0.line_start = lstart.Ast0.line_start;
37 Ast0.line_end = lend.Ast0.line_end;
38 Ast0.logical_start = lstart.Ast0.logical_start;
39 Ast0.logical_end = lend.Ast0.logical_end;
40 Ast0.attachable_start = lstart.Ast0.attachable_start;
41 Ast0.attachable_end = lend.Ast0.attachable_end;
42 Ast0.mcode_start = lstart.Ast0.mcode_start;
43 Ast0.mcode_end = lend.Ast0.mcode_end;
44 Ast0.column = lstart.Ast0.column;
45 Ast0.offset = lstart.Ast0.offset;
46 (* only for tokens, not inherited upwards *)
47 Ast0.strings_before = []; Ast0.strings_after = []} in
48 {x with Ast0.node = e; Ast0.info = info}
50 let mkmultires x e left right (astart,start_mcodes) (aend,end_mcodes) =
51 let lstart = Ast0.get_info left in
52 let lend = Ast0.get_info right in
54 { Ast0.line_start = lstart.Ast0.line_start;
55 Ast0.line_end = lend.Ast0.line_end;
56 Ast0.logical_start = lstart.Ast0.logical_start;
57 Ast0.logical_end = lend.Ast0.logical_end;
58 Ast0.attachable_start = astart;
59 Ast0.attachable_end = aend;
60 Ast0.mcode_start = start_mcodes;
61 Ast0.mcode_end = end_mcodes;
62 Ast0.column = lstart.Ast0.column;
63 Ast0.offset = lstart.Ast0.offset;
64 (* only for tokens, not inherited upwards *)
65 Ast0.strings_before = []; Ast0.strings_after = [] } in
66 {x with Ast0.node = e; Ast0.info = info}
68 (* --------------------------------------------------------------------- *)
70 let get_option fn = function
72 | Some x -> Some (fn x)
74 (* --------------------------------------------------------------------- *)
75 (* --------------------------------------------------------------------- *)
78 let promote_mcode (_,_,info,mcodekind,_) =
81 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
82 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
84 let promote_mcode_plus_one (_,_,info,mcodekind,_) =
87 Ast0.line_start = info.Ast0.line_start + 1;
88 Ast0.logical_start = info.Ast0.logical_start + 1;
89 Ast0.line_end = info.Ast0.line_end + 1;
90 Ast0.logical_end = info.Ast0.logical_end + 1;
91 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind]} in
92 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
94 let promote_to_statement stm mcodekind =
95 let info = Ast0.get_info stm in
98 Ast0.logical_start = info.Ast0.logical_end;
99 Ast0.line_start = info.Ast0.line_end;
100 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
101 Ast0.attachable_start = true; Ast0.attachable_end = true} in
102 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
104 let promote_to_statement_start stm mcodekind =
105 let info = Ast0.get_info stm in
108 Ast0.logical_end = info.Ast0.logical_start;
109 Ast0.line_end = info.Ast0.line_start;
110 Ast0.mcode_start = [mcodekind]; Ast0.mcode_end = [mcodekind];
111 Ast0.attachable_start = true; Ast0.attachable_end = true} in
112 {(Ast0.wrap ()) with Ast0.info = new_info; Ast0.mcodekind = ref mcodekind}
114 (* mcode is good by default *)
115 let bad_mcode (t,a,info,mcodekind,pos) =
117 {info with Ast0.attachable_start = false; Ast0.attachable_end = false} in
118 (t,a,new_info,mcodekind,pos)
120 let get_all_start_info l =
121 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_start) l,
122 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_start) l))
124 let get_all_end_info l =
125 (List.for_all (function x -> (Ast0.get_info x).Ast0.attachable_end) l,
126 List.concat (List.map (function x -> (Ast0.get_info x).Ast0.mcode_end) l))
128 (* --------------------------------------------------------------------- *)
131 (* for the logline classification and the mcode field, on both sides, skip
132 over initial minus dots, as they don't contribute anything *)
133 let dot_list is_dots fn = function
134 [] -> failwith "dots should not be empty"
137 let first = List.hd l in
139 match (is_dots first, l) with (true,_::x::_) -> x | _ -> first in
140 (* get the logline decorator and the mcodekind of the chosen node *)
141 fn (Ast0.get_info chosen) in
142 let forward = List.map fn l in
143 let backward = List.rev forward in
144 let (first_attachable,first_mcode) =
146 (function x -> (x.Ast0.attachable_start,x.Ast0.mcode_start)) in
147 let (last_attachable,last_mcode) =
149 (function x -> (x.Ast0.attachable_end,x.Ast0.mcode_end)) in
150 let first = List.hd forward in
151 let last = List.hd backward in
153 { (Ast0.get_info first) with
154 Ast0.attachable_start = first_attachable;
155 Ast0.mcode_start = first_mcode } in
157 { (Ast0.get_info last) with
158 Ast0.attachable_end = last_attachable;
159 Ast0.mcode_end = last_mcode } in
160 let first = Ast0.set_info first first_info in
161 let last = Ast0.set_info last last_info in
164 let dots is_dots prev fn d =
165 match (prev,Ast0.unwrap d) with
166 (Some prev,Ast0.DOTS([])) ->
167 mkres d (Ast0.DOTS []) prev prev
168 | (None,Ast0.DOTS([])) ->
171 with Ast0.attachable_start = false; Ast0.attachable_end = false}
172 | (_,Ast0.DOTS(x)) ->
173 let (l,lstart,lend) = dot_list is_dots fn x in
174 mkres d (Ast0.DOTS l) lstart lend
175 | (_,Ast0.CIRCLES(x)) ->
176 let (l,lstart,lend) = dot_list is_dots fn x in
177 mkres d (Ast0.CIRCLES l) lstart lend
178 | (_,Ast0.STARS(x)) ->
179 let (l,lstart,lend) = dot_list is_dots fn x in
180 mkres d (Ast0.STARS l) lstart lend
182 (* --------------------------------------------------------------------- *)
186 match Ast0.unwrap i with
187 Ast0.Id(name) as ui ->
188 let name = promote_mcode name in mkres i ui name name
189 | Ast0.MetaId(name,_,_)
190 | Ast0.MetaFunc(name,_,_) | Ast0.MetaLocalFunc(name,_,_) as ui ->
191 let name = promote_mcode name in mkres i ui name name
192 | Ast0.OptIdent(id) ->
193 let id = ident id in mkres i (Ast0.OptIdent(id)) id id
194 | Ast0.UniqueIdent(id) ->
195 let id = ident id in mkres i (Ast0.UniqueIdent(id)) id id
197 (* --------------------------------------------------------------------- *)
201 match Ast0.unwrap e with
202 Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> true
205 let rec expression e =
206 match Ast0.unwrap e with
209 mkres e (Ast0.Ident(id)) id id
210 | Ast0.Constant(const) as ue ->
211 let ln = promote_mcode const in
213 | Ast0.FunCall(fn,lp,args,rp) ->
214 let fn = expression fn in
215 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
216 mkres e (Ast0.FunCall(fn,lp,args,rp)) fn (promote_mcode rp)
217 | Ast0.Assignment(left,op,right,simple) ->
218 let left = expression left in
219 let right = expression right in
220 mkres e (Ast0.Assignment(left,op,right,simple)) left right
221 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
222 let exp1 = expression exp1 in
223 let exp2 = get_option expression exp2 in
224 let exp3 = expression exp3 in
225 mkres e (Ast0.CondExpr(exp1,why,exp2,colon,exp3)) exp1 exp3
226 | Ast0.Postfix(exp,op) ->
227 let exp = expression exp in
228 mkres e (Ast0.Postfix(exp,op)) exp (promote_mcode op)
229 | Ast0.Infix(exp,op) ->
230 let exp = expression exp in
231 mkres e (Ast0.Infix(exp,op)) (promote_mcode op) exp
232 | Ast0.Unary(exp,op) ->
233 let exp = expression exp in
234 mkres e (Ast0.Unary(exp,op)) (promote_mcode op) exp
235 | Ast0.Binary(left,op,right) ->
236 let left = expression left in
237 let right = expression right in
238 mkres e (Ast0.Binary(left,op,right)) left right
239 | Ast0.Nested(left,op,right) ->
240 let left = expression left in
241 let right = expression right in
242 mkres e (Ast0.Nested(left,op,right)) left right
243 | Ast0.Paren(lp,exp,rp) ->
244 mkres e (Ast0.Paren(lp,expression exp,rp))
245 (promote_mcode lp) (promote_mcode rp)
246 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
247 let exp1 = expression exp1 in
248 let exp2 = expression exp2 in
249 mkres e (Ast0.ArrayAccess(exp1,lb,exp2,rb)) exp1 (promote_mcode rb)
250 | Ast0.RecordAccess(exp,pt,field) ->
251 let exp = expression exp in
252 let field = ident field in
253 mkres e (Ast0.RecordAccess(exp,pt,field)) exp field
254 | Ast0.RecordPtAccess(exp,ar,field) ->
255 let exp = expression exp in
256 let field = ident field in
257 mkres e (Ast0.RecordPtAccess(exp,ar,field)) exp field
258 | Ast0.Cast(lp,ty,rp,exp) ->
259 let exp = expression exp in
260 mkres e (Ast0.Cast(lp,typeC ty,rp,exp)) (promote_mcode lp) exp
261 | Ast0.SizeOfExpr(szf,exp) ->
262 let exp = expression exp in
263 mkres e (Ast0.SizeOfExpr(szf,exp)) (promote_mcode szf) exp
264 | Ast0.SizeOfType(szf,lp,ty,rp) ->
265 mkres e (Ast0.SizeOfType(szf,lp,typeC ty,rp))
266 (promote_mcode szf) (promote_mcode rp)
267 | Ast0.TypeExp(ty) ->
268 let ty = typeC ty in mkres e (Ast0.TypeExp(ty)) ty ty
269 | Ast0.MetaErr(name,_,_) | Ast0.MetaExpr(name,_,_,_,_)
270 | Ast0.MetaExprList(name,_,_) as ue ->
271 let ln = promote_mcode name in mkres e ue ln ln
273 let cm = bad_mcode cm in
274 let ln = promote_mcode cm in
275 mkres e (Ast0.EComma(cm)) ln ln
276 | Ast0.DisjExpr(starter,exps,mids,ender) ->
277 let starter = bad_mcode starter in
278 let exps = List.map expression exps in
279 let mids = List.map bad_mcode mids in
280 let ender = bad_mcode ender in
281 mkmultires e (Ast0.DisjExpr(starter,exps,mids,ender))
282 (promote_mcode starter) (promote_mcode ender)
283 (get_all_start_info exps) (get_all_end_info exps)
284 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
285 let exp_dots = dots is_exp_dots None expression exp_dots in
286 let starter = bad_mcode starter in
287 let ender = bad_mcode ender in
288 mkres e (Ast0.NestExpr(starter,exp_dots,ender,whencode,multi))
289 (promote_mcode starter) (promote_mcode ender)
290 | Ast0.Edots(dots,whencode) ->
291 let dots = bad_mcode dots in
292 let ln = promote_mcode dots in
293 mkres e (Ast0.Edots(dots,whencode)) ln ln
294 | Ast0.Ecircles(dots,whencode) ->
295 let dots = bad_mcode dots in
296 let ln = promote_mcode dots in
297 mkres e (Ast0.Ecircles(dots,whencode)) ln ln
298 | Ast0.Estars(dots,whencode) ->
299 let dots = bad_mcode dots in
300 let ln = promote_mcode dots in
301 mkres e (Ast0.Estars(dots,whencode)) ln ln
302 | Ast0.OptExp(exp) ->
303 let exp = expression exp in
304 mkres e (Ast0.OptExp(exp)) exp exp
305 | Ast0.UniqueExp(exp) ->
306 let exp = expression exp in
307 mkres e (Ast0.UniqueExp(exp)) exp exp
309 and expression_dots x = dots is_exp_dots None expression x
311 (* --------------------------------------------------------------------- *)
315 match Ast0.unwrap t with
316 Ast0.ConstVol(cv,ty) ->
318 mkres t (Ast0.ConstVol(cv,ty)) (promote_mcode cv) ty
319 | Ast0.BaseType(ty,strings) as ut ->
320 let first = List.hd strings in
321 let last = List.hd (List.rev strings) in
322 mkres t ut (promote_mcode first) (promote_mcode last)
323 | Ast0.Signed(sgn,None) as ut ->
324 mkres t ut (promote_mcode sgn) (promote_mcode sgn)
325 | Ast0.Signed(sgn,Some ty) ->
327 mkres t (Ast0.Signed(sgn,Some ty)) (promote_mcode sgn) ty
328 | Ast0.Pointer(ty,star) ->
330 mkres t (Ast0.Pointer(ty,star)) ty (promote_mcode star)
331 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
333 let params = parameter_list (Some(promote_mcode lp2)) params in
334 mkres t (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
335 ty (promote_mcode rp2)
336 | Ast0.FunctionType(Some ty,lp1,params,rp1) ->
338 let params = parameter_list (Some(promote_mcode lp1)) params in
339 let res = Ast0.FunctionType(Some ty,lp1,params,rp1) in
340 mkres t res ty (promote_mcode rp1)
341 | Ast0.FunctionType(None,lp1,params,rp1) ->
342 let params = parameter_list (Some(promote_mcode lp1)) params in
343 let res = Ast0.FunctionType(None,lp1,params,rp1) in
344 mkres t res (promote_mcode lp1) (promote_mcode rp1)
345 | Ast0.Array(ty,lb,size,rb) ->
347 mkres t (Ast0.Array(ty,lb,get_option expression size,rb))
348 ty (promote_mcode rb)
349 | Ast0.EnumName(kind,name) ->
350 let name = ident name in
351 mkres t (Ast0.EnumName(kind,name)) (promote_mcode kind) name
352 | Ast0.StructUnionName(kind,Some name) ->
353 let name = ident name in
354 mkres t (Ast0.StructUnionName(kind,Some name)) (promote_mcode kind) name
355 | Ast0.StructUnionName(kind,None) ->
356 let mc = promote_mcode kind in
357 mkres t (Ast0.StructUnionName(kind,None)) mc mc
358 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
361 dots is_decl_dots (Some(promote_mcode lb)) declaration decls in
362 mkres t (Ast0.StructUnionDef(ty,lb,decls,rb)) ty (promote_mcode rb)
363 | Ast0.TypeName(name) as ut ->
364 let ln = promote_mcode name in mkres t ut ln ln
365 | Ast0.MetaType(name,_) as ut ->
366 let ln = promote_mcode name in mkres t ut ln ln
367 | Ast0.DisjType(starter,types,mids,ender) ->
368 let starter = bad_mcode starter in
369 let types = List.map typeC types in
370 let mids = List.map bad_mcode mids in
371 let ender = bad_mcode ender in
372 mkmultires t (Ast0.DisjType(starter,types,mids,ender))
373 (promote_mcode starter) (promote_mcode ender)
374 (get_all_start_info types) (get_all_end_info types)
375 | Ast0.OptType(ty) ->
376 let ty = typeC ty in mkres t (Ast0.OptType(ty)) ty ty
377 | Ast0.UniqueType(ty) ->
378 let ty = typeC ty in mkres t (Ast0.UniqueType(ty)) ty ty
380 (* --------------------------------------------------------------------- *)
381 (* Variable declaration *)
382 (* Even if the Cocci program specifies a list of declarations, they are
383 split out into multiple declarations of a single variable each. *)
386 match Ast0.unwrap s with
387 Ast0.Ddots(_,_) -> true
391 match Ast0.unwrap d with
392 Ast0.Init(stg,ty,id,eq,exp,sem) ->
395 let exp = initialiser exp in
398 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem)) ty (promote_mcode sem)
400 mkres d (Ast0.Init(stg,ty,id,eq,exp,sem))
401 (promote_mcode x) (promote_mcode sem))
402 | Ast0.UnInit(stg,ty,id,sem) ->
407 mkres d (Ast0.UnInit(stg,ty,id,sem)) ty (promote_mcode sem)
409 mkres d (Ast0.UnInit(stg,ty,id,sem))
410 (promote_mcode x) (promote_mcode sem))
411 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
412 let name = ident name in
413 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
414 mkres d (Ast0.MacroDecl(name,lp,args,rp,sem)) name (promote_mcode sem)
415 | Ast0.TyDecl(ty,sem) ->
417 mkres d (Ast0.TyDecl(ty,sem)) ty (promote_mcode sem)
418 | Ast0.Typedef(stg,ty,id,sem) ->
421 mkres d (Ast0.Typedef(stg,ty,id,sem))
422 (promote_mcode stg) (promote_mcode sem)
423 | Ast0.DisjDecl(starter,decls,mids,ender) ->
424 let starter = bad_mcode starter in
425 let decls = List.map declaration decls in
426 let mids = List.map bad_mcode mids in
427 let ender = bad_mcode ender in
428 mkmultires d (Ast0.DisjDecl(starter,decls,mids,ender))
429 (promote_mcode starter) (promote_mcode ender)
430 (get_all_start_info decls) (get_all_end_info decls)
431 | Ast0.Ddots(dots,whencode) ->
432 let dots = bad_mcode dots in
433 let ln = promote_mcode dots in
434 mkres d (Ast0.Ddots(dots,whencode)) ln ln
435 | Ast0.OptDecl(decl) ->
436 let decl = declaration decl in
437 mkres d (Ast0.OptDecl(declaration decl)) decl decl
438 | Ast0.UniqueDecl(decl) ->
439 let decl = declaration decl in
440 mkres d (Ast0.UniqueDecl(declaration decl)) decl decl
442 (* --------------------------------------------------------------------- *)
446 match Ast0.unwrap i with
447 Ast0.Idots(_,_) -> true
451 match Ast0.unwrap i with
452 Ast0.MetaInit(name,_) as ut ->
453 let ln = promote_mcode name in mkres i ut ln ln
454 | Ast0.InitExpr(exp) ->
455 let exp = expression exp in
456 mkres i (Ast0.InitExpr(exp)) exp exp
457 | Ast0.InitList(lb,initlist,rb) ->
459 dots is_init_dots (Some(promote_mcode lb)) initialiser initlist in
460 mkres i (Ast0.InitList(lb,initlist,rb))
461 (promote_mcode lb) (promote_mcode rb)
462 | Ast0.InitGccExt(designators,eq,ini) ->
463 let (delims,designators) = (* non empty due to parsing *)
464 List.split (List.map designator designators) in
465 let ini = initialiser ini in
466 mkres i (Ast0.InitGccExt(designators,eq,ini))
467 (promote_mcode (List.hd delims)) ini
468 | Ast0.InitGccName(name,eq,ini) ->
469 let name = ident name in
470 let ini = initialiser ini in
471 mkres i (Ast0.InitGccName(name,eq,ini)) name ini
472 | Ast0.IComma(cm) as up ->
473 let ln = promote_mcode cm in mkres i up ln ln
474 | Ast0.Idots(dots,whencode) ->
475 let dots = bad_mcode dots in
476 let ln = promote_mcode dots in
477 mkres i (Ast0.Idots(dots,whencode)) ln ln
478 | Ast0.OptIni(ini) ->
479 let ini = initialiser ini in
480 mkres i (Ast0.OptIni(ini)) ini ini
481 | Ast0.UniqueIni(ini) ->
482 let ini = initialiser ini in
483 mkres i (Ast0.UniqueIni(ini)) ini ini
485 and designator = function
486 Ast0.DesignatorField(dot,id) ->
487 (dot,Ast0.DesignatorField(dot,ident id))
488 | Ast0.DesignatorIndex(lb,exp,rb) ->
489 (lb,Ast0.DesignatorIndex(lb,expression exp,rb))
490 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
491 (lb,Ast0.DesignatorRange(lb,expression min,dots,expression max,rb))
493 and initialiser_list prev = dots is_init_dots prev initialiser
496 and initialiser_dots x = dots is_init_dots None initialiser x
498 (* --------------------------------------------------------------------- *)
501 and is_param_dots p =
502 match Ast0.unwrap p with
503 Ast0.Pdots(_) | Ast0.Pcircles(_) -> true
506 and parameterTypeDef p =
507 match Ast0.unwrap p with
508 Ast0.VoidParam(ty) ->
509 let ty = typeC ty in mkres p (Ast0.VoidParam(ty)) ty ty
510 | Ast0.Param(ty,Some id) ->
512 let ty = typeC ty in mkres p (Ast0.Param(ty,Some id)) ty id
513 | Ast0.Param(ty,None) ->
514 let ty = typeC ty in mkres p (Ast0.Param(ty,None)) ty ty
515 | Ast0.MetaParam(name,_) as up ->
516 let ln = promote_mcode name in mkres p up ln ln
517 | Ast0.MetaParamList(name,_,_) as up ->
518 let ln = promote_mcode name in mkres p up ln ln
520 let cm = bad_mcode cm in
521 let ln = promote_mcode cm in
522 mkres p (Ast0.PComma(cm)) ln ln
523 | Ast0.Pdots(dots) ->
524 let dots = bad_mcode dots in
525 let ln = promote_mcode dots in
526 mkres p (Ast0.Pdots(dots)) ln ln
527 | Ast0.Pcircles(dots) ->
528 let dots = bad_mcode dots in
529 let ln = promote_mcode dots in
530 mkres p (Ast0.Pcircles(dots)) ln ln
531 | Ast0.OptParam(param) ->
532 let res = parameterTypeDef param in
533 mkres p (Ast0.OptParam(res)) res res
534 | Ast0.UniqueParam(param) ->
535 let res = parameterTypeDef param in
536 mkres p (Ast0.UniqueParam(res)) res res
538 and parameter_list prev = dots is_param_dots prev parameterTypeDef
541 let parameter_dots x = dots is_param_dots None parameterTypeDef x
543 (* --------------------------------------------------------------------- *)
547 match Ast0.unwrap s with
548 Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
551 let rec statement s =
553 match Ast0.unwrap s with
554 Ast0.Decl((_,bef),decl) ->
555 let decl = declaration decl in
556 let left = promote_to_statement_start decl bef in
557 mkres s (Ast0.Decl((Ast0.get_info left,bef),decl)) decl decl
558 | Ast0.Seq(lbrace,body,rbrace) ->
560 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
561 mkres s (Ast0.Seq(lbrace,body,rbrace))
562 (promote_mcode lbrace) (promote_mcode rbrace)
563 | Ast0.ExprStatement(exp,sem) ->
564 let exp = expression exp in
565 mkres s (Ast0.ExprStatement(exp,sem)) exp (promote_mcode sem)
566 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
567 let exp = expression exp in
568 let branch = statement branch in
569 let right = promote_to_statement branch aft in
570 mkres s (Ast0.IfThen(iff,lp,exp,rp,branch,(Ast0.get_info right,aft)))
571 (promote_mcode iff) right
572 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
573 let exp = expression exp in
574 let branch1 = statement branch1 in
575 let branch2 = statement branch2 in
576 let right = promote_to_statement branch2 aft in
578 (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,
579 (Ast0.get_info right,aft)))
580 (promote_mcode iff) right
581 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
582 let exp = expression exp in
583 let body = statement body in
584 let right = promote_to_statement body aft in
585 mkres s (Ast0.While(wh,lp,exp,rp,body,(Ast0.get_info right,aft)))
586 (promote_mcode wh) right
587 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
588 let body = statement body in
589 let exp = expression exp in
590 mkres s (Ast0.Do(d,body,wh,lp,exp,rp,sem))
591 (promote_mcode d) (promote_mcode sem)
592 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
593 let exp1 = get_option expression exp1 in
594 let exp2 = get_option expression exp2 in
595 let exp3 = get_option expression exp3 in
596 let body = statement body in
597 let right = promote_to_statement body aft in
598 mkres s (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,
599 (Ast0.get_info right,aft)))
600 (promote_mcode fr) right
601 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
603 let args = dots is_exp_dots (Some(promote_mcode lp)) expression args in
604 let body = statement body in
605 let right = promote_to_statement body aft in
606 mkres s (Ast0.Iterator(nm,lp,args,rp,body,(Ast0.get_info right,aft)))
608 | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
609 let exp = expression exp in
611 dots (function _ -> false) (Some(promote_mcode lb)) case_line cases in
613 (Ast0.Switch(switch,lp,exp,rp,lb,cases,rb))
614 (promote_mcode switch) (promote_mcode rb)
615 | Ast0.Break(br,sem) as us ->
616 mkres s us (promote_mcode br) (promote_mcode sem)
617 | Ast0.Continue(cont,sem) as us ->
618 mkres s us (promote_mcode cont) (promote_mcode sem)
619 | Ast0.Label(l,dd) ->
621 mkres s (Ast0.Label(l,dd)) l (promote_mcode dd)
622 | Ast0.Goto(goto,id,sem) ->
624 mkres s (Ast0.Goto(goto,id,sem))
625 (promote_mcode goto) (promote_mcode sem)
626 | Ast0.Return(ret,sem) as us ->
627 mkres s us (promote_mcode ret) (promote_mcode sem)
628 | Ast0.ReturnExpr(ret,exp,sem) ->
629 let exp = expression exp in
630 mkres s (Ast0.ReturnExpr(ret,exp,sem))
631 (promote_mcode ret) (promote_mcode sem)
632 | Ast0.MetaStmt(name,_)
633 | Ast0.MetaStmtList(name,_) as us ->
634 let ln = promote_mcode name in mkres s us ln ln
636 let exp = expression exp in
637 mkres s (Ast0.Exp(exp)) exp exp
638 | Ast0.TopExp(exp) ->
639 let exp = expression exp in
640 mkres s (Ast0.TopExp(exp)) exp exp
643 mkres s (Ast0.Ty(ty)) ty ty
644 | Ast0.TopInit(init) ->
645 let init = initialiser init in
646 mkres s (Ast0.TopInit(init)) init init
647 | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
648 let starter = bad_mcode starter in
649 let mids = List.map bad_mcode mids in
650 let ender = bad_mcode ender in
651 let rec loop prevs = function
654 (dots is_stm_dots (Some(promote_mcode_plus_one(List.hd prevs)))
656 (loop (List.tl prevs) stms) in
657 let elems = loop (starter::mids) rule_elem_dots_list in
658 mkmultires s (Ast0.Disj(starter,elems,mids,ender))
659 (promote_mcode starter) (promote_mcode ender)
660 (get_all_start_info elems) (get_all_end_info elems)
661 | Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi) ->
662 let starter = bad_mcode starter in
663 let ender = bad_mcode ender in
664 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
665 mkres s (Ast0.Nest(starter,rule_elem_dots,ender,whencode,multi))
666 (promote_mcode starter) (promote_mcode ender)
667 | Ast0.Dots(dots,whencode) ->
668 let dots = bad_mcode dots in
669 let ln = promote_mcode dots in
670 mkres s (Ast0.Dots(dots,whencode)) ln ln
671 | Ast0.Circles(dots,whencode) ->
672 let dots = bad_mcode dots in
673 let ln = promote_mcode dots in
674 mkres s (Ast0.Circles(dots,whencode)) ln ln
675 | Ast0.Stars(dots,whencode) ->
676 let dots = bad_mcode dots in
677 let ln = promote_mcode dots in
678 mkres s (Ast0.Stars(dots,whencode)) ln ln
679 | Ast0.FunDecl((_,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
682 (function Ast0.FType(ty) -> Ast0.FType(typeC ty) | x -> x)
684 let name = ident name in
685 let params = parameter_list (Some(promote_mcode lp)) params in
687 dots is_stm_dots (Some(promote_mcode lbrace)) statement body in
689 (* cases on what is leftmost *)
691 [] -> promote_to_statement_start name bef
692 | Ast0.FStorage(stg)::_ ->
693 promote_to_statement_start (promote_mcode stg) bef
694 | Ast0.FType(ty)::_ ->
695 promote_to_statement_start ty bef
696 | Ast0.FInline(inline)::_ ->
697 promote_to_statement_start (promote_mcode inline) bef
698 | Ast0.FAttr(attr)::_ ->
699 promote_to_statement_start (promote_mcode attr) bef in
700 (* pretend it is one line before the start of the function, so that it
701 will catch things defined at top level. We assume that these will not
702 be defined on the same line as the function. This is a HACK.
703 A better approach would be to attach top_level things to this node,
704 and other things to the node after, but that would complicate
705 insert_plus, which doesn't distinguish between different mcodekinds *)
707 Ast0.FunDecl((Ast0.get_info left,bef),fninfo,name,lp,params,rp,lbrace,
709 (* have to do this test again, because of typing problems - can't save
710 the result, only use it *)
712 [] -> mkres s res name (promote_mcode rbrace)
713 | Ast0.FStorage(stg)::_ ->
714 mkres s res (promote_mcode stg) (promote_mcode rbrace)
715 | Ast0.FType(ty)::_ -> mkres s res ty (promote_mcode rbrace)
716 | Ast0.FInline(inline)::_ ->
717 mkres s res (promote_mcode inline) (promote_mcode rbrace)
718 | Ast0.FAttr(attr)::_ ->
719 mkres s res (promote_mcode attr) (promote_mcode rbrace))
721 | Ast0.Include(inc,stm) ->
722 mkres s (Ast0.Include(inc,stm)) (promote_mcode inc) (promote_mcode stm)
723 | Ast0.Define(def,id,params,body) ->
725 let body = dots is_stm_dots None statement body in
726 mkres s (Ast0.Define(def,id,params,body)) (promote_mcode def) body
727 | Ast0.OptStm(stm) ->
728 let stm = statement stm in mkres s (Ast0.OptStm(stm)) stm stm
729 | Ast0.UniqueStm(stm) ->
730 let stm = statement stm in mkres s (Ast0.UniqueStm(stm)) stm stm in
731 Ast0.set_dots_bef_aft res
732 (match Ast0.get_dots_bef_aft res with
733 Ast0.NoDots -> Ast0.NoDots
734 | Ast0.AddingBetweenDots s ->
735 Ast0.AddingBetweenDots(statement s)
736 | Ast0.DroppingBetweenDots s ->
737 Ast0.DroppingBetweenDots(statement s))
740 match Ast0.unwrap c with
741 Ast0.Default(def,colon,code) ->
742 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
743 mkres c (Ast0.Default(def,colon,code)) (promote_mcode def) code
744 | Ast0.Case(case,exp,colon,code) ->
745 let exp = expression exp in
746 let code = dots is_stm_dots (Some(promote_mcode colon)) statement code in
747 mkres c (Ast0.Case(case,exp,colon,code)) (promote_mcode case) code
748 | Ast0.OptCase(case) ->
749 let case = case_line case in mkres c (Ast0.OptCase(case)) case case
751 and statement_dots x = dots is_stm_dots None statement x
753 (* --------------------------------------------------------------------- *)
754 (* Function declaration *)
757 match Ast0.unwrap t with
758 Ast0.FILEINFO(old_file,new_file) -> t
760 let stmt = statement stmt in mkres t (Ast0.DECL(stmt)) stmt stmt
761 | Ast0.CODE(rule_elem_dots) ->
762 let rule_elem_dots = dots is_stm_dots None statement rule_elem_dots in
763 mkres t (Ast0.CODE(rule_elem_dots)) rule_elem_dots rule_elem_dots
764 | Ast0.ERRORWORDS(exps) -> t
765 | Ast0.OTHER(_) -> failwith "eliminated by top_level"
767 (* --------------------------------------------------------------------- *)
770 let compute_lines = List.map top_level