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