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