1 (* Computes starting and ending logical lines for statements and
2 expressions. every node gets an index as well. *)
4 module Ast0
= Ast0_cocci
7 (* --------------------------------------------------------------------- *)
10 let mkres x e left right
=
11 let lstart = Ast0.get_info left
in
12 let lend = Ast0.get_info right
in
14 { Ast0.line_start
= lstart.Ast0.pos_info.Ast0.line_start
;
15 Ast0.line_end
= lend.Ast0.pos_info.Ast0.line_end
;
16 Ast0.logical_start
= lstart.Ast0.pos_info.Ast0.logical_start
;
17 Ast0.logical_end
= lend.Ast0.pos_info.Ast0.logical_end
;
18 Ast0.column
= lstart.Ast0.pos_info.Ast0.column
;
19 Ast0.offset
= lstart.Ast0.pos_info.Ast0.offset
;} in
21 { Ast0.pos_info = pos_info;
22 Ast0.attachable_start
= lstart.Ast0.attachable_start
;
23 Ast0.attachable_end
= lend.Ast0.attachable_end
;
24 Ast0.mcode_start
= lstart.Ast0.mcode_start
;
25 Ast0.mcode_end
= lend.Ast0.mcode_end
;
26 (* only for tokens, not inherited upwards *)
27 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
28 {x
with Ast0.node
= e
; Ast0.info = info}
30 (* This looks like it is there to allow distribution of plus code
31 over disjunctions. But this doesn't work with single_statement, as the
32 plus code has not been distributed to the place that it expects. So the
33 only reasonably easy solution seems to be to disallow distribution. *)
34 (* inherit attachable is because single_statement doesn't work well when +
35 code is attached outside an or, but this has to be allowed after
36 isomorphisms have been introduced. So only set it to true then, or when we
37 know that the code involved cannot contain a statement, ie it is a
39 let inherit_attachable = ref false
40 let mkmultires x e left right
(astart
,start_mcodes
) (aend
,end_mcodes
) =
41 let lstart = Ast0.get_info left
in
42 let lend = Ast0.get_info right
in
44 { Ast0.line_start
= lstart.Ast0.pos_info.Ast0.line_start
;
45 Ast0.line_end
= lend.Ast0.pos_info.Ast0.line_end
;
46 Ast0.logical_start
= lstart.Ast0.pos_info.Ast0.logical_start
;
47 Ast0.logical_end
= lend.Ast0.pos_info.Ast0.logical_end
;
48 Ast0.column
= lstart.Ast0.pos_info.Ast0.column
;
49 Ast0.offset
= lstart.Ast0.pos_info.Ast0.offset
; } in
51 { Ast0.pos_info = pos_info;
52 Ast0.attachable_start
= if !inherit_attachable then astart
else false;
53 Ast0.attachable_end
= if !inherit_attachable then aend
else false;
54 Ast0.mcode_start
= start_mcodes
;
55 Ast0.mcode_end
= end_mcodes
;
56 (* only for tokens, not inherited upwards *)
57 Ast0.strings_before
= []; Ast0.strings_after
= [] } in
58 {x
with Ast0.node
= e
; Ast0.info = info}
60 (* --------------------------------------------------------------------- *)
62 let get_option fn
= function
64 | Some x
-> Some
(fn x
)
66 (* --------------------------------------------------------------------- *)
67 (* --------------------------------------------------------------------- *)
70 let promote_mcode (_
,_
,info,mcodekind
,_
,_
) =
73 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
74 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
76 let promote_mcode_plus_one (_
,_
,info,mcodekind
,_
,_
) =
78 {info.Ast0.pos_info with
79 Ast0.line_start
= info.Ast0.pos_info.Ast0.line_start
+ 1;
80 Ast0.logical_start
= info.Ast0.pos_info.Ast0.logical_start
+ 1;
81 Ast0.line_end
= info.Ast0.pos_info.Ast0.line_end
+ 1;
82 Ast0.logical_end
= info.Ast0.pos_info.Ast0.logical_end
+ 1; } in
85 Ast0.pos_info = new_pos_info;
86 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
]} in
87 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
89 let promote_to_statement stm mcodekind
=
90 let info = Ast0.get_info stm
in
92 {info.Ast0.pos_info with
93 Ast0.logical_start
= info.Ast0.pos_info.Ast0.logical_end
;
94 Ast0.line_start
= info.Ast0.pos_info.Ast0.line_end
; } in
97 Ast0.pos_info = new_pos_info;
98 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
];
99 Ast0.attachable_start
= true; Ast0.attachable_end
= true} in
100 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
102 let promote_to_statement_start stm mcodekind
=
103 let info = Ast0.get_info stm
in
105 {info.Ast0.pos_info with
106 Ast0.logical_end
= info.Ast0.pos_info.Ast0.logical_start
;
107 Ast0.line_end
= info.Ast0.pos_info.Ast0.line_start
; } in
110 Ast0.pos_info = new_pos_info;
111 Ast0.mcode_start
= [mcodekind
]; Ast0.mcode_end
= [mcodekind
];
112 Ast0.attachable_start
= true; Ast0.attachable_end
= true} in
113 {(Ast0.wrap
()) with Ast0.info = new_info; Ast0.mcodekind
= ref mcodekind
}
115 (* mcode is good by default *)
116 let bad_mcode (t
,a
,info,mcodekind
,pos
,adj
) =
118 {info with Ast0.attachable_start
= false; Ast0.attachable_end
= false} in
119 (t
,a
,new_info,mcodekind
,pos
,adj
)
121 let get_all_start_info l
=
122 (List.for_all
(function x
-> (Ast0.get_info x
).Ast0.attachable_start
) l
,
123 List.concat
(List.map
(function x
-> (Ast0.get_info x
).Ast0.mcode_start
) l
))
125 let get_all_end_info l
=
126 (List.for_all
(function x
-> (Ast0.get_info x
).Ast0.attachable_end
) l
,
127 List.concat
(List.map
(function x
-> (Ast0.get_info x
).Ast0.mcode_end
) l
))
129 (* --------------------------------------------------------------------- *)
132 (* for the logline classification and the mcode field, on both sides, skip
133 over initial minus dots, as they don't contribute anything *)
134 let dot_list is_dots fn
= function
135 [] -> failwith
"dots should not be empty"
138 let first = List.hd l
in
140 match (is_dots
first, l
) with (true,_
::x
::_
) -> x
| _
-> first in
141 (* get the logline decorator and the mcodekind of the chosen node *)
142 fn
(Ast0.get_info
chosen) in
143 let forward = List.map fn l
in
144 let backward = List.rev
forward in
145 let (first_attachable
,first_mcode
) =
147 (function x
-> (x
.Ast0.attachable_start
,x
.Ast0.mcode_start
)) in
148 let (last_attachable
,last_mcode
) =
150 (function x
-> (x
.Ast0.attachable_end
,x
.Ast0.mcode_end
)) in
151 let first = List.hd
forward in
152 let last = List.hd
backward in
154 { (Ast0.get_info
first) with
155 Ast0.attachable_start
= first_attachable
;
156 Ast0.mcode_start
= first_mcode
} in
158 { (Ast0.get_info
last) with
159 Ast0.attachable_end
= last_attachable
;
160 Ast0.mcode_end
= last_mcode
} in
161 let first = Ast0.set_info
first first_info in
162 let last = Ast0.set_info
last last_info in
165 let dots is_dots prev fn d
=
166 match (prev
,Ast0.unwrap d
) with
167 (Some prev
,Ast0.DOTS
([])) ->
168 mkres d
(Ast0.DOTS
[]) prev prev
169 | (None
,Ast0.DOTS
([])) ->
172 with Ast0.attachable_start
= false; Ast0.attachable_end
= false}
173 | (_
,Ast0.DOTS
(x
)) ->
174 let (l
,lstart,lend) = dot_list is_dots fn x
in
175 mkres d
(Ast0.DOTS l
) lstart lend
176 | (_
,Ast0.CIRCLES
(x
)) ->
177 let (l
,lstart,lend) = dot_list is_dots fn x
in
178 mkres d
(Ast0.CIRCLES l
) lstart lend
179 | (_
,Ast0.STARS
(x
)) ->
180 let (l
,lstart,lend) = dot_list is_dots fn x
in
181 mkres d
(Ast0.STARS l
) lstart lend
183 (* --------------------------------------------------------------------- *)
187 match Ast0.unwrap i
with
188 Ast0.Id
(name
) as ui
->
189 let name = promote_mcode name in mkres i ui
name name
190 | Ast0.MetaId
(name,_
,_
)
191 | Ast0.MetaFunc
(name,_
,_
) | Ast0.MetaLocalFunc
(name,_
,_
) as ui
->
192 let name = promote_mcode name in mkres i ui
name name
193 | Ast0.OptIdent
(id
) ->
194 let id = ident id in mkres i
(Ast0.OptIdent
(id)) id id
195 | Ast0.UniqueIdent
(id) ->
196 let id = ident id in mkres i
(Ast0.UniqueIdent
(id)) id id
198 (* --------------------------------------------------------------------- *)
202 match Ast0.unwrap e
with
203 Ast0.Edots
(_
,_
) | Ast0.Ecircles
(_
,_
) | Ast0.Estars
(_
,_
) -> true
206 let rec expression e
=
207 match Ast0.unwrap e
with
210 mkres e
(Ast0.Ident
(id)) id id
211 | Ast0.Constant
(const
) as ue
->
212 let ln = promote_mcode const
in
214 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
215 let fn = expression fn in
216 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
217 mkres e
(Ast0.FunCall
(fn,lp
,args,rp
)) fn (promote_mcode rp
)
218 | Ast0.Assignment
(left
,op
,right
,simple
) ->
219 let left = expression left in
220 let right = expression right in
221 mkres e
(Ast0.Assignment
(left,op
,right,simple
)) left right
222 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
223 let exp1 = expression exp1 in
224 let exp2 = get_option expression exp2 in
225 let exp3 = expression exp3 in
226 mkres e
(Ast0.CondExpr
(exp1,why
,exp2,colon
,exp3)) exp1 exp3
227 | Ast0.Postfix
(exp
,op
) ->
228 let exp = expression exp in
229 mkres e
(Ast0.Postfix
(exp,op
)) exp (promote_mcode op
)
230 | Ast0.Infix
(exp,op
) ->
231 let exp = expression exp in
232 mkres e
(Ast0.Infix
(exp,op
)) (promote_mcode op
) exp
233 | Ast0.Unary
(exp,op
) ->
234 let exp = expression exp in
235 mkres e
(Ast0.Unary
(exp,op
)) (promote_mcode op
) exp
236 | Ast0.Binary
(left,op
,right) ->
237 let left = expression left in
238 let right = expression right in
239 mkres e
(Ast0.Binary
(left,op
,right)) left right
240 | Ast0.Nested
(left,op
,right) ->
241 let left = expression left in
242 let right = expression right in
243 mkres e
(Ast0.Nested
(left,op
,right)) left right
244 | Ast0.Paren
(lp
,exp,rp
) ->
245 mkres e
(Ast0.Paren
(lp
,expression exp,rp
))
246 (promote_mcode lp
) (promote_mcode rp
)
247 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
248 let exp1 = expression exp1 in
249 let exp2 = expression exp2 in
250 mkres e
(Ast0.ArrayAccess
(exp1,lb
,exp2,rb
)) exp1 (promote_mcode rb
)
251 | Ast0.RecordAccess
(exp,pt
,field
) ->
252 let exp = expression exp in
253 let field = ident field in
254 mkres e
(Ast0.RecordAccess
(exp,pt
,field)) exp field
255 | Ast0.RecordPtAccess
(exp,ar
,field) ->
256 let exp = expression exp in
257 let field = ident field in
258 mkres e
(Ast0.RecordPtAccess
(exp,ar
,field)) exp field
259 | Ast0.Cast
(lp
,ty
,rp
,exp) ->
260 let exp = expression exp in
261 mkres e
(Ast0.Cast
(lp
,typeC ty
,rp
,exp)) (promote_mcode lp
) exp
262 | Ast0.SizeOfExpr
(szf
,exp) ->
263 let exp = expression exp in
264 mkres e
(Ast0.SizeOfExpr
(szf
,exp)) (promote_mcode szf
) exp
265 | Ast0.SizeOfType
(szf
,lp
,ty
,rp
) ->
266 mkres e
(Ast0.SizeOfType
(szf
,lp
,typeC ty
,rp
))
267 (promote_mcode szf
) (promote_mcode rp
)
268 | Ast0.TypeExp
(ty
) ->
269 let ty = typeC
ty in mkres e
(Ast0.TypeExp
(ty)) ty ty
270 | Ast0.MetaErr
(name,_
,_
) | Ast0.MetaExpr
(name,_
,_
,_
,_
)
271 | Ast0.MetaExprList
(name,_
,_
) as ue
->
272 let ln = promote_mcode name in mkres e ue
ln ln
274 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
275 let ln = promote_mcode cm in
276 mkres e
(Ast0.EComma
(cm)) ln ln
277 | Ast0.DisjExpr
(starter
,exps
,mids
,ender
) ->
278 let starter = bad_mcode starter in
279 let exps = List.map
expression exps in
280 let mids = List.map
bad_mcode mids in
281 let ender = bad_mcode ender in
282 mkmultires e
(Ast0.DisjExpr
(starter,exps,mids,ender))
283 (promote_mcode starter) (promote_mcode ender)
284 (get_all_start_info exps) (get_all_end_info exps)
285 | Ast0.NestExpr
(starter,exp_dots
,ender,whencode
,multi
) ->
286 let exp_dots = dots is_exp_dots None
expression exp_dots in
287 let starter = bad_mcode starter in
288 let ender = bad_mcode ender in
289 mkres e
(Ast0.NestExpr
(starter,exp_dots,ender,whencode
,multi
))
290 (promote_mcode starter) (promote_mcode ender)
291 | Ast0.Edots
(dots,whencode
) ->
292 let dots = bad_mcode dots in
293 let ln = promote_mcode dots in
294 mkres e
(Ast0.Edots
(dots,whencode
)) ln ln
295 | Ast0.Ecircles
(dots,whencode
) ->
296 let dots = bad_mcode dots in
297 let ln = promote_mcode dots in
298 mkres e
(Ast0.Ecircles
(dots,whencode
)) ln ln
299 | Ast0.Estars
(dots,whencode
) ->
300 let dots = bad_mcode dots in
301 let ln = promote_mcode dots in
302 mkres e
(Ast0.Estars
(dots,whencode
)) ln ln
303 | Ast0.OptExp
(exp) ->
304 let exp = expression exp in
305 mkres e
(Ast0.OptExp
(exp)) exp exp
306 | Ast0.UniqueExp
(exp) ->
307 let exp = expression exp in
308 mkres e
(Ast0.UniqueExp
(exp)) exp exp
310 and expression_dots x
= dots is_exp_dots None
expression x
312 (* --------------------------------------------------------------------- *)
316 match Ast0.unwrap t
with
317 Ast0.ConstVol
(cv
,ty) ->
319 mkres t
(Ast0.ConstVol
(cv
,ty)) (promote_mcode cv
) ty
320 | Ast0.BaseType
(ty,strings
) as ut
->
321 let first = List.hd strings
in
322 let last = List.hd
(List.rev strings
) in
323 mkres t ut
(promote_mcode first) (promote_mcode last)
324 | Ast0.Signed
(sgn
,None
) as ut
->
325 mkres t ut
(promote_mcode sgn
) (promote_mcode sgn
)
326 | Ast0.Signed
(sgn
,Some
ty) ->
328 mkres t
(Ast0.Signed
(sgn
,Some
ty)) (promote_mcode sgn
) ty
329 | Ast0.Pointer
(ty,star
) ->
331 mkres t
(Ast0.Pointer
(ty,star
)) ty (promote_mcode star
)
332 | Ast0.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
334 let params = parameter_list
(Some
(promote_mcode lp2
)) params in
335 mkres t
(Ast0.FunctionPointer
(ty,lp1
,star
,rp1
,lp2
,params,rp2
))
336 ty (promote_mcode rp2
)
337 | Ast0.FunctionType
(Some
ty,lp1
,params,rp1
) ->
339 let params = parameter_list
(Some
(promote_mcode lp1
)) params in
340 let res = Ast0.FunctionType
(Some
ty,lp1
,params,rp1
) in
341 mkres t
res ty (promote_mcode rp1
)
342 | Ast0.FunctionType
(None
,lp1
,params,rp1
) ->
343 let params = parameter_list
(Some
(promote_mcode lp1
)) params in
344 let res = Ast0.FunctionType
(None
,lp1
,params,rp1
) in
345 mkres t
res (promote_mcode lp1
) (promote_mcode rp1
)
346 | Ast0.Array
(ty,lb
,size
,rb
) ->
348 mkres t
(Ast0.Array
(ty,lb
,get_option expression size
,rb
))
349 ty (promote_mcode rb
)
350 | Ast0.EnumName
(kind
,name) ->
351 let name = ident name in
352 mkres t
(Ast0.EnumName
(kind
,name)) (promote_mcode kind
) name
353 | Ast0.StructUnionName
(kind
,Some
name) ->
354 let name = ident name in
355 mkres t
(Ast0.StructUnionName
(kind
,Some
name)) (promote_mcode kind
) name
356 | Ast0.StructUnionName
(kind
,None
) ->
357 let mc = promote_mcode kind
in
358 mkres t
(Ast0.StructUnionName
(kind
,None
)) mc mc
359 | Ast0.StructUnionDef
(ty,lb
,decls
,rb
) ->
362 dots is_decl_dots
(Some
(promote_mcode lb
)) declaration
decls in
363 mkres t
(Ast0.StructUnionDef
(ty,lb
,decls,rb
)) ty (promote_mcode rb
)
364 | Ast0.TypeName
(name) as ut
->
365 let ln = promote_mcode name in mkres t ut
ln ln
366 | Ast0.MetaType
(name,_
) as ut
->
367 let ln = promote_mcode name in mkres t ut
ln ln
368 | Ast0.DisjType
(starter,types
,mids,ender) ->
369 let starter = bad_mcode starter in
370 let types = List.map typeC
types in
371 let mids = List.map
bad_mcode mids in
372 let ender = bad_mcode ender in
373 mkmultires t
(Ast0.DisjType
(starter,types,mids,ender))
374 (promote_mcode starter) (promote_mcode ender)
375 (get_all_start_info types) (get_all_end_info types)
376 | Ast0.OptType
(ty) ->
377 let ty = typeC
ty in mkres t
(Ast0.OptType
(ty)) ty ty
378 | Ast0.UniqueType
(ty) ->
379 let ty = typeC
ty in mkres t
(Ast0.UniqueType
(ty)) ty ty
381 (* --------------------------------------------------------------------- *)
382 (* Variable declaration *)
383 (* Even if the Cocci program specifies a list of declarations, they are
384 split out into multiple declarations of a single variable each. *)
387 match Ast0.unwrap s
with
388 Ast0.Ddots
(_
,_
) -> true
392 match Ast0.unwrap d
with
393 Ast0.Init
(stg
,ty,id,eq
,exp,sem
) ->
396 let exp = initialiser
exp in
399 mkres d
(Ast0.Init
(stg
,ty,id,eq
,exp,sem
)) ty (promote_mcode sem
)
401 mkres d
(Ast0.Init
(stg
,ty,id,eq
,exp,sem
))
402 (promote_mcode x
) (promote_mcode sem
))
403 | Ast0.UnInit
(stg
,ty,id,sem
) ->
408 mkres d
(Ast0.UnInit
(stg
,ty,id,sem
)) ty (promote_mcode sem
)
410 mkres d
(Ast0.UnInit
(stg
,ty,id,sem
))
411 (promote_mcode x
) (promote_mcode sem
))
412 | Ast0.MacroDecl
(name,lp
,args,rp
,sem
) ->
413 let name = ident name in
414 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
415 mkres d
(Ast0.MacroDecl
(name,lp
,args,rp
,sem
)) name (promote_mcode sem
)
416 | Ast0.TyDecl
(ty,sem
) ->
418 mkres d
(Ast0.TyDecl
(ty,sem
)) ty (promote_mcode sem
)
419 | Ast0.Typedef
(stg
,ty,id,sem
) ->
422 mkres d
(Ast0.Typedef
(stg
,ty,id,sem
))
423 (promote_mcode stg
) (promote_mcode sem
)
424 | Ast0.DisjDecl
(starter,decls,mids,ender) ->
425 let starter = bad_mcode starter in
426 let decls = List.map declaration
decls in
427 let mids = List.map
bad_mcode mids in
428 let ender = bad_mcode ender in
429 mkmultires d
(Ast0.DisjDecl
(starter,decls,mids,ender))
430 (promote_mcode starter) (promote_mcode ender)
431 (get_all_start_info decls) (get_all_end_info decls)
432 | Ast0.Ddots
(dots,whencode
) ->
433 let dots = bad_mcode dots in
434 let ln = promote_mcode dots in
435 mkres d
(Ast0.Ddots
(dots,whencode
)) ln ln
436 | Ast0.OptDecl
(decl
) ->
437 let decl = declaration
decl in
438 mkres d
(Ast0.OptDecl
(declaration
decl)) decl decl
439 | Ast0.UniqueDecl
(decl) ->
440 let decl = declaration
decl in
441 mkres d
(Ast0.UniqueDecl
(declaration
decl)) decl decl
443 (* --------------------------------------------------------------------- *)
447 match Ast0.unwrap i
with
448 Ast0.Idots
(_
,_
) -> true
452 match Ast0.unwrap i
with
453 Ast0.MetaInit
(name,_
) as ut
->
454 let ln = promote_mcode name in mkres i ut
ln ln
455 | Ast0.InitExpr
(exp) ->
456 let exp = expression exp in
457 mkres i
(Ast0.InitExpr
(exp)) exp exp
458 | Ast0.InitList
(lb
,initlist
,rb
) ->
460 dots is_init_dots
(Some
(promote_mcode lb
)) initialiser
initlist in
461 mkres i
(Ast0.InitList
(lb
,initlist,rb
))
462 (promote_mcode lb
) (promote_mcode rb
)
463 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
464 let (delims
,designators
) = (* non empty due to parsing *)
465 List.split
(List.map designator designators
) in
466 let ini = initialiser
ini in
467 mkres i
(Ast0.InitGccExt
(designators
,eq
,ini))
468 (promote_mcode (List.hd delims
)) ini
469 | Ast0.InitGccName
(name,eq
,ini) ->
470 let name = ident name in
471 let ini = initialiser
ini in
472 mkres i
(Ast0.InitGccName
(name,eq
,ini)) name ini
473 | Ast0.IComma
(cm) as up
->
474 let ln = promote_mcode cm in mkres i up
ln ln
475 | Ast0.Idots
(dots,whencode
) ->
476 let dots = bad_mcode dots in
477 let ln = promote_mcode dots in
478 mkres i
(Ast0.Idots
(dots,whencode
)) ln ln
479 | Ast0.OptIni
(ini) ->
480 let ini = initialiser
ini in
481 mkres i
(Ast0.OptIni
(ini)) ini ini
482 | Ast0.UniqueIni
(ini) ->
483 let ini = initialiser
ini in
484 mkres i
(Ast0.UniqueIni
(ini)) ini ini
486 and designator
= function
487 Ast0.DesignatorField
(dot
,id) ->
488 (dot
,Ast0.DesignatorField
(dot
,ident id))
489 | Ast0.DesignatorIndex
(lb
,exp,rb
) ->
490 (lb
,Ast0.DesignatorIndex
(lb
,expression exp,rb
))
491 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
492 (lb
,Ast0.DesignatorRange
(lb
,expression min
,dots,expression max
,rb
))
494 and initialiser_list prev
= dots is_init_dots prev initialiser
497 and initialiser_dots x
= dots is_init_dots None initialiser x
499 (* --------------------------------------------------------------------- *)
502 and is_param_dots p
=
503 match Ast0.unwrap p
with
504 Ast0.Pdots
(_
) | Ast0.Pcircles
(_
) -> true
507 and parameterTypeDef p
=
508 match Ast0.unwrap p
with
509 Ast0.VoidParam
(ty) ->
510 let ty = typeC
ty in mkres p
(Ast0.VoidParam
(ty)) ty ty
511 | Ast0.Param
(ty,Some
id) ->
513 let ty = typeC
ty in mkres p
(Ast0.Param
(ty,Some
id)) ty id
514 | Ast0.Param
(ty,None
) ->
515 let ty = typeC
ty in mkres p
(Ast0.Param
(ty,None
)) ty ty
516 | Ast0.MetaParam
(name,_
) as up
->
517 let ln = promote_mcode name in mkres p up
ln ln
518 | Ast0.MetaParamList
(name,_
,_
) as up
->
519 let ln = promote_mcode name in mkres p up
ln ln
521 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
522 let ln = promote_mcode cm in
523 mkres p
(Ast0.PComma
(cm)) ln ln
524 | Ast0.Pdots
(dots) ->
525 let dots = bad_mcode dots in
526 let ln = promote_mcode dots in
527 mkres p
(Ast0.Pdots
(dots)) ln ln
528 | Ast0.Pcircles
(dots) ->
529 let dots = bad_mcode dots in
530 let ln = promote_mcode dots in
531 mkres p
(Ast0.Pcircles
(dots)) ln ln
532 | Ast0.OptParam
(param
) ->
533 let res = parameterTypeDef param
in
534 mkres p
(Ast0.OptParam
(res)) res res
535 | Ast0.UniqueParam
(param
) ->
536 let res = parameterTypeDef param
in
537 mkres p
(Ast0.UniqueParam
(res)) res res
539 and parameter_list prev
= dots is_param_dots prev parameterTypeDef
542 let parameter_dots x
= dots is_param_dots None parameterTypeDef x
544 (* --------------------------------------------------------------------- *)
546 let is_define_param_dots s
=
547 match Ast0.unwrap s
with
548 Ast0.DPdots
(_
) | Ast0.DPcircles
(_
) -> true
551 let rec define_param p
=
552 match Ast0.unwrap p
with
554 let id = ident id in mkres p
(Ast0.DParam
(id)) id id
555 | Ast0.DPComma
(cm) ->
556 (*let cm = bad_mcode cm in*) (* why was this bad??? *)
557 let ln = promote_mcode cm in
558 mkres p
(Ast0.DPComma
(cm)) ln ln
559 | Ast0.DPdots
(dots) ->
560 let dots = bad_mcode dots in
561 let ln = promote_mcode dots in
562 mkres p
(Ast0.DPdots
(dots)) ln ln
563 | Ast0.DPcircles
(dots) ->
564 let dots = bad_mcode dots in
565 let ln = promote_mcode dots in
566 mkres p
(Ast0.DPcircles
(dots)) ln ln
567 | Ast0.OptDParam
(dp
) ->
568 let res = define_param dp
in
569 mkres p
(Ast0.OptDParam
(res)) res res
570 | Ast0.UniqueDParam
(dp
) ->
571 let res = define_param dp
in
572 mkres p
(Ast0.UniqueDParam
(res)) res res
574 let define_parameters x
=
575 match Ast0.unwrap x
with
576 Ast0.NoParams
-> x
(* no info, should be ignored *)
577 | Ast0.DParams
(lp
,dp
,rp
) ->
578 let dp = dots is_define_param_dots None
define_param dp in
579 let l = promote_mcode lp
in
580 let r = promote_mcode rp
in
581 mkres x
(Ast0.DParams
(lp
,dp,rp
)) l r
583 (* --------------------------------------------------------------------- *)
587 match Ast0.unwrap s
with
588 Ast0.Dots
(_
,_
) | Ast0.Circles
(_
,_
) | Ast0.Stars
(_
,_
) -> true
591 let rec statement s
=
593 match Ast0.unwrap s
with
594 Ast0.Decl
((_
,bef
),decl) ->
595 let decl = declaration
decl in
596 let left = promote_to_statement_start decl bef
in
597 mkres s
(Ast0.Decl
((Ast0.get_info
left,bef
),decl)) decl decl
598 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
600 dots is_stm_dots (Some
(promote_mcode lbrace
)) statement body in
601 mkres s
(Ast0.Seq
(lbrace
,body,rbrace
))
602 (promote_mcode lbrace
) (promote_mcode rbrace
)
603 | Ast0.ExprStatement
(exp,sem
) ->
604 let exp = expression exp in
605 mkres s
(Ast0.ExprStatement
(exp,sem
)) exp (promote_mcode sem
)
606 | Ast0.IfThen
(iff
,lp
,exp,rp
,branch
,(_
,aft
)) ->
607 let exp = expression exp in
608 let branch = statement branch in
609 let right = promote_to_statement branch aft
in
610 mkres s
(Ast0.IfThen
(iff
,lp
,exp,rp
,branch,(Ast0.get_info
right,aft
)))
611 (promote_mcode iff
) right
612 | Ast0.IfThenElse
(iff
,lp
,exp,rp
,branch1
,els
,branch2
,(_
,aft
)) ->
613 let exp = expression exp in
614 let branch1 = statement branch1 in
615 let branch2 = statement branch2 in
616 let right = promote_to_statement branch2 aft
in
618 (Ast0.IfThenElse
(iff
,lp
,exp,rp
,branch1,els
,branch2,
619 (Ast0.get_info
right,aft
)))
620 (promote_mcode iff
) right
621 | Ast0.While
(wh
,lp
,exp,rp
,body,(_
,aft
)) ->
622 let exp = expression exp in
623 let body = statement body in
624 let right = promote_to_statement body aft
in
625 mkres s
(Ast0.While
(wh
,lp
,exp,rp
,body,(Ast0.get_info
right,aft
)))
626 (promote_mcode wh
) right
627 | Ast0.Do
(d
,body,wh
,lp
,exp,rp
,sem
) ->
628 let body = statement body in
629 let exp = expression exp in
630 mkres s
(Ast0.Do
(d
,body,wh
,lp
,exp,rp
,sem
))
631 (promote_mcode d
) (promote_mcode sem
)
632 | Ast0.For
(fr
,lp
,exp1,sem1
,exp2,sem2
,exp3,rp
,body,(_
,aft
)) ->
633 let exp1 = get_option expression exp1 in
634 let exp2 = get_option expression exp2 in
635 let exp3 = get_option expression exp3 in
636 let body = statement body in
637 let right = promote_to_statement body aft
in
638 mkres s
(Ast0.For
(fr
,lp
,exp1,sem1
,exp2,sem2
,exp3,rp
,body,
639 (Ast0.get_info
right,aft
)))
640 (promote_mcode fr
) right
641 | Ast0.Iterator
(nm
,lp
,args,rp
,body,(_
,aft
)) ->
643 let args = dots is_exp_dots (Some
(promote_mcode lp
)) expression args in
644 let body = statement body in
645 let right = promote_to_statement body aft
in
646 mkres s
(Ast0.Iterator
(nm,lp
,args,rp
,body,(Ast0.get_info
right,aft
)))
648 | Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases
,rb
) ->
649 let exp = expression exp in
651 dots is_stm_dots (Some
(promote_mcode lb
))
654 dots (function _
-> false)
655 (if Ast0.undots
decls = []
656 then (Some
(promote_mcode lb
))
657 else None
(* not sure this is right, but not sure the case can
661 (Ast0.Switch
(switch
,lp
,exp,rp
,lb
,decls,cases,rb
))
662 (promote_mcode switch
) (promote_mcode rb
)
663 | Ast0.Break
(br
,sem
) as us
->
664 mkres s us
(promote_mcode br
) (promote_mcode sem
)
665 | Ast0.Continue
(cont
,sem
) as us
->
666 mkres s us
(promote_mcode cont
) (promote_mcode sem
)
667 | Ast0.Label
(l,dd
) ->
669 mkres s
(Ast0.Label
(l,dd
)) l (promote_mcode dd
)
670 | Ast0.Goto
(goto
,id,sem
) ->
672 mkres s
(Ast0.Goto
(goto
,id,sem
))
673 (promote_mcode goto
) (promote_mcode sem
)
674 | Ast0.Return
(ret
,sem
) as us
->
675 mkres s us
(promote_mcode ret
) (promote_mcode sem
)
676 | Ast0.ReturnExpr
(ret
,exp,sem
) ->
677 let exp = expression exp in
678 mkres s
(Ast0.ReturnExpr
(ret
,exp,sem
))
679 (promote_mcode ret
) (promote_mcode sem
)
680 | Ast0.MetaStmt
(name,_
)
681 | Ast0.MetaStmtList
(name,_
) as us
->
682 let ln = promote_mcode name in mkres s us
ln ln
684 let exp = expression exp in
685 mkres s
(Ast0.Exp
(exp)) exp exp
686 | Ast0.TopExp
(exp) ->
687 let exp = expression exp in
688 mkres s
(Ast0.TopExp
(exp)) exp exp
691 mkres s
(Ast0.Ty
(ty)) ty ty
692 | Ast0.TopInit
(init
) ->
693 let init = initialiser
init in
694 mkres s
(Ast0.TopInit
(init)) init init
695 | Ast0.Disj
(starter,rule_elem_dots_list
,mids,ender) ->
696 let starter = bad_mcode starter in
697 let mids = List.map
bad_mcode mids in
698 let ender = bad_mcode ender in
699 let rec loop prevs
= function
702 (dots is_stm_dots (Some
(promote_mcode_plus_one(List.hd prevs
)))
704 (loop (List.tl prevs
) stms
) in
705 let elems = loop (starter::mids) rule_elem_dots_list
in
706 mkmultires s
(Ast0.Disj
(starter,elems,mids,ender))
707 (promote_mcode starter) (promote_mcode ender)
708 (get_all_start_info elems) (get_all_end_info elems)
709 | Ast0.Nest
(starter,rule_elem_dots
,ender,whencode
,multi
) ->
710 let starter = bad_mcode starter in
711 let ender = bad_mcode ender in
712 let rule_elem_dots = dots is_stm_dots None
statement rule_elem_dots in
713 mkres s
(Ast0.Nest
(starter,rule_elem_dots,ender,whencode
,multi
))
714 (promote_mcode starter) (promote_mcode ender)
715 | Ast0.Dots
(dots,whencode
) ->
716 let dots = bad_mcode dots in
717 let ln = promote_mcode dots in
718 mkres s
(Ast0.Dots
(dots,whencode
)) ln ln
719 | Ast0.Circles
(dots,whencode
) ->
720 let dots = bad_mcode dots in
721 let ln = promote_mcode dots in
722 mkres s
(Ast0.Circles
(dots,whencode
)) ln ln
723 | Ast0.Stars
(dots,whencode
) ->
724 let dots = bad_mcode dots in
725 let ln = promote_mcode dots in
726 mkres s
(Ast0.Stars
(dots,whencode
)) ln ln
727 | Ast0.FunDecl
((_
,bef
),fninfo
,name,lp
,params,rp
,lbrace
,body,rbrace
) ->
730 (function Ast0.FType
(ty) -> Ast0.FType
(typeC
ty) | x
-> x
)
732 let name = ident name in
733 let params = parameter_list
(Some
(promote_mcode lp
)) params in
735 dots is_stm_dots (Some
(promote_mcode lbrace
)) statement body in
737 (* cases on what is leftmost *)
739 [] -> promote_to_statement_start name bef
740 | Ast0.FStorage
(stg
)::_
->
741 promote_to_statement_start (promote_mcode stg
) bef
742 | Ast0.FType
(ty)::_
->
743 promote_to_statement_start ty bef
744 | Ast0.FInline
(inline
)::_
->
745 promote_to_statement_start (promote_mcode inline
) bef
746 | Ast0.FAttr
(attr
)::_
->
747 promote_to_statement_start (promote_mcode attr
) bef
in
748 (* pretend it is one line before the start of the function, so that it
749 will catch things defined at top level. We assume that these will not
750 be defined on the same line as the function. This is a HACK.
751 A better approach would be to attach top_level things to this node,
752 and other things to the node after, but that would complicate
753 insert_plus, which doesn't distinguish between different mcodekinds *)
755 Ast0.FunDecl
((Ast0.get_info
left,bef
),fninfo,name,lp
,params,rp
,lbrace
,
757 (* have to do this test again, because of typing problems - can't save
758 the result, only use it *)
760 [] -> mkres s
res name (promote_mcode rbrace
)
761 | Ast0.FStorage
(stg
)::_
->
762 mkres s
res (promote_mcode stg
) (promote_mcode rbrace
)
763 | Ast0.FType
(ty)::_
-> mkres s
res ty (promote_mcode rbrace
)
764 | Ast0.FInline
(inline
)::_
->
765 mkres s
res (promote_mcode inline
) (promote_mcode rbrace
)
766 | Ast0.FAttr
(attr
)::_
->
767 mkres s
res (promote_mcode attr
) (promote_mcode rbrace
))
769 | Ast0.Include
(inc
,stm
) ->
770 mkres s
(Ast0.Include
(inc
,stm
)) (promote_mcode inc
) (promote_mcode stm
)
771 | Ast0.Define
(def
,id,params,body) ->
773 let params = define_parameters params in
774 let body = dots is_stm_dots None
statement body in
775 mkres s
(Ast0.Define
(def
,id,params,body)) (promote_mcode def
) body
776 | Ast0.OptStm
(stm
) ->
777 let stm = statement stm in mkres s
(Ast0.OptStm
(stm)) stm stm
778 | Ast0.UniqueStm
(stm) ->
779 let stm = statement stm in mkres s
(Ast0.UniqueStm
(stm)) stm stm in
780 Ast0.set_dots_bef_aft
res
781 (match Ast0.get_dots_bef_aft
res with
782 Ast0.NoDots
-> Ast0.NoDots
783 | Ast0.AddingBetweenDots s
->
784 Ast0.AddingBetweenDots
(statement s
)
785 | Ast0.DroppingBetweenDots s
->
786 Ast0.DroppingBetweenDots
(statement s
))
789 match Ast0.unwrap c
with
790 Ast0.Default
(def
,colon
,code
) ->
791 let code = dots is_stm_dots (Some
(promote_mcode colon
)) statement code in
792 mkres c
(Ast0.Default
(def
,colon
,code)) (promote_mcode def
) code
793 | Ast0.Case
(case
,exp,colon
,code) ->
794 let exp = expression exp in
795 let code = dots is_stm_dots (Some
(promote_mcode colon
)) statement code in
796 mkres c
(Ast0.Case
(case
,exp,colon
,code)) (promote_mcode case
) code
797 | Ast0.DisjCase
(starter,case_lines
,mids,ender) ->
798 let starter = bad_mcode starter in
799 let case_lines = List.map case_line
case_lines in
800 let mids = List.map
bad_mcode mids in
801 let ender = bad_mcode ender in
802 mkmultires c
(Ast0.DisjCase
(starter,case_lines,mids,ender))
803 (promote_mcode starter) (promote_mcode ender)
804 (get_all_start_info case_lines) (get_all_end_info case_lines)
805 | Ast0.OptCase
(case
) ->
806 let case = case_line
case in mkres c
(Ast0.OptCase
(case)) case case
808 and statement_dots x
= dots is_stm_dots None
statement x
810 (* --------------------------------------------------------------------- *)
811 (* Function declaration *)
814 match Ast0.unwrap t
with
815 Ast0.FILEINFO
(old_file
,new_file
) -> t
817 let stmt = statement stmt in mkres t
(Ast0.DECL
(stmt)) stmt stmt
818 | Ast0.CODE
(rule_elem_dots) ->
819 let rule_elem_dots = dots is_stm_dots None
statement rule_elem_dots in
820 mkres t
(Ast0.CODE
(rule_elem_dots)) rule_elem_dots rule_elem_dots
821 | Ast0.ERRORWORDS
(exps) -> t
822 | Ast0.OTHER
(_
) -> failwith
"eliminated by top_level"
824 (* --------------------------------------------------------------------- *)
827 let compute_lines attachable_or x
=
828 inherit_attachable := attachable_or
;
831 let compute_statement_lines attachable_or x
=
832 inherit_attachable := attachable_or
;
835 let compute_statement_dots_lines attachable_or x
=
836 inherit_attachable := attachable_or
;