Coccinelle release-1.0.0-rc11
[bpt/coccinelle.git] / parsing_cocci / ast0toast.ml
CommitLineData
f537ebc4 1(*
17ba0788
C
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
f537ebc4
C
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
34e49164
C
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
30rule_elems, and on subterms if the context is ? also. *)
31
32module Ast0 = Ast0_cocci
33module Ast = Ast_cocci
34module V0 = Visitor_ast0
b1b2de81 35module VT0 = Visitor_ast0_types
34e49164
C
36
37let unitary = Type_cocci.Unitary
38
39let ctr = ref 0
40let 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
47corresponding leftmost and rightmost mcodes *)
48
49let 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
8babbc8f 59 (Ast.NOREPLACEMENT,_) -> ()
34e49164
C
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
951c7801 100 let attach_bef bef beforeinfo befit = function
34e49164
C
101 (true,mcl) ->
102 List.iter
103 (function
104 Ast0.MINUS(mreplacements) ->
8babbc8f
C
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))
34e49164
C
115 | Ast0.CONTEXT(mbefaft) ->
116 (match !mbefaft with
951c7801 117 (Ast.BEFORE(mbef,it),mbeforeinfo,a) ->
34e49164
C
118 let (newbef,newinfo) =
119 concat bef beforeinfo mbef mbeforeinfo in
951c7801
C
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
34e49164 124 mbefaft :=
951c7801
C
125 (Ast.BEFOREAFTER(bef,maft,it),beforeinfo,a)
126 | (Ast.BEFOREAFTER(mbef,maft,it),mbeforeinfo,a) ->
34e49164
C
127 let (newbef,newinfo) =
128 concat bef beforeinfo mbef mbeforeinfo in
951c7801 129 let it = Ast.lub_count befit it in
34e49164 130 mbefaft :=
951c7801 131 (Ast.BEFOREAFTER(newbef,maft,it),newinfo,a)
34e49164 132 | (Ast.NOTHING,_,a) ->
951c7801
C
133 mbefaft :=
134 (Ast.BEFORE(bef,befit),beforeinfo,a))
34e49164
C
135 | _ -> failwith "unexpected annotation")
136 mcl
137 | _ ->
978fd7e5 138 Printf.printf "before %s\n" (Dumper.dump bef);
34e49164 139 failwith
978fd7e5 140 "context tree should not have bad code before" in
951c7801 141 let attach_aft aft afterinfo aftit = function
34e49164
C
142 (true,mcl) ->
143 List.iter
144 (function
145 Ast0.MINUS(mreplacements) ->
8babbc8f
C
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))
34e49164
C
156 | Ast0.CONTEXT(mbefaft) ->
157 (match !mbefaft with
951c7801
C
158 (Ast.BEFORE(mbef,it),b,_) ->
159 let it = Ast.lub_count aftit it in
34e49164 160 mbefaft :=
951c7801
C
161 (Ast.BEFOREAFTER(mbef,aft,it),b,afterinfo)
162 | (Ast.AFTER(maft,it),b,mafterinfo) ->
34e49164
C
163 let (newaft,newinfo) =
164 concat maft mafterinfo aft afterinfo in
951c7801
C
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) ->
34e49164
C
168 let (newaft,newinfo) =
169 concat maft mafterinfo aft afterinfo in
951c7801 170 let it = Ast.lub_count aftit it in
34e49164 171 mbefaft :=
951c7801 172 (Ast.BEFOREAFTER(mbef,newaft,it),b,newinfo)
34e49164 173 | (Ast.NOTHING,b,_) ->
951c7801 174 mbefaft := (Ast.AFTER(aft,aftit),b,afterinfo))
34e49164
C
175 | _ -> failwith "unexpected annotation")
176 mcl
177 | _ ->
178 failwith
978fd7e5 179 "context tree should not have bad code after" in
34e49164 180 (match !befaft with
951c7801
C
181 (Ast.BEFORE(bef,it),beforeinfo,_) ->
182 attach_bef bef beforeinfo it
34e49164 183 (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start)
951c7801
C
184 | (Ast.AFTER(aft,it),_,afterinfo) ->
185 attach_aft aft afterinfo it
34e49164 186 (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
951c7801
C
187 | (Ast.BEFOREAFTER(bef,aft,it),beforeinfo,afterinfo) ->
188 attach_bef bef beforeinfo it
34e49164 189 (einfo.Ast0.attachable_start,einfo.Ast0.mcode_start);
951c7801 190 attach_aft aft afterinfo it
34e49164
C
191 (einfo.Ast0.attachable_end,einfo.Ast0.mcode_end)
192 | (Ast.NOTHING,_,_) -> ())
951c7801 193 | Ast0.PLUS _ -> () in
b1b2de81 194 V0.flat_combiner bind option_default
34e49164 195 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
faf9a90c 196 mcode mcode
34e49164
C
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
203might be mixed when the function contains ()s, where agglomeration of -s is
204not possible. *)
205
206let 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
708f4980 210 let mcode (_,_,_,mc,_,_) =
34e49164 211 match mc with
8babbc8f 212 Ast0.MINUS(r) -> let (plusses,_) = !r in plusses = Ast.NOREPLACEMENT
34e49164
C
213 | _ -> false in
214
17ba0788 215 (* special case for disj and asExpr etc *)
d3f655c6
C
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
34e49164
C
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
17ba0788 226 | Ast0.AsExpr(exp,asexp) -> k exp
34e49164
C
227 | _ -> k e in
228
229 let declaration r k e =
230 match Ast0.unwrap e with
231 Ast0.DisjDecl(starter,decls,mids,ender) ->
b1b2de81 232 List.for_all r.VT0.combiner_rec_declaration decls
17ba0788 233 | Ast0.AsDecl(decl,asdecl) -> k decl
34e49164
C
234 | _ -> k e in
235
236 let typeC r k e =
237 match Ast0.unwrap e with
238 Ast0.DisjType(starter,decls,mids,ender) ->
b1b2de81 239 List.for_all r.VT0.combiner_rec_typeC decls
17ba0788
C
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
34e49164
C
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) ->
b1b2de81 251 List.for_all r.VT0.combiner_rec_statement_dots statement_dots_list
17ba0788 252 | Ast0.AsStmt(stmt,asstmt) -> k stmt
34e49164
C
253 | _ -> k e in
254
fc1ad971
C
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
b1b2de81 261 V0.flat_combiner bind option_default
34e49164 262 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
faf9a90c 263 mcode mcode
34e49164 264 donothing donothing donothing donothing donothing donothing
17ba0788 265 ident expression typeC initialiser donothing declaration
fc1ad971 266 statement case_line donothing
faf9a90c 267
34e49164
C
268(* --------------------------------------------------------------------- *)
269(* --------------------------------------------------------------------- *)
faf9a90c 270
34e49164
C
271let get_option fn = function
272 None -> None
273 | Some x -> Some (fn x)
274
275(* --------------------------------------------------------------------- *)
276(* --------------------------------------------------------------------- *)
277(* Mcode *)
faf9a90c 278
34e49164 279let convert_info info =
0708f913
C
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;
97111a47
C
287 Ast.straft = strings_to_s info.Ast0.strings_after;
288 }
34e49164 289
708f4980 290let convert_mcodekind adj = function
34e49164 291 Ast0.MINUS(replacements) ->
faf9a90c 292 let (replacements,_) = !replacements in
8babbc8f 293 Ast.MINUS(Ast.NoPos,[],Ast.ADJ adj,replacements)
951c7801 294 | Ast0.PLUS count -> Ast.PLUS count
34e49164 295 | Ast0.CONTEXT(befaft) ->
8babbc8f
C
296 let (befaft,_,_) = !befaft in
297 Ast.CONTEXT(Ast.NoPos,befaft)
34e49164
C
298 | Ast0.MIXED(_) -> failwith "not possible for mcode"
299
8babbc8f
C
300let 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
708f4980 315let pos_mcode(term,_,info,mcodekind,pos,adj) =
34e49164 316 (* avoids a recursion problem *)
8f657093 317 (term,convert_info info,convert_mcodekind adj mcodekind,[])
34e49164 318
708f4980 319let mcode (term,_,info,mcodekind,pos,adj) =
34e49164 320 let pos =
17ba0788
C
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)
34e49164
C
329
330(* --------------------------------------------------------------------- *)
331(* Dots *)
332let wrap ast line isos =
333 {(Ast.make_term ast) with Ast.node_line = line;
334 Ast.iso_info = isos}
335
336let rewrap ast0 isos ast =
0708f913 337 wrap ast ((Ast0.get_info ast0).Ast0.pos_info.Ast0.line_start) isos
34e49164
C
338
339let no_isos = []
340
341(* no isos on tokens *)
342let tokenwrap (_,info,_,_) s ast = wrap ast info.Ast.line no_isos
343let iso_tokenwrap (_,info,_,_) s ast iso = wrap ast info.Ast.line iso
344
345let 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
c491d8ee
C
352(* commas in dotted lists, here due to polymorphism restrictions *)
353
17ba0788 354let add_comma is_comma is_dots make_comma itemlist =
c491d8ee
C
355 match Ast0.unwrap itemlist with
356 Ast0.DOTS(x) ->
357 (match List.rev x with
358 [] -> itemlist
17ba0788
C
359(* Not sure if comma is needed if the list is just ...; leave it there for
360now. See list_matcher in cocci_vs_c.ml in first try_matches case. *)
361(* | [e] when is_dots e -> itemlist*)
c491d8ee
C
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
375let add_exp_comma =
376 add_comma
377 (function x -> match Ast0.unwrap x with Ast0.EComma _ -> true | _ -> false)
17ba0788 378 (function x -> match Ast0.unwrap x with Ast0.Edots _ -> true | _ -> false)
c491d8ee
C
379 (function x -> Ast0.EComma x)
380
381and add_init_comma =
382 add_comma
383 (function x -> match Ast0.unwrap x with Ast0.IComma _ -> true | _ -> false)
17ba0788 384 (function x -> match Ast0.unwrap x with Ast0.Idots _ -> true | _ -> false)
c491d8ee
C
385 (function x -> Ast0.IComma x)
386
34e49164
C
387(* --------------------------------------------------------------------- *)
388(* Identifier *)
389
390let rec do_isos l = List.map (function (nm,x) -> (nm,anything x)) l
391
392and ident i =
393 rewrap i (do_isos (Ast0.get_iso i))
394 (match Ast0.unwrap i with
d3f655c6
C
395 Ast0.Id(name) -> Ast.Id(mcode name)
396 | Ast0.DisjId(_,id_list,_,_) ->
397 Ast.DisjId(List.map ident id_list)
8babbc8f 398 | Ast0.MetaId(name,constraints,_,_) ->
d3f655c6
C
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))
34e49164
C
406
407(* --------------------------------------------------------------------- *)
408(* Expression *)
409
410and 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)
17ba0788
C
425 | Ast0.Sequence(left,op,right) ->
426 Ast.Sequence(expression left,mcode op,expression right)
34e49164
C
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) ->
17ba0788
C
453 let allminus = check_allminus.VT0.combiner_rec_expression e in
454 Ast.Cast(mcode lp,typeC allminus ty,mcode rp,expression exp)
34e49164
C
455 | Ast0.SizeOfExpr(szf,exp) ->
456 Ast.SizeOfExpr(mcode szf,expression exp)
457 | Ast0.SizeOfType(szf,lp,ty,rp) ->
17ba0788
C
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)
7fe62b65 463 | Ast0.Constructor(lp,ty,rp,init) ->
17ba0788
C
464 let allminus = check_allminus.VT0.combiner_rec_expression e in
465 Ast.Constructor(mcode lp,typeC allminus ty,mcode rp,initialiser init)
951c7801
C
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)
88e71198
C
470 | Ast0.MetaExprList(name,lenname,_) ->
471 Ast.MetaExprList(mcode name,do_lenname lenname,unitary,false)
17ba0788
C
472 | Ast0.AsExpr(expr,asexpr) ->
473 Ast.AsExpr(expression expr,expression asexpr)
34e49164 474 | Ast0.EComma(cm) -> Ast.EComma(mcode cm)
978fd7e5
C
475 | Ast0.DisjExpr(_,exps,_,_) ->
476 Ast.DisjExpr(List.map expression exps)
5636bb2c
C
477 | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
478 let starter = mcode starter in
34e49164 479 let whencode = get_option expression whencode in
5636bb2c
C
480 let ender = mcode ender in
481 Ast.NestExpr(starter,dots expression exp_dots,ender,whencode,multi)
34e49164
C
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
498and expression_dots ed = dots expression ed
faf9a90c 499
951c7801
C
500and 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)
5636bb2c 505 | Ast0.SubExpCstrt ids -> Ast.SubExpCstrt ids
951c7801 506
88e71198
C
507and 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
34e49164
C
512(* --------------------------------------------------------------------- *)
513(* Types *)
514
faf9a90c
C
515and rewrap_iso t t1 = rewrap t (do_isos (Ast0.get_iso t)) t1
516
17ba0788 517and typeC allminus t =
34e49164
C
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
17ba0788
C
532 (allminus, Some (mcode cv),
533 rewrap_iso ty (base_typeC allminus ty)))
34e49164
C
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))
faf9a90c 541 | Ast0.BaseType(_) | Ast0.Signed(_,_) | Ast0.Pointer(_,_)
34e49164 542 | Ast0.FunctionPointer(_,_,_,_,_,_,_) | Ast0.FunctionType(_,_,_,_)
faf9a90c 543 | Ast0.Array(_,_,_,_) | Ast0.EnumName(_,_) | Ast0.StructUnionName(_,_)
c491d8ee
C
544 | Ast0.StructUnionDef(_,_,_,_) | Ast0.EnumDef(_,_,_,_)
545 | Ast0.TypeName(_) | Ast0.MetaType(_,_) ->
17ba0788
C
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
554and base_typeC allminus t =
34e49164 555 match Ast0.unwrap t with
faf9a90c
C
556 Ast0.BaseType(ty,strings) -> Ast.BaseType(ty,List.map mcode strings)
557 | Ast0.Signed(sgn,ty) ->
17ba0788
C
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)
34e49164
C
562 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
563 Ast.FunctionPointer
17ba0788 564 (typeC allminus ty,mcode lp1,mcode star,mcode rp1,
34e49164
C
565 mcode lp2,parameter_list params,mcode rp2)
566 | Ast0.FunctionType(ret,lp,params,rp) ->
b1b2de81 567 let allminus = check_allminus.VT0.combiner_rec_typeC t in
34e49164 568 Ast.FunctionType
17ba0788 569 (allminus,get_option (typeC allminus) ret,mcode lp,
34e49164
C
570 parameter_list params,mcode rp)
571 | Ast0.Array(ty,lb,size,rb) ->
17ba0788
C
572 Ast.Array(typeC allminus ty,mcode lb,get_option expression size,
573 mcode rb)
faf9a90c 574 | Ast0.EnumName(kind,name) ->
c491d8ee
C
575 Ast.EnumName(mcode kind,get_option ident name)
576 | Ast0.EnumDef(ty,lb,ids,rb) ->
577 let ids = add_exp_comma ids in
17ba0788 578 Ast.EnumDef(typeC allminus ty,mcode lb,dots expression ids,mcode rb)
34e49164
C
579 | Ast0.StructUnionName(kind,name) ->
580 Ast.StructUnionName(mcode kind,get_option ident name)
581 | Ast0.StructUnionDef(ty,lb,decls,rb) ->
17ba0788 582 Ast.StructUnionDef(typeC allminus ty,mcode lb,
34e49164
C
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"
faf9a90c 589
34e49164
C
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. *)
faf9a90c 594
34e49164
C
595and declaration d =
596 rewrap d (do_isos (Ast0.get_iso d))
597 (match Ast0.unwrap d with
413ffc02
C
598 Ast0.MetaDecl(name,_) -> Ast.MetaDecl(mcode name,unitary,false)
599 | Ast0.MetaField(name,_) -> Ast.MetaField(mcode name,unitary,false)
190f1acf
C
600 | Ast0.MetaFieldList(name,lenname,_) ->
601 Ast.MetaFieldList(mcode name,do_lenname lenname,unitary,false)
17ba0788
C
602 | Ast0.AsDecl(decl,asdecl) ->
603 Ast.AsDecl(declaration decl,declaration asdecl)
413ffc02 604 | Ast0.Init(stg,ty,id,eq,ini,sem) ->
17ba0788 605 let allminus = check_allminus.VT0.combiner_rec_declaration d in
34e49164 606 let stg = get_option mcode stg in
17ba0788 607 let ty = typeC allminus ty in
34e49164
C
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) ->
b1b2de81 616 let allminus = check_allminus.VT0.combiner_rec_declaration d in
34e49164
C
617 Ast.UnInit(get_option mcode stg,
618 rewrap ty (do_isos (Ast0.get_iso ty))
619 (Ast.Type
17ba0788 620 (allminus,None,
34e49164
C
621 rewrap ty no_isos
622 (Ast.FunctionType
17ba0788
C
623 (allminus,get_option (typeC allminus) tyx,
624 mcode lp1,
34e49164
C
625 parameter_list params,mcode rp1)))),
626 ident id,mcode sem)
17ba0788
C
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))
34e49164
C
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)
17ba0788
C
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)
34e49164 650 | Ast0.Typedef(stg,ty,id,sem) ->
17ba0788
C
651 let allminus = check_allminus.VT0.combiner_rec_declaration d in
652 let id = typeC allminus id in
34e49164 653 (match Ast.unwrap id with
17ba0788
C
654 Ast.Type(_,None,id) -> (* only MetaType or Id *)
655 Ast.Typedef(mcode stg,typeC allminus ty,id,mcode sem)
34e49164
C
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
665and declaration_dots l = dots declaration l
666
667(* --------------------------------------------------------------------- *)
668(* Initialiser *)
669
670and strip_idots initlist =
90aeb998
C
671 let isminus mc =
672 match Ast0.get_mcode_mcodekind mc with
673 Ast0.MINUS _ -> true
674 | _ -> false in
34e49164 675 match Ast0.unwrap initlist with
c491d8ee
C
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
90aeb998 686 let (whencode,init,dotinfo) =
c491d8ee
C
687 let rec loop = function
688 [] -> ([],[],[])
689 | x::rest ->
690 (match Ast0.unwrap x with
34e49164 691 Ast0.Idots(dots,Some whencode) ->
c491d8ee
C
692 let (restwhen,restinit,dotinfo) = loop rest in
693 (whencode :: restwhen, restinit,
90aeb998 694 (isminus dots)::dotinfo)
c491d8ee
C
695 | Ast0.Idots(dots,None) ->
696 let (restwhen,restinit,dotinfo) = loop rest in
697 (restwhen, restinit, (isminus dots)::dotinfo)
97111a47 698 | _ ->
c491d8ee
C
699 let (restwhen,restinit,dotinfo) = loop rest in
700 (restwhen,x::restinit,dotinfo)) in
701 loop l in
90aeb998
C
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
c491d8ee 709 (whencode, init, allminus)
34e49164
C
710 | Ast0.CIRCLES(x) | Ast0.STARS(x) -> failwith "not possible for an initlist"
711
712and initialiser i =
713 rewrap i no_isos
714 (match Ast0.unwrap i with
113803cf 715 Ast0.MetaInit(name,_) -> Ast.MetaInit(mcode name,unitary,false)
8f657093
C
716 | Ast0.MetaInitList(name,lenname,_) ->
717 Ast.MetaInitList(mcode name,do_lenname lenname,unitary,false)
17ba0788
C
718 | Ast0.AsInit(init,asinit) ->
719 Ast.AsInit(initialiser init,initialiser asinit)
113803cf 720 | Ast0.InitExpr(exp) -> Ast.InitExpr(expression exp)
c491d8ee
C
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
90aeb998 726 let (whencode,initlist,allminus) = strip_idots initlist in
c491d8ee
C
727 Ast.StrInitList
728 (allminus,mcode lb,List.map initialiser initlist,mcode rb,
729 List.map initialiser whencode)
113803cf
C
730 | Ast0.InitGccExt(designators,eq,ini) ->
731 Ast.InitGccExt(List.map designator designators,mcode eq,
732 initialiser ini)
34e49164
C
733 | Ast0.InitGccName(name,eq,ini) ->
734 Ast.InitGccName(ident name,mcode eq,initialiser ini)
34e49164 735 | Ast0.IComma(comma) -> Ast.IComma(mcode comma)
c491d8ee
C
736 | Ast0.Idots(dots,whencode) ->
737 let dots = mcode dots in
738 let whencode = get_option initialiser whencode in
739 Ast.Idots(dots,whencode)
34e49164
C
740 | Ast0.OptIni(ini) -> Ast.OptIni(initialiser ini)
741 | Ast0.UniqueIni(ini) -> Ast.UniqueIni(initialiser ini))
742
113803cf
C
743and 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
34e49164
C
751(* --------------------------------------------------------------------- *)
752(* Parameter *)
faf9a90c 753
34e49164
C
754and parameterTypeDef p =
755 rewrap p no_isos
756 (match Ast0.unwrap p with
17ba0788
C
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)
34e49164
C
761 | Ast0.MetaParam(name,_) ->
762 Ast.MetaParam(mcode name,unitary,false)
88e71198
C
763 | Ast0.MetaParamList(name,lenname,_) ->
764 Ast.MetaParamList(mcode name,do_lenname lenname,unitary,false)
34e49164
C
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
771and parameter_list l = dots parameterTypeDef l
772
773(* --------------------------------------------------------------------- *)
774(* Top-level code *)
775
776and 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) ->
8babbc8f 792 let allminus = check_allminus.VT0.combiner_rec_statement s in
34e49164 793 Ast.Atomic(rewrap_rule_elem s
8babbc8f
C
794 (Ast.Decl(convert_allminus_mcodekind allminus bef,
795 allminus,declaration decl)))
faf9a90c 796 | Ast0.Seq(lbrace,body,rbrace) ->
34e49164 797 let lbrace = mcode lbrace in
708f4980 798 let body = dots (statement seqible) body in
34e49164
C
799 let rbrace = mcode rbrace in
800 Ast.Seq(iso_tokenwrap lbrace s (Ast.SeqStart(lbrace))
801 (do_isos (Ast0.get_iso s)),
708f4980 802 body,
34e49164
C
803 tokenwrap rbrace s (Ast.SeqEnd(rbrace)))
804 | Ast0.ExprStatement(exp,sem) ->
805 Ast.Atomic(rewrap_rule_elem s
8babbc8f 806 (Ast.ExprStatement(get_option expression exp,mcode sem)))
34e49164
C
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,
708f4980 812 ([],[],[],convert_mcodekind (-1) aft))
34e49164
C
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,
708f4980 821 ([],[],[],convert_mcodekind (-1) aft))
34e49164
C
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,
708f4980 827 ([],[],[],convert_mcodekind (-1) aft))
34e49164
C
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)),
708f4980 847 body,([],[],[],convert_mcodekind (-1) aft))
34e49164
C
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,
708f4980 855 ([],[],[],convert_mcodekind (-1) aft))
fc1ad971 856 | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) ->
34e49164
C
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
fc1ad971 862 let decls = dots (statement seqible) decls in
34e49164
C
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)),
fc1ad971 867 decls,cases,
34e49164
C
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)))
17ba0788
C
890 | Ast0.AsStmt(stmt,asstmt) ->
891 Ast.AsStmt(statement seqible stmt,statement seqible asstmt)
34e49164
C
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)))
1be43e12
C
896 | Ast0.TopInit(init) ->
897 Ast.Atomic(rewrap_rule_elem s (Ast.TopInit(initialiser init)))
34e49164 898 | Ast0.Ty(ty) ->
17ba0788
C
899 let allminus = check_allminus.VT0.combiner_rec_statement s in
900 Ast.Atomic(rewrap_rule_elem s (Ast.Ty(typeC allminus ty)))
34e49164
C
901 | Ast0.Disj(_,rule_elem_dots_list,_,_) ->
902 Ast.Disj(List.map (function x -> statement_dots seqible x)
903 rule_elem_dots_list)
5636bb2c 904 | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) ->
34e49164 905 Ast.Nest
5636bb2c
C
906 (mcode starter,statement_dots Ast.Sequencible rule_elem_dots,
907 mcode ender,
34e49164
C
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
708f4980 944 let body = dots (statement seqible) body in
34e49164 945 let rbrace = mcode rbrace in
b1b2de81 946 let allminus = check_allminus.VT0.combiner_rec_statement s in
34e49164 947 Ast.FunDecl(rewrap_rule_elem s
8babbc8f
C
948 (Ast.FunHeader
949 (convert_allminus_mcodekind allminus bef,
950 allminus,fi,name,lp,params,rp)),
34e49164 951 tokenwrap lbrace s (Ast.SeqStart(lbrace)),
708f4980 952 body,
34e49164
C
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)))
3a314143
C
956 | Ast0.Undef(def,id) ->
957 Ast.Atomic(rewrap_rule_elem s (Ast.Undef(mcode def,ident id)))
34e49164
C
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)
1be43e12
C
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"
34e49164
C
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
708f4980
C
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.
34e49164
C
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)
708f4980 1073 | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in
34e49164
C
1074
1075 statement Ast.Sequencible s
1076
1077and fninfo = function
1078 Ast0.FStorage(stg) -> Ast.FStorage(mcode stg)
17ba0788 1079 | Ast0.FType(ty) -> Ast.FType(typeC false ty)
34e49164
C
1080 | Ast0.FInline(inline) -> Ast.FInline(mcode inline)
1081 | Ast0.FAttr(attr) -> Ast.FAttr(mcode attr)
1082
1083and option_to_list = function
1084 Some x -> [x]
1085 | None -> []
1086
1087and 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)
fc1ad971
C
1101 | Ast0.DisjCase(_,case_lines,_,_) ->
1102 failwith "not supported"
1103 (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*)
1104
34e49164
C
1105 | Ast0.OptCase(case) -> Ast.OptCase(case_line case))
1106
1107and statement_dots l = dots statement l
faf9a90c 1108
34e49164
C
1109(* --------------------------------------------------------------------- *)
1110
1111(* what is possible is only what is at the top level in an iso *)
1112and 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"
17ba0788 1123 | Ast0.TypeCTag(d) -> Ast.FullTypeTag(typeC false d)
34e49164
C
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"
1be43e12
C
1131 | Ast0.IsoWhenTTag(_) -> failwith "not possible"
1132 | Ast0.IsoWhenFTag(_) -> failwith "not possible"
34e49164 1133 | Ast0.MetaPosTag _ -> failwith "not possible"
17ba0788 1134 | Ast0.HiddenVarTag _ -> failwith "not possible"
34e49164
C
1135
1136(* --------------------------------------------------------------------- *)
1137(* Function declaration *)
1138(* top level isos are probably lost to tracking *)
faf9a90c 1139
34e49164
C
1140and 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)
65038c61
C
1145 | Ast0.NONDECL(stmt) -> Ast.NONDECL(statement stmt)
1146 | Ast0.CODE(rule_elem_dots) -> Ast.CODE(statement_dots rule_elem_dots)
34e49164 1147 | Ast0.ERRORWORDS(exps) -> Ast.ERRORWORDS(List.map expression exps)
65038c61 1148 | Ast0.OTHER(_) | Ast0.TOPCODE(_) -> failwith "eliminated by top_level")
34e49164
C
1149
1150(* --------------------------------------------------------------------- *)
1151(* Entry point for minus code *)
1152
1153(* Inline_mcodes is very important - sends + code attached to the - code
1154down to the mcodes. The functions above can only be used when there is no
1155attached + code, eg in + code itself. *)
1156let ast0toast_toplevel x =
b1b2de81 1157 inline_mcodes.VT0.combiner_rec_top_level x;
34e49164
C
1158 top_level x
1159
faf9a90c 1160let ast0toast name deps dropped exists x is_exp ruletype =
b1b2de81 1161 List.iter inline_mcodes.VT0.combiner_rec_top_level x;
faf9a90c
C
1162 Ast.CocciRule
1163 (name,(deps,dropped,exists),List.map top_level x,is_exp,ruletype)