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