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.
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.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
;
41 Ast0.offset
= lstart.Ast0.pos_info.Ast0.offset
;} in
43 { Ast0.pos_info = pos_info;
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
;
48 (* only for tokens, not inherited upwards *)
49 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
50 {x
with Ast0.node
= e
; Ast0.info = info}
52 (* This looks like it is there to allow distribution of plus code
53 over disjunctions. But this doesn't work with single_statement, as the
54 plus code has not been distributed to the place that it expects. So the
55 only reasonably easy solution seems to be to disallow distribution. *)
56 (* inherit attachable is because single_statement doesn't work well when +
57 code is attached outside an or, but this has to be allowed after
58 isomorphisms have been introduced. So only set it to true then, or when we
59 know that the code involved cannot contain a statement, ie it is a
61 let inherit_attachable = ref false
62 let 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
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
73 { Ast0.pos_info = pos_info;
74 Ast0.attachable_start
= if !inherit_attachable then astart
else false;
75 Ast0.attachable_end
= if !inherit_attachable then aend
else false;
76 Ast0.mcode_start
= start_mcodes
;
77 Ast0.mcode_end
= end_mcodes
;
78 (* only for tokens, not inherited upwards *)
79 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
80 {x
with Ast0.node
= e
; Ast0.info = info}
82 (* --------------------------------------------------------------------- *)
84 let get_option fn
= function
86 | Some x
-> Some
(fn x
)
88 (* --------------------------------------------------------------------- *)
89 (* --------------------------------------------------------------------- *)
92 let promote_mcode (_
,_
,info,mcodekind
,_
,_
) =
95 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
96 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
98 let promote_mcode_plus_one (_
,_
,info,mcodekind
,_
,_
) =
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
107 Ast0.pos_info = new_pos_info;
108 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
109 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
111 let promote_to_statement stm mcodekind
=
112 let info = Ast0.get_info stm
in
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
119 Ast0.pos_info = new_pos_info;
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
}
124 let promote_to_statement_start stm mcodekind
=
125 let info = Ast0.get_info stm
in
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
132 Ast0.pos_info = new_pos_info;
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
}
137 (* mcode is good by default *)
138 let bad_mcode (t
,a
,info,mcodekind
,pos
,adj
) =
140 {info with Ast0.attachable_start
= false; Ast0.attachable_end
= false} in
141 (t
,a
,new_info,mcodekind
,pos
,adj
)
143 let 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
))
147 let 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
))
151 (* --------------------------------------------------------------------- *)
154 (* for the logline classification and the mcode field, on both sides, skip
155 over initial minus dots, as they don't contribute anything *)
156 let dot_list is_dots fn
= function
157 [] -> failwith
"dots should not be empty"
160 let first = List.hd l
in
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
) =
169 (function x
-> (x
.Ast0.attachable_start
,x
.Ast0.mcode_start
)) in
170 let (last_attachable
,last_mcode
) =
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
176 { (Ast0.get_info
first) with
177 Ast0.attachable_start
= first_attachable
;
178 Ast0.mcode_start
= first_mcode
} in
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
187 let 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
([])) ->
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
205 (* --------------------------------------------------------------------- *)
209 match Ast0.unwrap i
with
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
220 (* --------------------------------------------------------------------- *)
224 match Ast0.unwrap e
with
225 Ast0.Edots
(_
,_
) | Ast0.Ecircles
(_
,_
) | Ast0.Estars
(_
,_
) -> true
228 let rec expression e
=
229 match Ast0.unwrap e
with
232 mkres e
(Ast0.Ident
(id)) id id
233 | Ast0.Constant
(const
) as ue
->
234 let ln = promote_mcode const
in
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
) ->
288 mkres e
(Ast0.SizeOfType
(szf
,lp
,typeC ty
,rp
))
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
296 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
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
332 and expression_dots x
= dots is_exp_dots None
expression x
334 (* --------------------------------------------------------------------- *)
338 match Ast0.unwrap t
with
339 Ast0.ConstVol
(cv
,ty) ->
341 mkres t
(Ast0.ConstVol
(cv
,ty)) (promote_mcode cv
) ty
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
->
347 mkres t ut
(promote_mcode sgn
) (promote_mcode sgn
)
348 | Ast0.Signed
(sgn
,Some
ty) ->
350 mkres t
(Ast0.Signed
(sgn
,Some
ty)) (promote_mcode sgn
) ty
351 | Ast0.Pointer
(ty,star
) ->
353 mkres t
(Ast0.Pointer
(ty,star
)) ty (promote_mcode star
)
354 | Ast0.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
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
) ->
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
) ->
370 mkres t
(Ast0.Array
(ty,lb
,get_option expression size
,rb
))
371 ty (promote_mcode rb
)
372 | Ast0.EnumName
(kind
,name) ->
373 let name = ident name in
374 mkres t
(Ast0.EnumName
(kind
,name)) (promote_mcode kind
) name
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
) ->
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
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. *)
409 match Ast0.unwrap s
with
410 Ast0.Ddots
(_
,_
) -> true
414 match Ast0.unwrap d
with
415 Ast0.Init
(stg
,ty,id,eq
,exp,sem
) ->
418 let exp = initialiser
exp in
421 mkres d
(Ast0.Init
(stg
,ty,id,eq
,exp,sem
)) ty (promote_mcode sem
)
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
) ->
430 mkres d
(Ast0.UnInit
(stg
,ty,id,sem
)) ty (promote_mcode sem
)
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
) ->
440 mkres d
(Ast0.TyDecl
(ty,sem
)) ty (promote_mcode sem
)
441 | Ast0.Typedef
(stg
,ty,id,sem
) ->
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
465 (* --------------------------------------------------------------------- *)
469 match Ast0.unwrap i
with
470 Ast0.Idots
(_
,_
) -> true
474 match Ast0.unwrap i
with
475 Ast0.MetaInit
(name,_
) as ut
->
476 let ln = promote_mcode name in mkres i ut
ln ln
477 | Ast0.InitExpr
(exp) ->
478 let exp = expression exp in
479 mkres i
(Ast0.InitExpr
(exp)) exp exp
480 | Ast0.InitList
(lb
,initlist
,rb
) ->
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
)
485 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
486 let (delims
,designators
) = (* non empty due to parsing *)
487 List.split
(List.map designator designators
) in
488 let ini = initialiser
ini in
489 mkres i
(Ast0.InitGccExt
(designators
,eq
,ini))
490 (promote_mcode (List.hd delims
)) ini
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
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
508 and 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
))
516 and initialiser_list prev
= dots is_init_dots prev initialiser
519 and initialiser_dots x
= dots is_init_dots None initialiser x
521 (* --------------------------------------------------------------------- *)
524 and is_param_dots p
=
525 match Ast0.unwrap p
with
526 Ast0.Pdots
(_
) | Ast0.Pcircles
(_
) -> true
529 and 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) ->
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
543 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
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
561 and parameter_list prev
= dots is_param_dots prev parameterTypeDef
564 let parameter_dots x
= dots is_param_dots None parameterTypeDef x
566 (* --------------------------------------------------------------------- *)
568 let is_define_param_dots s
=
569 match Ast0.unwrap s
with
570 Ast0.DPdots
(_
) | Ast0.DPcircles
(_
) -> true
573 let rec define_param p
=
574 match Ast0.unwrap p
with
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
596 let 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
605 (* --------------------------------------------------------------------- *)
609 match Ast0.unwrap s
with
610 Ast0.Dots
(_
,_
) | Ast0.Circles
(_
,_
) | Ast0.Stars
(_
,_
) -> true
613 let rec statement s
=
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
620 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
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
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
)) ->
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
)))
670 | Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases
,rb
) ->
671 let exp = expression exp in
673 dots is_stm_dots (Some
(promote_mcode lb
))
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
683 (Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases,rb
))
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
) ->
691 mkres s
(Ast0.Label
(l,dd
)) l (promote_mcode dd
)
692 | Ast0.Goto
(goto
,id,sem
) ->
694 mkres s
(Ast0.Goto
(goto
,id,sem
))
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
700 mkres s
(Ast0.ReturnExpr
(ret
,exp,sem
))
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
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
713 mkres s
(Ast0.Ty
(ty)) ty ty
714 | Ast0.TopInit
(init
) ->
715 let init = initialiser
init in
716 mkres s
(Ast0.TopInit
(init)) init init
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
724 (dots is_stm_dots (Some
(promote_mcode_plus_one(List.hd prevs
)))
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
) ->
752 (function Ast0.FType
(ty) -> Ast0.FType
(typeC
ty) | x
-> x
)
754 let name = ident name in
755 let params = parameter_list
(Some
(promote_mcode lp
)) params in
757 dots is_stm_dots (Some
(promote_mcode lbrace
)) statement body in
759 (* cases on what is leftmost *)
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 *)
777 Ast0.FunDecl
((Ast0.get_info
left,bef
),fninfo,name,lp
,params,rp
,lbrace
,
779 (* have to do this test again, because of typing problems - can't save
780 the result, only use it *)
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
))
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) ->
795 let params = define_parameters params in
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
))
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
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)
827 | Ast0.OptCase
(case
) ->
828 let case = case_line
case in mkres c
(Ast0.OptCase
(case)) case case
830 and statement_dots x
= dots is_stm_dots None
statement x
832 (* --------------------------------------------------------------------- *)
833 (* Function declaration *)
836 match Ast0.unwrap t
with
837 Ast0.FILEINFO
(old_file
,new_file
) -> t
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"
846 (* --------------------------------------------------------------------- *)
849 let compute_lines attachable_or x
=
850 inherit_attachable := attachable_or
;
853 let compute_statement_lines attachable_or x
=
854 inherit_attachable := attachable_or
;
857 let compute_statement_dots_lines attachable_or x
=
858 inherit_attachable := attachable_or
;