HCoop / bpt / coccinelle.git / blob
? search:


d8a0ed9658c5a12df32c9b0cb662dfd1eec495fd
[bpt/coccinelle.git] / parsing_cocci / ast0toast.ml
1 (*
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
5 *
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
9 *
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
23 (* Arities matter for the minus slice, but not for the plus slice. *)
24
25 (* + only allowed on code in a nest (in_nest = true). ? only allowed on
26 rule_elems, and on subterms if the context is ? also. *)
27
28 module Ast0 = Ast0_cocci
29 module Ast = Ast_cocci
30 module V0 = Visitor_ast0
31 module VT0 = Visitor_ast0_types
32 module V = Visitor_ast
33
34 let unitary = Type_cocci.Unitary
35
36 let ctr = ref 0
37 let get_ctr _ =
38 let c = !ctr in
39 ctr := !ctr + 1;
40 c
41
42 (* --------------------------------------------------------------------- *)
43 (* Move plus tokens from the MINUS and CONTEXT structured nodes to the
44 corresponding leftmost and rightmost mcodes *)
45
46 let inline_mcodes =
47 let bind x y = () in
48 let option_default = () in
49 let mcode _ = () in
50 let do_nothing r k e =
51 k e;
52 let einfo = Ast0.get_info e in
53 match (Ast0.get_mcodekind e) with
54 Ast0.MINUS(replacements) ->
55 (match !replacements with
56 ([],_) -> ()
57 | replacements ->
58 let minus_try = function
59 (true,mc) ->
60 if List.for_all
61 (function
62 Ast0.MINUS(mreplacements) -> true | _ -> false)
63 mc
64 then
65 (List.iter
66 (function
67 Ast0.MINUS(mreplacements) ->
68 mreplacements := replacements
69 | _ -> ())
70 mc;
71 true)
72 else false
73 | _ -> false in
74 if not (minus_try(einfo.Ast0.attachable_start,
75 einfo.Ast0.mcode_start)
76 or
77 minus_try(einfo.Ast0.attachable_end,
78 einfo.Ast0.mcode_end))
79 then
80 failwith "minus tree should not have bad code on both sides")
81 | Ast0.CONTEXT(befaft)
82 | Ast0.MIXED(befaft) ->
83 let concat starter startinfo ender endinfo =
84 let lst =
85 match (starter,ender) with
86 ([],_) -> ender
87 | (_,[]) -> starter
88 | _ ->
89 if startinfo.Ast0.tline_end = endinfo.Ast0.tline_start
90 then (* put them in the same inner list *)
91 let last = List.hd (List.rev starter) in
92 let butlast = List.rev(List.tl(List.rev starter)) in
93 butlast @ (last@(List.hd ender)) :: (List.tl ender)
94 else starter @ ender in
95 (lst,
96 {endinfo with Ast0.tline_start = startinfo.Ast0.tline_start}) in
97 let attach_bef bef beforeinfo = function
98 (true,mcl) ->
99 List.iter
100 (function
101 Ast0.MINUS(mreplacements) ->
102 let (mrepl,tokeninfo) = !mreplacements in
103 mreplacements := concat bef beforeinfo mrepl tokeninfo
104 | Ast0.CONTEXT(mbefaft) ->
105 (match !mbefaft with
106 (Ast.BEFORE(mbef),mbeforeinfo,a) ->
107 let (newbef,newinfo) =
108 concat bef beforeinfo mbef mbeforeinfo in
109 mbefaft := (Ast.BEFORE(newbef),newinfo,a)
110 | (Ast.AFTER(maft),_,a) ->
111 mbefaft :=
112 (Ast.BEFOREAFTER(bef,maft),beforeinfo,a)
113 | (Ast.BEFOREAFTER(mbef,maft),mbeforeinfo,a) ->
114 let (newbef,newinfo) =
115 concat bef beforeinfo mbef mbeforeinfo in
116 mbefaft :=
117 (Ast.BEFOREAFTER(newbef,maft),newinfo,a)
118 | (Ast.NOTHING,_,a) ->
119 mbefaft := (Ast.BEFORE(bef),beforeinfo,a))
120 | _ -> failwith "unexpected annotation")
121 mcl
122 | _ ->
123 failwith
124 "context tree should not have bad code on both sides" in
125 let attach_aft aft afterinfo = function
126 (true,mcl) ->
127 List.iter
128 (function
129 Ast0.MINUS(mreplacements) ->
130 let (mrepl,tokeninfo) = !mreplacements in
131 mreplacements := concat mrepl tokeninfo aft afterinfo
132 | Ast0.CONTEXT(mbefaft) ->
133 (match !mbefaft with
134 (Ast.BEFORE(mbef),b,_) ->
135 mbefaft :=
136 (Ast.BEFOREAFTER(mbef,aft),b,afterinfo)
137 | (Ast.AFTER(maft),b,mafterinfo) ->
138 let (newaft,newinfo) =
139 concat maft mafterinfo aft afterinfo in
140 mbefaft := (Ast.AFTER(newaft),b,newinfo)
141 | (Ast.BEFOREAFTER(mbef,maft),b,mafterinfo) ->
142 let (newaft,newinfo) =
143 concat maft mafterinfo aft afterinfo in
144 mbefaft :=
145 (Ast.BEFOREAFTER(mbef,newaft),b,newinfo)
146 | (Ast.NOTHING,b,_) ->
147 mbefaft := (Ast.AFTER(aft),b,afterinfo))
148 | _ -> failwith "unexpected annotation")
149 mcl
150 | _ ->
151 failwith
152 "context tree should not have bad code on both sides" in
153 (match !befaft with
154 (Ast.BEFORE(bef),beforeinfo,_) ->
155 attach_bef bef beforeinfo
156 (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start)
157 | (Ast.AFTER(aft),_,afterinfo) ->
158 attach_aft aft afterinfo
159 (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
160 | (Ast.BEFOREAFTER(bef,aft),beforeinfo,afterinfo) ->
161 attach_bef bef beforeinfo
162 (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start);
163 attach_aft aft afterinfo
164 (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
165 | (Ast.NOTHING,_,_) -> ())
166 | Ast0.PLUS -> () in
167 V0.flat_combiner bind option_default
168 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
169 mcode mcode
170 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
171 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
172 do_nothing do_nothing do_nothing
173
174 (* --------------------------------------------------------------------- *)
175 (* For function declarations. Can't use the mcode at the root, because that
176 might be mixed when the function contains ()s, where agglomeration of -s is
177 not possible. *)
178
179 let check_allminus =
180 let donothing r k e = k e in
181 let bind x y = x && y in
182 let option_default = true in
183 let mcode (_,_,_,mc,_) =
184 match mc with
185 Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = []
186 | _ -> false in
187
188 (* special case for disj *)
189 let expression r k e =
190 match Ast0.unwrap e with
191 Ast0.DisjExpr(starter,expr_list,mids,ender) ->
192 List.for_all r.VT0.combiner_rec_expression expr_list
193 | _ -> k e in
194
195 let declaration r k e =
196 match Ast0.unwrap e with
197 Ast0.DisjDecl(starter,decls,mids,ender) ->
198 List.for_all r.VT0.combiner_rec_declaration decls
199 | _ -> k e in
200
201 let typeC r k e =
202 match Ast0.unwrap e with
203 Ast0.DisjType(starter,decls,mids,ender) ->
204 List.for_all r.VT0.combiner_rec_typeC decls
205 | _ -> k e in
206
207 let statement r k e =
208 match Ast0.unwrap e with
209 Ast0.Disj(starter,statement_dots_list,mids,ender) ->
210 List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
211 | _ -> k e in
212
213 V0.flat_combiner bind option_default
214 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
215 mcode mcode
216 donothing donothing donothing donothing donothing donothing
217 donothing expression typeC donothing donothing declaration
218 statement donothing donothing
219
220 (* --------------------------------------------------------------------- *)
221 (* --------------------------------------------------------------------- *)
222
223 let get_option fn = function
224 None -> None
225 | Some x -> Some (fn x)
226
227 (* --------------------------------------------------------------------- *)
228 (* --------------------------------------------------------------------- *)
229 (* Mcode *)
230
231 let convert_info info =
232 let strings_to_s l =
233 List.map
234 (function (s,info) -> (s,info.Ast0.line_start,info.Ast0.column))
235 l in
236 { Ast.line = info.Ast0.pos_info.Ast0.line_start;
237 Ast.column = info.Ast0.pos_info.Ast0.column;
238 Ast.strbef = strings_to_s info.Ast0.strings_before;
239 Ast.straft = strings_to_s info.Ast0.strings_after; }
240
241 let convert_mcodekind = function
242 Ast0.MINUS(replacements) ->
243 let (replacements,_) = !replacements in
244 Ast.MINUS(Ast.NoPos,replacements)
245 | Ast0.PLUS -> Ast.PLUS
246 | Ast0.CONTEXT(befaft) ->
247 let (befaft,_,_) = !befaft in Ast.CONTEXT(Ast.NoPos,befaft)
248 | Ast0.MIXED(_) -> failwith "not possible for mcode"
249
250 let pos_mcode(term,_,info,mcodekind,pos) =
251 (* avoids a recursion problem *)
252 (term,convert_info info,convert_mcodekind mcodekind,Ast.NoMetaPos)
253
254 let mcode(term,_,info,mcodekind,pos) =
255 let pos =
256 match !pos with
257 Ast0.MetaPos(pos,constraints,per) ->
258 Ast.MetaPos(pos_mcode pos,constraints,per,unitary,false)
259 | _ -> Ast.NoMetaPos in
260 (term,convert_info info,convert_mcodekind mcodekind,pos)
261
262 (* --------------------------------------------------------------------- *)
263 (* Dots *)
264 let wrap ast line isos =
265 {(Ast.make_term ast) with Ast.node_line = line;
266 Ast.iso_info = isos}
267
268 let rewrap ast0 isos ast =
269 wrap ast ((Ast0.get_info ast0).Ast0.pos_info.Ast0.line_start) isos
270
271 let no_isos = []
272
273 (* no isos on tokens *)
274 let tokenwrap (_,info,_,_) s ast = wrap ast info.Ast.line no_isos
275 let iso_tokenwrap (_,info,_,_) s ast iso = wrap ast info.Ast.line iso
276
277 let dots fn d =
278 rewrap d no_isos
279 (match Ast0.unwrap d with
280 Ast0.DOTS(x) -> Ast.DOTS(List.map fn x)
281 | Ast0.CIRCLES(x) -> Ast.CIRCLES(List.map fn x)
282 | Ast0.STARS(x) -> Ast.STARS(List.map fn x))
283
284 (* --------------------------------------------------------------------- *)
285 (* Identifier *)
286
287 let rec do_isos l = List.map (function (nm,x) -> (nm,anything x)) l
288
289 and ident i =
290 rewrap i (do_isos (Ast0.get_iso i))
291 (match Ast0.unwrap i with
292 Ast0.Id(name) -> Ast.Id(mcode name)
293 | Ast0.MetaId(name,constraints,_) ->
294 let constraints = List.map ident constraints in
295 Ast.MetaId(mcode name,constraints,unitary,false)
296 | Ast0.MetaFunc(name,constraints,_) ->
297 let constraints = List.map ident constraints in
298 Ast.MetaFunc(mcode name,constraints,unitary,false)
299 | Ast0.MetaLocalFunc(name,constraints,_) ->
300 let constraints = List.map ident constraints in
301 Ast.MetaLocalFunc(mcode name,constraints,unitary,false)
302 | Ast0.OptIdent(id) -> Ast.OptIdent(ident id)
303 | Ast0.UniqueIdent(id) -> Ast.UniqueIdent(ident id))
304
305 (* --------------------------------------------------------------------- *)
306 (* Expression *)
307
308 and expression e =
309 let e1 =
310 rewrap e (do_isos (Ast0.get_iso e))
311 (match Ast0.unwrap e with
312 Ast0.Ident(id) -> Ast.Ident(ident id)
313 | Ast0.Constant(const) ->
314 Ast.Constant(mcode const)
315 | Ast0.FunCall(fn,lp,args,rp) ->
316 let fn = expression fn in
317 let lp = mcode lp in
318 let args = dots expression args in
319 let rp = mcode rp in
320 Ast.FunCall(fn,lp,args,rp)
321 | Ast0.Assignment(left,op,right,simple) ->
322 Ast.Assignment(expression left,mcode op,expression right,simple)
323 | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
324 let exp1 = expression exp1 in
325 let why = mcode why in
326 let exp2 = get_option expression exp2 in
327 let colon = mcode colon in
328 let exp3 = expression exp3 in
329 Ast.CondExpr(exp1,why,exp2,colon,exp3)
330 | Ast0.Postfix(exp,op) ->
331 Ast.Postfix(expression exp,mcode op)
332 | Ast0.Infix(exp,op) ->
333 Ast.Infix(expression exp,mcode op)
334 | Ast0.Unary(exp,op) ->
335 Ast.Unary(expression exp,mcode op)
336 | Ast0.Binary(left,op,right) ->
337 Ast.Binary(expression left,mcode op,expression right)
338 | Ast0.Nested(left,op,right) ->
339 Ast.Nested(expression left,mcode op,expression right)
340 | Ast0.Paren(lp,exp,rp) ->
341 Ast.Paren(mcode lp,expression exp,mcode rp)
342 | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
343 Ast.ArrayAccess(expression exp1,mcode lb,expression exp2,mcode rb)
344 | Ast0.RecordAccess(exp,pt,field) ->
345 Ast.RecordAccess(expression exp,mcode pt,ident field)
346 | Ast0.RecordPtAccess(exp,ar,field) ->
347 Ast.RecordPtAccess(expression exp,mcode ar,ident field)
348 | Ast0.Cast(lp,ty,rp,exp) ->
349 Ast.Cast(mcode lp,typeC ty,mcode rp,expression exp)
350 | Ast0.SizeOfExpr(szf,exp) ->
351 Ast.SizeOfExpr(mcode szf,expression exp)
352 | Ast0.SizeOfType(szf,lp,ty,rp) ->
353 Ast.SizeOfType(mcode szf, mcode lp,typeC ty,mcode rp)
354 | Ast0.TypeExp(ty) -> Ast.TypeExp(typeC ty)
355 | Ast0.MetaErr(name,constraints,_) ->
356 let constraints = List.map expression constraints in
357 Ast.MetaErr(mcode name,constraints,unitary,false)
358 | Ast0.MetaExpr(name,constraints,ty,form,_) ->
359 let constraints = List.map expression constraints in
360 Ast.MetaExpr(mcode name,constraints,unitary,ty,form,false)
361 | Ast0.MetaExprList(name,Some lenname,_) ->
362 Ast.MetaExprList(mcode name,Some (mcode lenname,unitary,false),
363 unitary,false)
364 | Ast0.MetaExprList(name,None,_) ->
365 Ast.MetaExprList(mcode name,None,unitary,false)
366 | Ast0.EComma(cm) -> Ast.EComma(mcode cm)
367 | Ast0.DisjExpr(_,exps,_,_) -> Ast.DisjExpr(List.map expression exps)
368 | Ast0.NestExpr(_,exp_dots,_,whencode,multi) ->
369 let whencode = get_option expression whencode in
370 Ast.NestExpr(dots expression exp_dots,whencode,multi)
371 | Ast0.Edots(dots,whencode) ->
372 let dots = mcode dots in
373 let whencode = get_option expression whencode in
374 Ast.Edots(dots,whencode)
375 | Ast0.Ecircles(dots,whencode) ->
376 let dots = mcode dots in
377 let whencode = get_option expression whencode in
378 Ast.Ecircles(dots,whencode)
379 | Ast0.Estars(dots,whencode) ->
380 let dots = mcode dots in
381 let whencode = get_option expression whencode in
382 Ast.Estars(dots,whencode)
383 | Ast0.OptExp(exp) -> Ast.OptExp(expression exp)
384 | Ast0.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in
385 if Ast0.get_test_exp e then Ast.set_test_exp e1 else e1
386
387 and expression_dots ed = dots expression ed
388
389 (* --------------------------------------------------------------------- *)
390 (* Types *)
391
392 and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1
393
394 and typeC t =
395 rewrap t (do_isos (Ast0.get_iso t))
396 (match Ast0.unwrap t with
397 Ast0.ConstVol(cv,ty) ->
398 let rec collect_disjs t =
399 match Ast0.unwrap t with
400 Ast0.DisjType(_,types,_,_) ->
401 if Ast0.get_iso t = []
402 then List.concat (List.map collect_disjs types)
403 else failwith "unexpected iso on a disjtype"
404 | _ -> [t] in
405 let res =
406 List.map
407 (function ty ->
408 Ast.Type
409 (Some (mcode cv),rewrap_iso ty (base_typeC ty)))
410 (collect_disjs ty) in
411 (* one could worry that isos are lost because we flatten the
412 disjunctions. but there should not be isos on the disjunctions
413 themselves. *)
414 (match res with
415 [ty] -> ty
416 | types -> Ast.DisjType(List.map (rewrap t no_isos) types))
417 | Ast0.BaseType(_) | Ast0.Signed(_,_) | Ast0.Pointer(_,_)
418 | Ast0.FunctionPointer(_,_,_,_,_,_,_) | Ast0.FunctionType(_,_,_,_)
419 | Ast0.Array(_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_)
420 | Ast0.StructUnionDef(_,_,_,_) | Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
421 Ast.Type(None,rewrap t no_isos (base_typeC t))
422 | Ast0.DisjType(_,types,_,_) -> Ast.DisjType(List.map typeC types)
423 | Ast0.OptType(ty) -> Ast.OptType(typeC ty)
424 | Ast0.UniqueType(ty) -> Ast.UniqueType(typeC ty))
425
426 and base_typeC t =
427 match Ast0.unwrap t with
428 Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings)
429 | Ast0.Signed(sgn,ty) ->
430 Ast.SignedT(mcode sgn,
431 get_option (function x -> rewrap_iso x (base_typeC x)) ty)
432 | Ast0.Pointer(ty,star) -> Ast.Pointer(typeC ty,mcode star)
433 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
434 Ast.FunctionPointer
435 (typeC ty,mcode lp1,mcode star,mcode rp1,
436 mcode lp2,parameter_list params,mcode rp2)
437 | Ast0.FunctionType(ret,lp,params,rp) ->
438 let allminus = check_allminus.VT0.combiner_rec_typeC t in
439 Ast.FunctionType
440 (allminus,get_option typeC ret,mcode lp,
441 parameter_list params,mcode rp)
442 | Ast0.Array(ty,lb,size,rb) ->
443 Ast.Array(typeC ty,mcode lb,get_option expression size,mcode rb)
444 | Ast0.EnumName(kind,name) ->
445 Ast.EnumName(mcode kind,ident name)
446 | Ast0.StructUnionName(kind,name) ->
447 Ast.StructUnionName(mcode kind,get_option ident name)
448 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
449 Ast.StructUnionDef(typeC ty,mcode lb,
450 dots declaration decls,
451 mcode rb)
452 | Ast0.TypeName(name) -> Ast.TypeName(mcode name)
453 | Ast0.MetaType(name,_) ->
454 Ast.MetaType(mcode name,unitary,false)
455 | _ -> failwith "ast0toast: unexpected type"
456
457 (* --------------------------------------------------------------------- *)
458 (* Variable declaration *)
459 (* Even if the Cocci program specifies a list of declarations, they are
460 split out into multiple declarations of a single variable each. *)
461
462 and declaration d =
463 rewrap d (do_isos (Ast0.get_iso d))
464 (match Ast0.unwrap d with
465 Ast0.Init(stg,ty,id,eq,ini,sem) ->
466 let stg = get_option mcode stg in
467 let ty = typeC ty in
468 let id = ident id in
469 let eq = mcode eq in
470 let ini = initialiser ini in
471 let sem = mcode sem in
472 Ast.Init(stg,ty,id,eq,ini,sem)
473 | Ast0.UnInit(stg,ty,id,sem) ->
474 (match Ast0.unwrap ty with
475 Ast0.FunctionType(tyx,lp1,params,rp1) ->
476 let allminus = check_allminus.VT0.combiner_rec_declaration d in
477 Ast.UnInit(get_option mcode stg,
478 rewrap ty (do_isos (Ast0.get_iso ty))
479 (Ast.Type
480 (None,
481 rewrap ty no_isos
482 (Ast.FunctionType
483 (allminus,get_option typeC tyx,mcode lp1,
484 parameter_list params,mcode rp1)))),
485 ident id,mcode sem)
486 | _ -> Ast.UnInit(get_option mcode stg,typeC ty,ident id,mcode sem))
487 | Ast0.MacroDecl(name,lp,args,rp,sem) ->
488 let name = ident name in
489 let lp = mcode lp in
490 let args = dots expression args in
491 let rp = mcode rp in
492 let sem = mcode sem in
493 Ast.MacroDecl(name,lp,args,rp,sem)
494 | Ast0.TyDecl(ty,sem) -> Ast.TyDecl(typeC ty,mcode sem)
495 | Ast0.Typedef(stg,ty,id,sem) ->
496 let id = typeC id in
497 (match Ast.unwrap id with
498 Ast.Type(None,id) -> (* only MetaType or Id *)
499 Ast.Typedef(mcode stg,typeC ty,id,mcode sem)
500 | _ -> failwith "bad typedef")
501 | Ast0.DisjDecl(_,decls,_,_) -> Ast.DisjDecl(List.map declaration decls)
502 | Ast0.Ddots(dots,whencode) ->
503 let dots = mcode dots in
504 let whencode = get_option declaration whencode in
505 Ast.Ddots(dots,whencode)
506 | Ast0.OptDecl(decl) -> Ast.OptDecl(declaration decl)
507 | Ast0.UniqueDecl(decl) -> Ast.UniqueDecl(declaration decl))
508
509 and declaration_dots l = dots declaration l
510
511 (* --------------------------------------------------------------------- *)
512 (* Initialiser *)
513
514 and strip_idots initlist =
515 match Ast0.unwrap initlist with
516 Ast0.DOTS(x) ->
517 let (whencode,init) =
518 List.fold_left
519 (function (prevwhen,previnit) ->
520 function cur ->
521 match Ast0.unwrap cur with
522 Ast0.Idots(dots,Some whencode) ->
523 (whencode :: prevwhen, previnit)
524 | Ast0.Idots(dots,None) -> (prevwhen,previnit)
525 | _ -> (prevwhen, cur :: previnit))
526 ([],[]) x in
527 (List.rev whencode, List.rev init)
528 | Ast0.CIRCLES(x) | Ast0.STARS(x) -> failwith "not possible for an initlist"
529
530 and initialiser i =
531 rewrap i no_isos
532 (match Ast0.unwrap i with
533 Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false)
534 | Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp)
535 | Ast0.InitList(lb,initlist,rb) ->
536 let (whencode,initlist) = strip_idots initlist in
537 Ast.InitList(mcode lb,List.map initialiser initlist,mcode rb,
538 List.map initialiser whencode)
539 | Ast0.InitGccExt(designators,eq,ini) ->
540 Ast.InitGccExt(List.map designator designators,mcode eq,
541 initialiser ini)
542 | Ast0.InitGccName(name,eq,ini) ->
543 Ast.InitGccName(ident name,mcode eq,initialiser ini)
544 | Ast0.IComma(comma) -> Ast.IComma(mcode comma)
545 | Ast0.Idots(_,_) -> failwith "Idots should have been removed"
546 | Ast0.OptIni(ini) -> Ast.OptIni(initialiser ini)
547 | Ast0.UniqueIni(ini) -> Ast.UniqueIni(initialiser ini))
548
549 and designator = function
550 Ast0.DesignatorField(dot,id) -> Ast.DesignatorField(mcode dot,ident id)
551 | Ast0.DesignatorIndex(lb,exp,rb) ->
552 Ast.DesignatorIndex(mcode lb, expression exp, mcode rb)
553 | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
554 Ast.DesignatorRange(mcode lb,expression min,mcode dots,expression max,
555 mcode rb)
556
557 (* --------------------------------------------------------------------- *)
558 (* Parameter *)
559
560 and parameterTypeDef p =
561 rewrap p no_isos
562 (match Ast0.unwrap p with
563 Ast0.VoidParam(ty) -> Ast.VoidParam(typeC ty)
564 | Ast0.Param(ty,id) -> Ast.Param(typeC ty,get_option ident id)
565 | Ast0.MetaParam(name,_) ->
566 Ast.MetaParam(mcode name,unitary,false)
567 | Ast0.MetaParamList(name,Some lenname,_) ->
568 Ast.MetaParamList(mcode name,Some(mcode lenname,unitary,false),
569 unitary,false)
570 | Ast0.MetaParamList(name,None,_) ->
571 Ast.MetaParamList(mcode name,None,unitary,false)
572 | Ast0.PComma(cm) -> Ast.PComma(mcode cm)
573 | Ast0.Pdots(dots) -> Ast.Pdots(mcode dots)
574 | Ast0.Pcircles(dots) -> Ast.Pcircles(mcode dots)
575 | Ast0.OptParam(param) -> Ast.OptParam(parameterTypeDef param)
576 | Ast0.UniqueParam(param) -> Ast.UniqueParam(parameterTypeDef param))
577
578 and parameter_list l = dots parameterTypeDef l
579
580 (* --------------------------------------------------------------------- *)
581 (* Top-level code *)
582
583 and statement s =
584 let rec statement seqible s =
585 let rewrap_stmt ast0 ast =
586 let befaft =
587 match Ast0.get_dots_bef_aft s with
588 Ast0.NoDots -> Ast.NoDots
589 | Ast0.DroppingBetweenDots s ->
590 Ast.DroppingBetweenDots (statement seqible s,get_ctr())
591 | Ast0.AddingBetweenDots s ->
592 Ast.AddingBetweenDots (statement seqible s,get_ctr()) in
593 Ast.set_dots_bef_aft befaft (rewrap ast0 no_isos ast) in
594 let rewrap_rule_elem ast0 ast =
595 rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in
596 rewrap_stmt s
597 (match Ast0.unwrap s with
598 Ast0.Decl((_,bef),decl) ->
599 Ast.Atomic(rewrap_rule_elem s
600 (Ast.Decl(convert_mcodekind bef,
601 check_allminus.VT0.combiner_rec_statement s,
602 declaration decl)))
603 | Ast0.Seq(lbrace,body,rbrace) ->
604 let lbrace = mcode lbrace in
605 let (decls,body) = separate_decls seqible body in
606 let rbrace = mcode rbrace in
607 Ast.Seq(iso_tokenwrap lbrace s (Ast.SeqStart(lbrace))
608 (do_isos (Ast0.get_iso s)),
609 decls,body,
610 tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
611 | Ast0.ExprStatement(exp,sem) ->
612 Ast.Atomic(rewrap_rule_elem s
613 (Ast.ExprStatement(expression exp,mcode sem)))
614 | Ast0.IfThen(iff,lp,exp,rp,branch,(_,aft)) ->
615 Ast.IfThen
616 (rewrap_rule_elem s
617 (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)),
618 statement Ast.NotSequencible branch,
619 ([],[],[],convert_mcodekind aft))
620 | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,(_,aft)) ->
621 let els = mcode els in
622 Ast.IfThenElse
623 (rewrap_rule_elem s
624 (Ast.IfHeader(mcode iff,mcode lp,expression exp,mcode rp)),
625 statement Ast.NotSequencible branch1,
626 tokenwrap els s (Ast.Else(els)),
627 statement Ast.NotSequencible branch2,
628 ([],[],[],convert_mcodekind aft))
629 | Ast0.While(wh,lp,exp,rp,body,(_,aft)) ->
630 Ast.While(rewrap_rule_elem s
631 (Ast.WhileHeader
632 (mcode wh,mcode lp,expression exp,mcode rp)),
633 statement Ast.NotSequencible body,
634 ([],[],[],convert_mcodekind aft))
635 | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
636 let wh = mcode wh in
637 Ast.Do(rewrap_rule_elem s (Ast.DoHeader(mcode d)),
638 statement Ast.NotSequencible body,
639 tokenwrap wh s
640 (Ast.WhileTail(wh,mcode lp,expression exp,mcode rp,
641 mcode sem)))
642 | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,(_,aft)) ->
643 let fr = mcode fr in
644 let lp = mcode lp in
645 let exp1 = get_option expression exp1 in
646 let sem1 = mcode sem1 in
647 let exp2 = get_option expression exp2 in
648 let sem2= mcode sem2 in
649 let exp3 = get_option expression exp3 in
650 let rp = mcode rp in
651 let body = statement Ast.NotSequencible body in
652 Ast.For(rewrap_rule_elem s
653 (Ast.ForHeader(fr,lp,exp1,sem1,exp2,sem2,exp3,rp)),
654 body,([],[],[],convert_mcodekind aft))
655 | Ast0.Iterator(nm,lp,args,rp,body,(_,aft)) ->
656 Ast.Iterator(rewrap_rule_elem s
657 (Ast.IteratorHeader
658 (ident nm,mcode lp,
659 dots expression args,
660 mcode rp)),
661 statement Ast.NotSequencible body,
662 ([],[],[],convert_mcodekind aft))
663 | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
664 let switch = mcode switch in
665 let lp = mcode lp in
666 let exp = expression exp in
667 let rp = mcode rp in
668 let lb = mcode lb in
669 let cases = List.map case_line (Ast0.undots cases) in
670 let rb = mcode rb in
671 Ast.Switch(rewrap_rule_elem s (Ast.SwitchHeader(switch,lp,exp,rp)),
672 tokenwrap lb s (Ast.SeqStart(lb)),
673 cases,
674 tokenwrap rb s (Ast.SeqEnd(rb)))
675 | Ast0.Break(br,sem) ->
676 Ast.Atomic(rewrap_rule_elem s (Ast.Break(mcode br,mcode sem)))
677 | Ast0.Continue(cont,sem) ->
678 Ast.Atomic(rewrap_rule_elem s (Ast.Continue(mcode cont,mcode sem)))
679 | Ast0.Label(l,dd) ->
680 Ast.Atomic(rewrap_rule_elem s (Ast.Label(ident l,mcode dd)))
681 | Ast0.Goto(goto,l,sem) ->
682 Ast.Atomic
683 (rewrap_rule_elem s (Ast.Goto(mcode goto,ident l,mcode sem)))
684 | Ast0.Return(ret,sem) ->
685 Ast.Atomic(rewrap_rule_elem s (Ast.Return(mcode ret,mcode sem)))
686 | Ast0.ReturnExpr(ret,exp,sem) ->
687 Ast.Atomic
688 (rewrap_rule_elem s
689 (Ast.ReturnExpr(mcode ret,expression exp,mcode sem)))
690 | Ast0.MetaStmt(name,_) ->
691 Ast.Atomic(rewrap_rule_elem s
692 (Ast.MetaStmt(mcode name,unitary,seqible,false)))
693 | Ast0.MetaStmtList(name,_) ->
694 Ast.Atomic(rewrap_rule_elem s
695 (Ast.MetaStmtList(mcode name,unitary,false)))
696 | Ast0.TopExp(exp) ->
697 Ast.Atomic(rewrap_rule_elem s (Ast.TopExp(expression exp)))
698 | Ast0.Exp(exp) ->
699 Ast.Atomic(rewrap_rule_elem s (Ast.Exp(expression exp)))
700 | Ast0.TopInit(init) ->
701 Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
702 | Ast0.Ty(ty) ->
703 Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC ty)))
704 | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
705 Ast.Disj(List.map (function x -> statement_dots seqible x)
706 rule_elem_dots_list)
707 | Ast0.Nest(_,rule_elem_dots,_,whn,multi) ->
708 Ast.Nest
709 (statement_dots Ast.Sequencible rule_elem_dots,
710 List.map
711 (whencode (statement_dots Ast.Sequencible)
712 (statement Ast.NotSequencible))
713 whn,
714 multi,[],[])
715 | Ast0.Dots(d,whn) ->
716 let d = mcode d in
717 let whn =
718 List.map
719 (whencode (statement_dots Ast.Sequencible)
720 (statement Ast.NotSequencible))
721 whn in
722 Ast.Dots(d,whn,[],[])
723 | Ast0.Circles(d,whn) ->
724 let d = mcode d in
725 let whn =
726 List.map
727 (whencode (statement_dots Ast.Sequencible)
728 (statement Ast.NotSequencible))
729 whn in
730 Ast.Circles(d,whn,[],[])
731 | Ast0.Stars(d,whn) ->
732 let d = mcode d in
733 let whn =
734 List.map
735 (whencode (statement_dots Ast.Sequencible)
736 (statement Ast.NotSequencible))
737 whn in
738 Ast.Stars(d,whn,[],[])
739 | Ast0.FunDecl((_,bef),fi,name,lp,params,rp,lbrace,body,rbrace) ->
740 let fi = List.map fninfo fi in
741 let name = ident name in
742 let lp = mcode lp in
743 let params = parameter_list params in
744 let rp = mcode rp in
745 let lbrace = mcode lbrace in
746 let (decls,body) = separate_decls seqible body in
747 let rbrace = mcode rbrace in
748 let allminus = check_allminus.VT0.combiner_rec_statement s in
749 Ast.FunDecl(rewrap_rule_elem s
750 (Ast.FunHeader(convert_mcodekind bef,
751 allminus,fi,name,lp,params,rp)),
752 tokenwrap lbrace s (Ast.SeqStart(lbrace)),
753 decls,body,
754 tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
755 | Ast0.Include(inc,str) ->
756 Ast.Atomic(rewrap_rule_elem s (Ast.Include(mcode inc,mcode str)))
757 | Ast0.Define(def,id,params,body) ->
758 Ast.Define
759 (rewrap_rule_elem s
760 (Ast.DefineHeader
761 (mcode def,ident id, define_parameters params)),
762 statement_dots Ast.NotSequencible (*not sure*) body)
763 | Ast0.OptStm(stm) -> Ast.OptStm(statement seqible stm)
764 | Ast0.UniqueStm(stm) -> Ast.UniqueStm(statement seqible stm))
765
766 and define_parameters p =
767 rewrap p no_isos
768 (match Ast0.unwrap p with
769 Ast0.NoParams -> Ast.NoParams
770 | Ast0.DParams(lp,params,rp) ->
771 Ast.DParams(mcode lp,
772 dots define_param params,
773 mcode rp))
774
775 and define_param p =
776 rewrap p no_isos
777 (match Ast0.unwrap p with
778 Ast0.DParam(id) -> Ast.DParam(ident id)
779 | Ast0.DPComma(comma) -> Ast.DPComma(mcode comma)
780 | Ast0.DPdots(d) -> Ast.DPdots(mcode d)
781 | Ast0.DPcircles(c) -> Ast.DPcircles(mcode c)
782 | Ast0.OptDParam(dp) -> Ast.OptDParam(define_param dp)
783 | Ast0.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp))
784
785 and whencode notfn alwaysfn = function
786 Ast0.WhenNot a -> Ast.WhenNot (notfn a)
787 | Ast0.WhenAlways a -> Ast.WhenAlways (alwaysfn a)
788 | Ast0.WhenModifier(x) -> Ast.WhenModifier(x)
789 | x ->
790 let rewrap_rule_elem ast0 ast =
791 rewrap ast0 (do_isos (Ast0.get_iso ast0)) ast in
792 match x with
793 Ast0.WhenNotTrue(e) ->
794 Ast.WhenNotTrue(rewrap_rule_elem e (Ast.Exp(expression e)))
795 | Ast0.WhenNotFalse(e) ->
796 Ast.WhenNotFalse(rewrap_rule_elem e (Ast.Exp(expression e)))
797 | _ -> failwith "not possible"
798
799 and process_list seqible isos = function
800 [] -> []
801 | x::rest ->
802 let first = statement seqible x in
803 let first =
804 if !Flag.track_iso_usage
805 then Ast.set_isos first (isos@(Ast.get_isos first))
806 else first in
807 (match Ast0.unwrap x with
808 Ast0.Dots(_,_) | Ast0.Nest(_) ->
809 first::(process_list (Ast.SequencibleAfterDots []) no_isos rest)
810 | _ ->
811 first::(process_list Ast.Sequencible no_isos rest))
812
813 and statement_dots seqible d =
814 let isos = do_isos (Ast0.get_iso d) in
815 rewrap d no_isos
816 (match Ast0.unwrap d with
817 Ast0.DOTS(x) -> Ast.DOTS(process_list seqible isos x)
818 | Ast0.CIRCLES(x) -> Ast.CIRCLES(process_list seqible isos x)
819 | Ast0.STARS(x) -> Ast.STARS(process_list seqible isos x))
820
821 and separate_decls seqible d =
822 let rec collect_decls = function
823 [] -> ([],[])
824 | (x::xs) as l ->
825 (match Ast0.unwrap x with
826 Ast0.Decl(_) ->
827 let (decls,other) = collect_decls xs in
828 (x :: decls,other)
829 | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) ->
830 let (decls,other) = collect_decls xs in
831 (match decls with
832 [] -> ([],x::other)
833 | _ -> (x :: decls,other))
834 | Ast0.Disj(starter,stmt_dots_list,mids,ender) ->
835 let disjs = List.map collect_dot_decls stmt_dots_list in
836 let all_decls = List.for_all (function (_,s) -> s=[]) disjs in
837 if all_decls
838 then
839 let (decls,other) = collect_decls xs in
840 (x :: decls,other)
841 else ([],l)
842 | _ -> ([],l))
843
844 and collect_dot_decls d =
845 match Ast0.unwrap d with
846 Ast0.DOTS(x) -> collect_decls x
847 | Ast0.CIRCLES(x) -> collect_decls x
848 | Ast0.STARS(x) -> collect_decls x in
849
850 let process l d fn =
851 let (decls,other) = collect_decls l in
852 (rewrap d no_isos (fn (List.map (statement seqible) decls)),
853 rewrap d no_isos
854 (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in
855 match Ast0.unwrap d with
856 Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x)
857 | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x)
858 | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) in
859
860 statement Ast.Sequencible s
861
862 and fninfo = function
863 Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
864 | Ast0.FType(ty) -> Ast.FType(typeC ty)
865 | Ast0.FInline(inline) -> Ast.FInline(mcode inline)
866 | Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
867
868 and option_to_list = function
869 Some x -> [x]
870 | None -> []
871
872 and case_line c =
873 rewrap c no_isos
874 (match Ast0.unwrap c with
875 Ast0.Default(def,colon,code) ->
876 let def = mcode def in
877 let colon = mcode colon in
878 let code = dots statement code in
879 Ast.CaseLine(rewrap c no_isos (Ast.Default(def,colon)),code)
880 | Ast0.Case(case,exp,colon,code) ->
881 let case = mcode case in
882 let exp = expression exp in
883 let colon = mcode colon in
884 let code = dots statement code in
885 Ast.CaseLine(rewrap c no_isos (Ast.Case(case,exp,colon)),code)
886 | Ast0.OptCase(case) -> Ast.OptCase(case_line case))
887
888 and statement_dots l = dots statement l
889
890 (* --------------------------------------------------------------------- *)
891
892 (* what is possible is only what is at the top level in an iso *)
893 and anything = function
894 Ast0.DotsExprTag(d) -> Ast.ExprDotsTag(expression_dots d)
895 | Ast0.DotsParamTag(d) -> Ast.ParamDotsTag(parameter_list d)
896 | Ast0.DotsInitTag(d) -> failwith "not possible"
897 | Ast0.DotsStmtTag(d) -> Ast.StmtDotsTag(statement_dots d)
898 | Ast0.DotsDeclTag(d) -> Ast.DeclDotsTag(declaration_dots d)
899 | Ast0.DotsCaseTag(d) -> failwith "not possible"
900 | Ast0.IdentTag(d) -> Ast.IdentTag(ident d)
901 | Ast0.ExprTag(d) -> Ast.ExpressionTag(expression d)
902 | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
903 failwith "only in isos, not converted to ast"
904 | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC d)
905 | Ast0.ParamTag(d) -> Ast.ParamTag(parameterTypeDef d)
906 | Ast0.InitTag(d) -> Ast.InitTag(initialiser d)
907 | Ast0.DeclTag(d) -> Ast.DeclarationTag(declaration d)
908 | Ast0.StmtTag(d) -> Ast.StatementTag(statement d)
909 | Ast0.CaseLineTag(d) -> Ast.CaseLineTag(case_line d)
910 | Ast0.TopTag(d) -> Ast.Code(top_level d)
911 | Ast0.IsoWhenTag(_) -> failwith "not possible"
912 | Ast0.IsoWhenTTag(_) -> failwith "not possible"
913 | Ast0.IsoWhenFTag(_) -> failwith "not possible"
914 | Ast0.MetaPosTag _ -> failwith "not possible"
915
916 (* --------------------------------------------------------------------- *)
917 (* Function declaration *)
918 (* top level isos are probably lost to tracking *)
919
920 and top_level t =
921 rewrap t no_isos
922 (match Ast0.unwrap t with
923 Ast0.FILEINFO(old_file,new_file) ->
924 Ast.FILEINFO(mcode old_file,mcode new_file)
925 | Ast0.DECL(stmt) -> Ast.DECL(statement stmt)
926 | Ast0.CODE(rule_elem_dots) ->
927 Ast.CODE(statement_dots rule_elem_dots)
928 | Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps)
929 | Ast0.OTHER(_) -> failwith "eliminated by top_level")
930
931 (* --------------------------------------------------------------------- *)
932 (* Entry point for minus code *)
933
934 (* Inline_mcodes is very important - sends + code attached to the - code
935 down to the mcodes. The functions above can only be used when there is no
936 attached + code, eg in + code itself. *)
937 let ast0toast_toplevel x =
938 inline_mcodes.VT0.combiner_rec_top_level x;
939 top_level x
940
941 let ast0toast name deps dropped exists x is_exp ruletype =
942 List.iter inline_mcodes.VT0.combiner_rec_top_level x;
943 Ast.CocciRule
944 (name,(deps,dropped,exists),List.map top_level x,is_exp,ruletype)
Unnamed repository; edit this file 'description' to name the repository.