Release coccinelle-0.1.6
[bpt/coccinelle.git] / parsing_c / visitor_c.ml
CommitLineData
0708f913
C
1(* Yoann Padioleau
2 *
3 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes
34e49164
C
4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License (GPL)
7 * version 2 as published by the Free Software Foundation.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * file license.txt for more details.
13 *)
14open Common
15
16
17open Ast_c
18module F = Control_flow_c
19
91eba41f
C
20(*****************************************************************************)
21(* Prelude *)
22(*****************************************************************************)
23
24(* todo? dont go in Include. Have a visitor flag ? disable_go_include ?
25 * disable_go_type_annotation ?
26 *)
27
34e49164
C
28(*****************************************************************************)
29(* Functions to visit the Ast, and now also the CFG nodes *)
30(*****************************************************************************)
31
113803cf
C
32(* Why this module ?
33 *
34 * The problem is that we manipulate the AST of C programs
35 * and some of our analysis need only to specify an action for
36 * specific cases, such as the function call case, and recurse
37 * for the other cases.
0708f913 38 * Here is a simplification of our AST:
113803cf
C
39 *
40 * type ctype =
41 * | Basetype of ...
42 * | Pointer of ctype
43 * | Array of expression option * ctype
44 * | ...
45 * and expression =
46 * | Ident of string
47 * | FunCall of expression * expression list
48 * | Postfix of ...
49 * | RecordAccess of ..
50 * | ...
51 * and statement =
52 * ...
53 * and declaration =
54 * ...
55 * and program =
56 * ...
57 *
58 * What we want is really write code like
59 *
60 * let my_analysis program =
61 * analyze_all_expressions program (fun expr ->
62 * match expr with
63 * | FunCall (e, es) -> do_something()
64 * | _ -> <find_a_way_to_recurse_for_all_the_other_cases>
65 * )
66 *
67 * The problem is how to write analyze_all_expressions
68 * and find_a_way_to_recurse_for_all_the_other_cases.
69 *
70 * Our solution is to mix the ideas of visitor, pattern matching,
71 * and continuation. Here is how it looks like
72 * using our hybrid-visitor API:
73 *
74 * let my_analysis program =
75 * Visitor.visit_iter program {
76 * Visitor.kexpr = (fun k e ->
77 * match e with
78 * | FunCall (e, es) -> do_something()
79 * | _ -> k e
80 * );
81 * }
82 *
83 * You can of course also give action "hooks" for
84 * kstatement, ktype, or kdeclaration. But we don't overuse
85 * visitors and so it would be stupid to provide
86 * kfunction_call, kident, kpostfix hooks as one can just
87 * use pattern matching with kexpr to achieve the same effect.
88 *
0708f913
C
89 * Note: when want to apply recursively, always apply the continuator
90 * on the toplevel expression, otherwise may miss some intermediate steps.
91 * Do
92 * match expr with
93 * | FunCall (e, es) -> ...
94 * k expr
95 * Or
96 * match expr with
97 * | FunCall (e, es) -> ...
98 * Visitor_c.vk_expr bigf e
99 * Not
100 * match expr with
101 * | FunCall (e, es) -> ...
102 * k e
103 *
104 *
113803cf
C
105 *
106 *
107 *
108 * Alternatives: from the caml mailing list:
109 * "You should have a look at the Camlp4 metaprogramming facilities :
110 * http://brion.inria.fr/gallium/index.php/Camlp4MapGenerator
111 * You would write something like" :
112 * let my_analysis program =
113 * let analysis = object (self)
114 * inherit fold as super
115 * method expr = function
116 * | FunCall (e, es) -> do_something (); self
117 * | other -> super#expr other
118 * end in analysis#expr
119 *
0708f913 120 * The problem is that you don't have control about what is generated
113803cf
C
121 * and in our case we sometimes dont want to visit too much. For instance
122 * our visitor don't recuse on the type annotation of expressions
0708f913 123 * Ok, this could be worked around, but the pb remains, you
113803cf
C
124 * don't have control and at some point you may want. In the same
125 * way we want to enforce a certain order in the visit (ok this is not good,
126 * but it's convenient) of ast elements. For instance first
127 * processing the left part 'e' of a Funcall(e,es), then the arguments 'es'.
128 *
129 *)
34e49164
C
130
131(* Visitor based on continuation. Cleaner than the one based on mutable
485bce71
C
132 * pointer functions that I had before.
133 * src: based on a (vague) idea from Remy Douence.
34e49164
C
134 *
135 *
136 *
137 * Diff with Julia's visitor ? She does:
138 *
139 * let ident r k i =
140 * ...
141 * let expression r k e =
142 * ...
143 * ... (List.map r.V0.combiner_expression expr_list) ...
144 * ...
145 * let res = V0.combiner bind option_default
146 * mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
147 * donothing donothing donothing donothing
148 * ident expression typeC donothing parameter declaration statement
149 * donothing in
150 * ...
151 * collect_unitary_nonunitary
152 * (List.concat (List.map res.V0.combiner_top_level t))
153 *
154 *
155 *
156 * So she has to remember at which position you must put the 'expression'
157 * function. I use record which is easier.
158 *
159 * When she calls recursively, her res.V0.combiner_xxx does not take bigf
160 * in param whereas I do
161 * | F.Decl decl -> Visitor_c.vk_decl bigf decl
162 * And with the record she gets, she does not have to do my
163 * multiple defs of function such as 'let al_type = V0.vk_type_s bigf'
164 *
165 * The code of visitor.ml is cleaner with julia because mutual recursive calls
166 * are clean such as ... 'expression e' ... and not 'f (k, bigf) e'
167 * or 'vk_expr bigf e'.
168 *
169 * So it is very dual:
170 * - I give a record but then I must handle bigf.
171 * - She gets a record, and gives a list of function
172 *
173 *)
174
175
176(* old: first version (only visiting expr)
177
178let (iter_expr:((expression -> unit) -> expression -> unit) -> expression -> unit)
179 = fun f expr ->
180 let rec k e =
181 match e with
182 | Constant c -> ()
183 | FunCall (e, es) -> f k e; List.iter (f k) es
184 | CondExpr (e1, e2, e3) -> f k e1; f k e2; f k e3
185 | Sequence (e1, e2) -> f k e1; f k e2;
186 | Assignment (e1, op, e2) -> f k e1; f k e2;
187
188 | Postfix (e, op) -> f k e
189 | Infix (e, op) -> f k e
190 | Unary (e, op) -> f k e
191 | Binary (e1, op, e2) -> f k e1; f k e2;
192
193 | ArrayAccess (e1, e2) -> f k e1; f k e2;
194 | RecordAccess (e, s) -> f k e
195 | RecordPtAccess (e, s) -> f k e
196
197 | SizeOfExpr e -> f k e
198 | SizeOfType t -> ()
199 | _ -> failwith "to complete"
200
201 in f k expr
202
203let ex1 = Sequence (Sequence (Constant (Ident "1"), Constant (Ident "2")),
204 Constant (Ident "4"))
205let test =
206 iter_expr (fun k e -> match e with
207 | Constant (Ident x) -> Common.pr2 x
208 | rest -> k rest
209 ) ex1
210==>
2111
2122
2134
214
215*)
216
217(*****************************************************************************)
218(* Side effect style visitor *)
219(*****************************************************************************)
220
221(* Visitors for all langage concept, not just for expression.
222 *
223 * Note that I don't visit necesserally in the order of the token
224 * found in the original file. So don't assume such hypothesis!
485bce71
C
225 *
226 * todo? parameter ? onedecl ?
34e49164
C
227 *)
228type visitor_c =
229 {
230 kexpr: (expression -> unit) * visitor_c -> expression -> unit;
231 kstatement: (statement -> unit) * visitor_c -> statement -> unit;
232 ktype: (fullType -> unit) * visitor_c -> fullType -> unit;
233
234 kdecl: (declaration -> unit) * visitor_c -> declaration -> unit;
235 kdef: (definition -> unit) * visitor_c -> definition -> unit;
236 kini: (initialiser -> unit) * visitor_c -> initialiser -> unit;
237
485bce71
C
238 kcppdirective: (cpp_directive -> unit) * visitor_c -> cpp_directive -> unit;
239 kdefineval : (define_val -> unit) * visitor_c -> define_val -> unit;
240 kstatementseq: (statement_sequencable -> unit) * visitor_c -> statement_sequencable -> unit;
34e49164 241
0708f913
C
242 kfield: (field -> unit) * visitor_c -> field -> unit;
243
34e49164
C
244 (* CFG *)
245 knode: (F.node -> unit) * visitor_c -> F.node -> unit;
246 (* AST *)
247 ktoplevel: (toplevel -> unit) * visitor_c -> toplevel -> unit;
485bce71
C
248
249 kinfo: (info -> unit) * visitor_c -> info -> unit;
34e49164
C
250 }
251
252let default_visitor_c =
253 { kexpr = (fun (k,_) e -> k e);
254 kstatement = (fun (k,_) st -> k st);
255 ktype = (fun (k,_) t -> k t);
256 kdecl = (fun (k,_) d -> k d);
257 kdef = (fun (k,_) d -> k d);
258 kini = (fun (k,_) ie -> k ie);
259 kinfo = (fun (k,_) ii -> k ii);
260 knode = (fun (k,_) n -> k n);
261 ktoplevel = (fun (k,_) p -> k p);
485bce71
C
262 kcppdirective = (fun (k,_) p -> k p);
263 kdefineval = (fun (k,_) p -> k p);
264 kstatementseq = (fun (k,_) p -> k p);
0708f913 265 kfield = (fun (k,_) p -> k p);
34e49164
C
266 }
267
485bce71
C
268
269(* ------------------------------------------------------------------------ *)
270
271
34e49164
C
272let rec vk_expr = fun bigf expr ->
273 let iif ii = vk_ii bigf ii in
274
275 let rec exprf e = bigf.kexpr (k,bigf) e
91eba41f 276 (* !!! dont go in _typ !!! *)
34e49164
C
277 and k ((e,_typ), ii) =
278 iif ii;
279 match e with
280 | Ident (s) -> ()
281 | Constant (c) -> ()
282 | FunCall (e, es) ->
283 exprf e;
485bce71 284 vk_argument_list bigf es;
34e49164
C
285 | CondExpr (e1, e2, e3) ->
286 exprf e1; do_option (exprf) e2; exprf e3
287 | Sequence (e1, e2) -> exprf e1; exprf e2;
288 | Assignment (e1, op, e2) -> exprf e1; exprf e2;
289
290 | Postfix (e, op) -> exprf e
291 | Infix (e, op) -> exprf e
292 | Unary (e, op) -> exprf e
293 | Binary (e1, op, e2) -> exprf e1; exprf e2;
294
295 | ArrayAccess (e1, e2) -> exprf e1; exprf e2;
296 | RecordAccess (e, s) -> exprf e
297 | RecordPtAccess (e, s) -> exprf e
298
299 | SizeOfExpr (e) -> exprf e
300 | SizeOfType (t) -> vk_type bigf t
301 | Cast (t, e) -> vk_type bigf t; exprf e
302
303 (* old: | StatementExpr (((declxs, statxs), is)), is2 ->
304 * List.iter (vk_decl bigf) declxs;
305 * List.iter (vk_statement bigf) statxs
306 *)
307 | StatementExpr ((statxs, is)) ->
308 iif is;
485bce71 309 statxs +> List.iter (vk_statement_sequencable bigf);
34e49164 310
34e49164
C
311 | Constructor (t, initxs) ->
312 vk_type bigf t;
313 initxs +> List.iter (fun (ini, ii) ->
314 vk_ini bigf ini;
315 vk_ii bigf ii;
316 )
317
318 | ParenExpr (e) -> exprf e
319
320
321 in exprf expr
322
34e49164
C
323
324
325
326
485bce71 327and vk_statement = fun bigf (st: Ast_c.statement) ->
34e49164
C
328 let iif ii = vk_ii bigf ii in
329
330 let rec statf x = bigf.kstatement (k,bigf) x
331 and k st =
332 let (unwrap_st, ii) = st in
333 iif ii;
334 match unwrap_st with
335 | Labeled (Label (s, st)) -> statf st;
336 | Labeled (Case (e, st)) -> vk_expr bigf e; statf st;
337 | Labeled (CaseRange (e, e2, st)) ->
338 vk_expr bigf e; vk_expr bigf e2; statf st;
339 | Labeled (Default st) -> statf st;
340
485bce71
C
341 | Compound statxs ->
342 statxs +> List.iter (vk_statement_sequencable bigf)
34e49164
C
343 | ExprStatement (eopt) -> do_option (vk_expr bigf) eopt;
344
345 | Selection (If (e, st1, st2)) ->
346 vk_expr bigf e; statf st1; statf st2;
34e49164
C
347 | Selection (Switch (e, st)) ->
348 vk_expr bigf e; statf st;
349 | Iteration (While (e, st)) ->
350 vk_expr bigf e; statf st;
351 | Iteration (DoWhile (st, e)) -> statf st; vk_expr bigf e;
352 | Iteration (For ((e1opt,i1), (e2opt,i2), (e3opt,i3), st)) ->
353 statf (ExprStatement (e1opt),i1);
354 statf (ExprStatement (e2opt),i2);
355 statf (ExprStatement (e3opt),i3);
356 statf st;
357
358 | Iteration (MacroIteration (s, es, st)) ->
485bce71 359 vk_argument_list bigf es;
34e49164
C
360 statf st;
361
362 | Jump (Goto s) -> ()
363 | Jump ((Continue|Break|Return)) -> ()
364 | Jump (ReturnExpr e) -> vk_expr bigf e;
365 | Jump (GotoComputed e) -> vk_expr bigf e;
366
367 | Decl decl -> vk_decl bigf decl
368 | Asm asmbody -> vk_asmbody bigf asmbody
369 | NestedFunc def -> vk_def bigf def
370 | MacroStmt -> ()
371
372 in statf st
373
485bce71
C
374and vk_statement_sequencable = fun bigf stseq ->
375 let f = bigf.kstatementseq in
376
377 let rec k stseq =
378 match stseq with
379 | StmtElem st -> vk_statement bigf st
380 | CppDirectiveStmt directive ->
381 vk_cpp_directive bigf directive
382 | IfdefStmt ifdef ->
383 vk_ifdef_directive bigf ifdef
384 | IfdefStmt2 (ifdef, xxs) ->
385 ifdef +> List.iter (vk_ifdef_directive bigf);
386 xxs +> List.iter (fun xs ->
387 xs +> List.iter (vk_statement_sequencable bigf)
388 )
389
390 in f (k, bigf) stseq
391
34e49164 392
34e49164
C
393
394and vk_type = fun bigf t ->
395 let iif ii = vk_ii bigf ii in
396
397 let rec typef x = bigf.ktype (k, bigf) x
398 and k t =
399 let (q, t) = t in
400 let (unwrap_q, iiq) = q in
401 let (unwrap_t, iit) = t in
402 iif iiq;
403 iif iit;
404 match unwrap_t with
405 | BaseType _ -> ()
406 | Pointer t -> typef t
407 | Array (eopt, t) ->
408 do_option (vk_expr bigf) eopt;
409 typef t
410 | FunctionType (returnt, paramst) ->
411 typef returnt;
412 (match paramst with
413 | (ts, (b,iihas3dots)) ->
414 iif iihas3dots;
485bce71 415 vk_param_list bigf ts
34e49164
C
416 )
417
418 | Enum (sopt, enumt) ->
419 enumt +> List.iter (fun (((s, eopt),ii_s_eq), iicomma) ->
420 iif ii_s_eq; iif iicomma;
421 eopt +> do_option (vk_expr bigf)
422 );
423
424 | StructUnion (sopt, _su, fields) ->
425 vk_struct_fields bigf fields
426
427 | StructUnionName (s, structunion) -> ()
428 | EnumName s -> ()
429
430 (* dont go in _typ *)
431 | TypeName (s, _typ) -> ()
432
433 | ParenType t -> typef t
434 | TypeOfExpr e -> vk_expr bigf e
435 | TypeOfType t -> typef t
436
437 in typef t
438
485bce71
C
439
440and vk_attribute = fun bigf attr ->
441 let iif ii = vk_ii bigf ii in
442 match attr with
443 | Attribute s, ii ->
444 iif ii
445
446
447(* ------------------------------------------------------------------------ *)
448
34e49164
C
449and vk_decl = fun bigf d ->
450 let iif ii = vk_ii bigf ii in
451
452 let f = bigf.kdecl in
453 let rec k decl =
454 match decl with
91eba41f
C
455 | DeclList (xs,ii) -> xs +> List.iter (fun (x,ii) ->
456 iif ii;
457 vk_onedecl bigf x;
458 );
34e49164
C
459 | MacroDecl ((s, args),ii) ->
460 iif ii;
485bce71 461 vk_argument_list bigf args;
91eba41f
C
462 in f (k, bigf) d
463
464
465and vk_onedecl = fun bigf onedecl ->
466 let iif ii = vk_ii bigf ii in
467 match onedecl with
468 | ({v_namei = var; v_type = t;
469 v_storage = _sto; v_attr = attrs}) ->
34e49164 470
34e49164 471 vk_type bigf t;
485bce71 472 attrs +> List.iter (vk_attribute bigf);
34e49164
C
473 var +> do_option (fun ((s, ini), ii_s_ini) ->
474 iif ii_s_ini;
475 ini +> do_option (vk_ini bigf)
476 );
34e49164
C
477
478and vk_ini = fun bigf ini ->
479 let iif ii = vk_ii bigf ii in
480
481 let rec inif x = bigf.kini (k, bigf) x
482 and k (ini, iini) =
483 iif iini;
484 match ini with
485 | InitExpr e -> vk_expr bigf e
486 | InitList initxs ->
487 initxs +> List.iter (fun (ini, ii) ->
488 inif ini;
489 iif ii;
490 )
491 | InitDesignators (xs, e) ->
492 xs +> List.iter (vk_designator bigf);
493 inif e
494
495 | InitFieldOld (s, e) -> inif e
496 | InitIndexOld (e1, e) ->
497 vk_expr bigf e1; inif e
498
485bce71 499
34e49164
C
500 in inif ini
501
502
503and vk_designator = fun bigf design ->
504 let iif ii = vk_ii bigf ii in
505 let (designator, ii) = design in
506 iif ii;
507 match designator with
508 | DesignatorField s -> ()
509 | DesignatorIndex e -> vk_expr bigf e
510 | DesignatorRange (e1, e2) -> vk_expr bigf e1; vk_expr bigf e2
511
485bce71
C
512
513(* ------------------------------------------------------------------------ *)
514
34e49164 515and vk_struct_fields = fun bigf fields ->
0708f913
C
516 fields +> List.iter (vk_struct_field bigf);
517
518and vk_struct_field = fun bigf field ->
34e49164
C
519 let iif ii = vk_ii bigf ii in
520
0708f913
C
521 let f = bigf.kfield in
522 let rec k field =
523
524 let (xfield, ii) = field in
34e49164
C
525 iif ii;
526 match xfield with
485bce71
C
527 | DeclarationField
528 (FieldDeclList (onefield_multivars, iiptvirg)) ->
529 vk_struct_fieldkinds bigf onefield_multivars;
530 iif iiptvirg;
34e49164 531 | EmptyField -> ()
485bce71 532 | MacroStructDeclTodo ->
91eba41f 533 pr2_once "MacroStructDeclTodo";
485bce71
C
534 ()
535
536 | CppDirectiveStruct directive ->
537 vk_cpp_directive bigf directive
538 | IfdefStruct ifdef ->
539 vk_ifdef_directive bigf ifdef
0708f913
C
540 in
541 f (k, bigf) field
542
485bce71 543
0708f913 544
34e49164 545
485bce71 546and vk_struct_fieldkinds = fun bigf onefield_multivars ->
34e49164
C
547 let iif ii = vk_ii bigf ii in
548 onefield_multivars +> List.iter (fun (field, iicomma) ->
549 iif iicomma;
550 match field with
551 | Simple (s, t), ii -> iif ii; vk_type bigf t;
552 | BitField (sopt, t, expr), ii ->
553 iif ii;
554 vk_expr bigf expr;
555 vk_type bigf t
556 )
557
485bce71 558(* ------------------------------------------------------------------------ *)
34e49164
C
559
560
561and vk_def = fun bigf d ->
562 let iif ii = vk_ii bigf ii in
563
564 let f = bigf.kdef in
565 let rec k d =
566 match d with
485bce71
C
567 | {f_name = s;
568 f_type = (returnt, (paramst, (b, iib)));
569 f_storage = sto;
570 f_body = statxs;
571 f_attr = attrs;
91eba41f 572 f_old_c_style = oldstyle;
485bce71
C
573 }, ii
574 ->
34e49164
C
575 iif ii;
576 iif iib;
485bce71 577 attrs +> List.iter (vk_attribute bigf);
34e49164
C
578 vk_type bigf returnt;
579 paramst +> List.iter (fun (param,iicomma) ->
580 vk_param bigf param;
581 iif iicomma;
582 );
91eba41f
C
583 oldstyle +> Common.do_option (fun decls ->
584 decls +> List.iter (vk_decl bigf);
585 );
586
485bce71 587 statxs +> List.iter (vk_statement_sequencable bigf)
34e49164
C
588 in f (k, bigf) d
589
590
591
592
593and vk_toplevel = fun bigf p ->
594 let f = bigf.ktoplevel in
595 let iif ii = vk_ii bigf ii in
596 let rec k p =
597 match p with
598 | Declaration decl -> (vk_decl bigf decl)
599 | Definition def -> (vk_def bigf def)
600 | EmptyDef ii -> iif ii
601 | MacroTop (s, xs, ii) ->
485bce71
C
602 vk_argument_list bigf xs;
603 iif ii
604
605 | CppTop top -> vk_cpp_directive bigf top
606 | IfdefTop ifdefdir -> vk_ifdef_directive bigf ifdefdir
34e49164 607
485bce71
C
608 | NotParsedCorrectly ii -> iif ii
609 | FinalDef info -> vk_info bigf info
610 in f (k, bigf) p
611
612and vk_program = fun bigf xs ->
613 xs +> List.iter (vk_toplevel bigf)
614
615and vk_ifdef_directive bigf directive =
616 let iif ii = vk_ii bigf ii in
617 match directive with
618 | IfdefDirective (ifkind, ii) -> iif ii
619
620
621and vk_cpp_directive bigf directive =
622 let iif ii = vk_ii bigf ii in
623 let f = bigf.kcppdirective in
624 let rec k directive =
625 match directive with
626 | Include {i_include = (s, ii);
627 i_content = copt;
628 }
629 ->
91eba41f
C
630 (* go inside ? yes, can be useful, for instance for type_annotater.
631 * The only pb may be that when we want to unparse the code we
632 * don't want to unparse the included file but the unparser
633 * and pretty_print do not use visitor_c so no problem.
634 *)
485bce71
C
635 iif ii;
636 copt +> Common.do_option (fun (file, asts) ->
637 vk_program bigf asts
638 );
34e49164
C
639 | Define ((s,ii), (defkind, defval)) ->
640 iif ii;
641 vk_define_kind bigf defkind;
642 vk_define_val bigf defval
485bce71
C
643 | Undef (s, ii) ->
644 iif ii
645 | PragmaAndCo (ii) ->
646 iif ii
647 in f (k, bigf) directive
34e49164 648
34e49164
C
649
650and vk_define_kind bigf defkind =
651 match defkind with
652 | DefineVar -> ()
653 | DefineFunc (params, ii) ->
654 vk_ii bigf ii;
655 params +> List.iter (fun ((s,iis), iicomma) ->
656 vk_ii bigf iis;
657 vk_ii bigf iicomma;
658 )
659
660and vk_define_val bigf defval =
485bce71
C
661 let f = bigf.kdefineval in
662
663 let rec k defval =
34e49164
C
664 match defval with
665 | DefineExpr e ->
666 vk_expr bigf e
667 | DefineStmt stmt -> vk_statement bigf stmt
485bce71 668 | DefineDoWhileZero ((stmt, e), ii) ->
34e49164 669 vk_statement bigf stmt;
485bce71 670 vk_expr bigf e;
34e49164
C
671 vk_ii bigf ii
672 | DefineFunction def -> vk_def bigf def
673 | DefineType ty -> vk_type bigf ty
674 | DefineText (s, ii) -> vk_ii bigf ii
675 | DefineEmpty -> ()
485bce71
C
676 | DefineInit ini -> vk_ini bigf ini
677
678 | DefineTodo ->
91eba41f 679 pr2_once "DefineTodo";
485bce71
C
680 ()
681 in f (k, bigf) defval
682
34e49164
C
683
684
685
686(* ------------------------------------------------------------------------ *)
687(* Now keep fullstatement inside the control flow node,
688 * so that can then get in a MetaStmtVar the fullstatement to later
689 * pp back when the S is in a +. But that means that
690 * Exp will match an Ifnode even if there is no such exp
691 * inside the condition of the Ifnode (because the exp may
692 * be deeper, in the then branch). So have to not visit
693 * all inside a node anymore.
694 *
485bce71 695 * update: j'ai choisi d'accrocher au noeud du CFG a la
34e49164
C
696 * fois le fullstatement et le partialstatement et appeler le
697 * visiteur que sur le partialstatement.
698 *)
699
700and vk_node = fun bigf node ->
701 let iif ii = vk_ii bigf ii in
702 let infof info = vk_info bigf info in
703
704 let f = bigf.knode in
705 let rec k n =
706 match F.unwrap n with
707
91eba41f
C
708 | F.FunHeader (def) ->
709 assert(null (fst def).f_body);
710 vk_def bigf def;
34e49164
C
711
712 | F.Decl decl -> vk_decl bigf decl
713 | F.ExprStatement (st, (eopt, ii)) ->
714 iif ii;
715 eopt +> do_option (vk_expr bigf)
716
717 | F.IfHeader (_, (e,ii))
718 | F.SwitchHeader (_, (e,ii))
719 | F.WhileHeader (_, (e,ii))
720 | F.DoWhileTail (e,ii) ->
721 iif ii;
722 vk_expr bigf e
723
724 | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
725 iif i1; iif i2; iif i3;
726 iif ii;
727 e1opt +> do_option (vk_expr bigf);
728 e2opt +> do_option (vk_expr bigf);
729 e3opt +> do_option (vk_expr bigf);
730 | F.MacroIterHeader (_s, ((s,es), ii)) ->
731 iif ii;
485bce71 732 vk_argument_list bigf es;
34e49164
C
733
734 | F.ReturnExpr (_st, (e,ii)) -> iif ii; vk_expr bigf e
735
736 | F.Case (_st, (e,ii)) -> iif ii; vk_expr bigf e
737 | F.CaseRange (_st, ((e1, e2),ii)) ->
738 iif ii; vk_expr bigf e1; vk_expr bigf e2
739
740
741 | F.CaseNode i -> ()
742
743 | F.DefineExpr e -> vk_expr bigf e
744 | F.DefineType ft -> vk_type bigf ft
745 | F.DefineHeader ((s,ii), (defkind)) ->
746 iif ii;
747 vk_define_kind bigf defkind;
748
749 | F.DefineDoWhileZeroHeader (((),ii)) -> iif ii
485bce71 750 | F.DefineTodo ->
91eba41f 751 pr2_once "DefineTodo";
485bce71
C
752 ()
753
34e49164 754
485bce71 755 | F.Include {i_include = (s, ii);} -> iif ii;
34e49164
C
756
757 | F.MacroTop (s, args, ii) ->
758 iif ii;
485bce71 759 vk_argument_list bigf args
34e49164 760
485bce71
C
761 | F.IfdefHeader (info) -> vk_ifdef_directive bigf info
762 | F.IfdefElse (info) -> vk_ifdef_directive bigf info
763 | F.IfdefEndif (info) -> vk_ifdef_directive bigf info
34e49164
C
764
765 | F.Break (st,((),ii)) -> iif ii
766 | F.Continue (st,((),ii)) -> iif ii
767 | F.Default (st,((),ii)) -> iif ii
768 | F.Return (st,((),ii)) -> iif ii
769 | F.Goto (st, (s,ii)) -> iif ii
770 | F.Label (st, (s,ii)) -> iif ii
485bce71 771
34e49164 772 | F.DoHeader (st, info) -> infof info
485bce71 773
34e49164 774 | F.Else info -> infof info
485bce71
C
775 | F.EndStatement iopt -> do_option infof iopt
776
34e49164
C
777 | F.SeqEnd (i, info) -> infof info
778 | F.SeqStart (st, i, info) -> infof info
779
780 | F.MacroStmt (st, ((),ii)) -> iif ii
781 | F.Asm (st, (asmbody,ii)) ->
782 iif ii;
783 vk_asmbody bigf asmbody
784
785 | (
786 F.TopNode|F.EndNode|
787 F.ErrorExit|F.Exit|F.Enter|
788 F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
789 F.Fake
790 ) -> ()
791
792
793
794 in
795 f (k, bigf) node
796
797(* ------------------------------------------------------------------------ *)
798and vk_info = fun bigf info ->
799 let rec infof ii = bigf.kinfo (k, bigf) ii
800 and k i = ()
801 in
802 infof info
803
804and vk_ii = fun bigf ii ->
805 List.iter (vk_info bigf) ii
806
807
485bce71
C
808(* ------------------------------------------------------------------------ *)
809and vk_argument = fun bigf arg ->
810 let rec do_action = function
811 | (ActMisc ii) -> vk_ii bigf ii
812 in
813 match arg with
814 | Left e -> (vk_expr bigf) e
815 | Right (ArgType param) -> vk_param bigf param
816 | Right (ArgAction action) -> do_action action
817
818and vk_argument_list = fun bigf es ->
819 let iif ii = vk_ii bigf ii in
820 es +> List.iter (fun (e, ii) ->
821 iif ii;
822 vk_argument bigf e
823 )
824
825
826
34e49164
C
827and vk_param = fun bigf (((b, s, t), ii_b_s)) ->
828 let iif ii = vk_ii bigf ii in
829 iif ii_b_s;
830 vk_type bigf t
831
485bce71
C
832and vk_param_list = fun bigf ts ->
833 let iif ii = vk_ii bigf ii in
834 ts +> List.iter (fun (param,iicomma) ->
835 vk_param bigf param;
836 iif iicomma;
837 )
838
839
840
841(* ------------------------------------------------------------------------ *)
842and vk_asmbody = fun bigf (string_list, colon_list) ->
843 let iif ii = vk_ii bigf ii in
844
845 iif string_list;
846 colon_list +> List.iter (fun (Colon xs, ii) ->
847 iif ii;
848 xs +> List.iter (fun (x,iicomma) ->
849 iif iicomma;
850 (match x with
851 | ColonMisc, ii -> iif ii
852 | ColonExpr e, ii ->
853 vk_expr bigf e;
854 iif ii
855 )
856 ))
857
34e49164 858
485bce71 859(* ------------------------------------------------------------------------ *)
34e49164
C
860let vk_args_splitted = fun bigf args_splitted ->
861 let iif ii = vk_ii bigf ii in
862 args_splitted +> List.iter (function
863 | Left arg -> vk_argument bigf arg
864 | Right ii -> iif ii
865 )
866
867
868let vk_define_params_splitted = fun bigf args_splitted ->
869 let iif ii = vk_ii bigf ii in
870 args_splitted +> List.iter (function
871 | Left (s, iis) -> vk_ii bigf iis
872 | Right ii -> iif ii
873 )
874
875
876
877let vk_params_splitted = fun bigf args_splitted ->
878 let iif ii = vk_ii bigf ii in
879 args_splitted +> List.iter (function
880 | Left arg -> vk_param bigf arg
881 | Right ii -> iif ii
882 )
883
485bce71 884(* ------------------------------------------------------------------------ *)
34e49164
C
885let vk_cst = fun bigf (cst, ii) ->
886 let iif ii = vk_ii bigf ii in
887 iif ii;
888 (match cst with
889 | Left cst -> ()
890 | Right s -> ()
891 )
892
893
894
895
896(*****************************************************************************)
897(* "syntetisized attributes" style *)
898(*****************************************************************************)
485bce71
C
899
900(* TODO port the xxs_s to new cpp construct too *)
901
34e49164
C
902type 'a inout = 'a -> 'a
903
904(* _s for synthetizized attributes
905 *
906 * Note that I don't visit necesserally in the order of the token
907 * found in the original file. So don't assume such hypothesis!
908 *)
909type visitor_c_s = {
910 kexpr_s: (expression inout * visitor_c_s) -> expression inout;
911 kstatement_s: (statement inout * visitor_c_s) -> statement inout;
912 ktype_s: (fullType inout * visitor_c_s) -> fullType inout;
34e49164
C
913
914 kdecl_s: (declaration inout * visitor_c_s) -> declaration inout;
915 kdef_s: (definition inout * visitor_c_s) -> definition inout;
916
485bce71 917 kini_s: (initialiser inout * visitor_c_s) -> initialiser inout;
34e49164 918
485bce71 919 kcppdirective_s: (cpp_directive inout * visitor_c_s) -> cpp_directive inout;
34e49164 920 kdefineval_s: (define_val inout * visitor_c_s) -> define_val inout;
485bce71
C
921 kstatementseq_s: (statement_sequencable inout * visitor_c_s) -> statement_sequencable inout;
922 kstatementseq_list_s: (statement_sequencable list inout * visitor_c_s) -> statement_sequencable list inout;
923
924 knode_s: (F.node inout * visitor_c_s) -> F.node inout;
34e49164 925
485bce71
C
926
927 ktoplevel_s: (toplevel inout * visitor_c_s) -> toplevel inout;
34e49164
C
928 kinfo_s: (info inout * visitor_c_s) -> info inout;
929 }
930
931let default_visitor_c_s =
932 { kexpr_s = (fun (k,_) e -> k e);
933 kstatement_s = (fun (k,_) st -> k st);
934 ktype_s = (fun (k,_) t -> k t);
935 kdecl_s = (fun (k,_) d -> k d);
936 kdef_s = (fun (k,_) d -> k d);
937 kini_s = (fun (k,_) d -> k d);
938 ktoplevel_s = (fun (k,_) p -> k p);
939 knode_s = (fun (k,_) n -> k n);
940 kinfo_s = (fun (k,_) i -> k i);
941 kdefineval_s = (fun (k,_) x -> k x);
485bce71
C
942 kstatementseq_s = (fun (k,_) x -> k x);
943 kstatementseq_list_s = (fun (k,_) x -> k x);
944 kcppdirective_s = (fun (k,_) x -> k x);
34e49164
C
945 }
946
947let rec vk_expr_s = fun bigf expr ->
948 let iif ii = vk_ii_s bigf ii in
949 let rec exprf e = bigf.kexpr_s (k, bigf) e
950 and k e =
951 let ((unwrap_e, typ), ii) = e in
91eba41f 952 (* !!! don't analyse optional type !!!
34e49164
C
953 * old: typ +> map_option (vk_type_s bigf) in
954 *)
955 let typ' = typ in
956 let e' =
957 match unwrap_e with
958 | Ident (s) -> Ident (s)
959 | Constant (c) -> Constant (c)
960 | FunCall (e, es) ->
961 FunCall (exprf e,
962 es +> List.map (fun (e,ii) ->
963 vk_argument_s bigf e, iif ii
964 ))
965
faf9a90c 966 | CondExpr (e1, e2, e3) -> CondExpr (exprf e1, fmap exprf e2, exprf e3)
34e49164
C
967 | Sequence (e1, e2) -> Sequence (exprf e1, exprf e2)
968 | Assignment (e1, op, e2) -> Assignment (exprf e1, op, exprf e2)
969
970 | Postfix (e, op) -> Postfix (exprf e, op)
971 | Infix (e, op) -> Infix (exprf e, op)
972 | Unary (e, op) -> Unary (exprf e, op)
973 | Binary (e1, op, e2) -> Binary (exprf e1, op, exprf e2)
974
975 | ArrayAccess (e1, e2) -> ArrayAccess (exprf e1, exprf e2)
976 | RecordAccess (e, s) -> RecordAccess (exprf e, s)
977 | RecordPtAccess (e, s) -> RecordPtAccess (exprf e, s)
978
979 | SizeOfExpr (e) -> SizeOfExpr (exprf e)
980 | SizeOfType (t) -> SizeOfType (vk_type_s bigf t)
981 | Cast (t, e) -> Cast (vk_type_s bigf t, exprf e)
982
983 | StatementExpr (statxs, is) ->
984 StatementExpr (
485bce71 985 vk_statement_sequencable_list_s bigf statxs,
34e49164
C
986 iif is)
987 | Constructor (t, initxs) ->
988 Constructor
989 (vk_type_s bigf t,
990 (initxs +> List.map (fun (ini, ii) ->
991 vk_ini_s bigf ini, vk_ii_s bigf ii)
992 ))
993
994 | ParenExpr (e) -> ParenExpr (exprf e)
995
996 in
997 (e', typ'), (iif ii)
998 in exprf expr
999
1000and vk_argument_s bigf argument =
1001 let iif ii = vk_ii_s bigf ii in
1002 let rec do_action = function
1003 | (ActMisc ii) -> ActMisc (iif ii)
1004 in
1005 (match argument with
1006 | Left e -> Left (vk_expr_s bigf e)
1007 | Right (ArgType param) -> Right (ArgType (vk_param_s bigf param))
1008 | Right (ArgAction action) -> Right (ArgAction (do_action action))
1009 )
1010
1011
1012
1013
1014
1015
1016and vk_statement_s = fun bigf st ->
1017 let rec statf st = bigf.kstatement_s (k, bigf) st
1018 and k st =
1019 let (unwrap_st, ii) = st in
1020 let st' =
1021 match unwrap_st with
1022 | Labeled (Label (s, st)) ->
1023 Labeled (Label (s, statf st))
1024 | Labeled (Case (e, st)) ->
1025 Labeled (Case ((vk_expr_s bigf) e , statf st))
1026 | Labeled (CaseRange (e, e2, st)) ->
1027 Labeled (CaseRange ((vk_expr_s bigf) e,
1028 (vk_expr_s bigf) e2,
1029 statf st))
1030 | Labeled (Default st) -> Labeled (Default (statf st))
1031 | Compound statxs ->
485bce71 1032 Compound (vk_statement_sequencable_list_s bigf statxs)
34e49164
C
1033 | ExprStatement (None) -> ExprStatement (None)
1034 | ExprStatement (Some e) -> ExprStatement (Some ((vk_expr_s bigf) e))
1035 | Selection (If (e, st1, st2)) ->
1036 Selection (If ((vk_expr_s bigf) e, statf st1, statf st2))
34e49164
C
1037 | Selection (Switch (e, st)) ->
1038 Selection (Switch ((vk_expr_s bigf) e, statf st))
1039 | Iteration (While (e, st)) ->
1040 Iteration (While ((vk_expr_s bigf) e, statf st))
1041 | Iteration (DoWhile (st, e)) ->
1042 Iteration (DoWhile (statf st, (vk_expr_s bigf) e))
1043 | Iteration (For ((e1opt,i1), (e2opt,i2), (e3opt,i3), st)) ->
1044 let e1opt' = statf (ExprStatement (e1opt),i1) in
1045 let e2opt' = statf (ExprStatement (e2opt),i2) in
1046 let e3opt' = statf (ExprStatement (e3opt),i3) in
1047 (match (e1opt', e2opt', e3opt') with
1048 | ((ExprStatement x1,i1), (ExprStatement x2,i2), ((ExprStatement x3,i3))) ->
1049 Iteration (For ((x1,i1), (x2,i2), (x3,i3), statf st))
1050 | x -> failwith "cant be here if iterator keep ExprStatement as is"
1051 )
1052
1053 | Iteration (MacroIteration (s, es, st)) ->
1054 Iteration
1055 (MacroIteration
1056 (s,
1057 es +> List.map (fun (e, ii) ->
1058 vk_argument_s bigf e, vk_ii_s bigf ii
1059 ),
1060 statf st
1061 ))
1062
1063
1064 | Jump (Goto s) -> Jump (Goto s)
1065 | Jump (((Continue|Break|Return) as x)) -> Jump (x)
1066 | Jump (ReturnExpr e) -> Jump (ReturnExpr ((vk_expr_s bigf) e))
1067 | Jump (GotoComputed e) -> Jump (GotoComputed (vk_expr_s bigf e));
1068
1069 | Decl decl -> Decl (vk_decl_s bigf decl)
1070 | Asm asmbody -> Asm (vk_asmbody_s bigf asmbody)
1071 | NestedFunc def -> NestedFunc (vk_def_s bigf def)
1072 | MacroStmt -> MacroStmt
1073 in
1074 st', vk_ii_s bigf ii
1075 in statf st
1076
485bce71
C
1077
1078and vk_statement_sequencable_s = fun bigf stseq ->
1079 let f = bigf.kstatementseq_s in
1080 let k stseq =
1081
1082 match stseq with
1083 | StmtElem st ->
1084 StmtElem (vk_statement_s bigf st)
1085 | CppDirectiveStmt directive ->
1086 CppDirectiveStmt (vk_cpp_directive_s bigf directive)
1087 | IfdefStmt ifdef ->
1088 IfdefStmt (vk_ifdef_directive_s bigf ifdef)
1089 | IfdefStmt2 (ifdef, xxs) ->
1090 let ifdef' = List.map (vk_ifdef_directive_s bigf) ifdef in
1091 let xxs' = xxs +> List.map (fun xs ->
1092 xs +> List.map (vk_statement_sequencable_s bigf)
1093 )
1094 in
1095 IfdefStmt2(ifdef', xxs')
1096 in f (k, bigf) stseq
1097
1098and vk_statement_sequencable_list_s = fun bigf statxs ->
1099 let f = bigf.kstatementseq_list_s in
1100 let k xs =
1101 xs +> List.map (vk_statement_sequencable_s bigf)
1102 in
1103 f (k, bigf) statxs
1104
1105
1106
34e49164
C
1107and vk_asmbody_s = fun bigf (string_list, colon_list) ->
1108 let iif ii = vk_ii_s bigf ii in
1109
1110 iif string_list,
1111 colon_list +> List.map (fun (Colon xs, ii) ->
1112 Colon
1113 (xs +> List.map (fun (x, iicomma) ->
1114 (match x with
1115 | ColonMisc, ii -> ColonMisc, iif ii
1116 | ColonExpr e, ii -> ColonExpr (vk_expr_s bigf e), iif ii
1117 ), iif iicomma
1118 )),
1119 iif ii
1120 )
1121
1122
1123
1124
0708f913 1125(* todo? a visitor for qualifier *)
34e49164
C
1126and vk_type_s = fun bigf t ->
1127 let rec typef t = bigf.ktype_s (k,bigf) t
1128 and iif ii = vk_ii_s bigf ii
1129 and k t =
1130 let (q, t) = t in
1131 let (unwrap_q, iiq) = q in
faf9a90c
C
1132 (* strip_info_visitor needs iiq to be processed before iit *)
1133 let iif_iiq = iif iiq in
0708f913 1134 let q' = unwrap_q in
34e49164
C
1135 let (unwrap_t, iit) = t in
1136 let t' =
1137 match unwrap_t with
1138 | BaseType x -> BaseType x
1139 | Pointer t -> Pointer (typef t)
1140 | Array (eopt, t) -> Array (fmap (vk_expr_s bigf) eopt, typef t)
1141 | FunctionType (returnt, paramst) ->
1142 FunctionType
1143 (typef returnt,
1144 (match paramst with
1145 | (ts, (b, iihas3dots)) ->
1146 (ts +> List.map (fun (param,iicomma) ->
1147 (vk_param_s bigf param, iif iicomma)),
1148 (b, iif iihas3dots))
1149 ))
1150
1151 | Enum (sopt, enumt) ->
1152 Enum (sopt,
1153 enumt +> List.map (fun (((s, eopt),ii_s_eq), iicomma) ->
1154 ((s, fmap (vk_expr_s bigf) eopt), iif ii_s_eq),
1155 iif iicomma
1156 )
1157 )
1158 | StructUnion (sopt, su, fields) ->
1159 StructUnion (sopt, su, vk_struct_fields_s bigf fields)
1160
1161
1162 | StructUnionName (s, structunion) -> StructUnionName (s, structunion)
1163 | EnumName s -> EnumName s
1164 | TypeName (s, typ) -> TypeName (s, typ)
1165
1166 | ParenType t -> ParenType (typef t)
1167 | TypeOfExpr e -> TypeOfExpr (vk_expr_s bigf e)
1168 | TypeOfType t -> TypeOfType (typef t)
1169 in
faf9a90c
C
1170 (q', iif_iiq),
1171 (t', iif iit)
34e49164
C
1172
1173
1174 in typef t
1175
485bce71
C
1176and vk_attribute_s = fun bigf attr ->
1177 let iif ii = vk_ii_s bigf ii in
1178 match attr with
1179 | Attribute s, ii ->
1180 Attribute s, iif ii
1181
1182
1183
34e49164
C
1184and vk_decl_s = fun bigf d ->
1185 let f = bigf.kdecl_s in
1186 let iif ii = vk_ii_s bigf ii in
1187 let rec k decl =
1188 match decl with
1189 | DeclList (xs, ii) ->
1190 DeclList (List.map aux xs, iif ii)
1191 | MacroDecl ((s, args),ii) ->
1192 MacroDecl
1193 ((s,
1194 args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii)
1195 ),
1196 iif ii)
1197
1198
485bce71
C
1199 and aux ({v_namei = var; v_type = t;
1200 v_storage = sto; v_local= local; v_attr = attrs}, iicomma) =
1201 {v_namei =
1202 (var +> map_option (fun ((s, ini), ii_s_ini) ->
34e49164
C
1203 (s, ini +> map_option (fun init -> vk_ini_s bigf init)),
1204 iif ii_s_ini
485bce71
C
1205 )
1206 );
1207 v_type = vk_type_s bigf t;
1208 v_storage = sto;
1209 v_local = local;
1210 v_attr = attrs +> List.map (vk_attribute_s bigf);
1211 },
1212 iif iicomma
34e49164
C
1213
1214 in f (k, bigf) d
1215
1216and vk_ini_s = fun bigf ini ->
1217 let rec inif ini = bigf.kini_s (k,bigf) ini
1218 and k ini =
1219 let (unwrap_ini, ii) = ini in
1220 let ini' =
1221 match unwrap_ini with
1222 | InitExpr e -> InitExpr (vk_expr_s bigf e)
1223 | InitList initxs ->
1224 InitList (initxs +> List.map (fun (ini, ii) ->
1225 inif ini, vk_ii_s bigf ii)
1226 )
1227
1228
1229 | InitDesignators (xs, e) ->
1230 InitDesignators
1231 (xs +> List.map (vk_designator_s bigf),
1232 inif e
1233 )
1234
1235 | InitFieldOld (s, e) -> InitFieldOld (s, inif e)
1236 | InitIndexOld (e1, e) -> InitIndexOld (vk_expr_s bigf e1, inif e)
1237
485bce71 1238
34e49164
C
1239 in ini', vk_ii_s bigf ii
1240 in inif ini
1241
1242
1243and vk_designator_s = fun bigf design ->
1244 let iif ii = vk_ii_s bigf ii in
1245 let (designator, ii) = design in
1246 (match designator with
1247 | DesignatorField s -> DesignatorField s
1248 | DesignatorIndex e -> DesignatorIndex (vk_expr_s bigf e)
1249 | DesignatorRange (e1, e2) ->
1250 DesignatorRange (vk_expr_s bigf e1, vk_expr_s bigf e2)
1251 ), iif ii
1252
1253
1254
1255
485bce71
C
1256and vk_struct_fieldkinds_s = fun bigf onefield_multivars ->
1257 let iif ii = vk_ii_s bigf ii in
1258
1259 onefield_multivars +> List.map (fun (field, iicomma) ->
1260 (match field with
1261 | Simple (s, t), iis -> Simple (s, vk_type_s bigf t), iif iis
1262 | BitField (sopt, t, expr), iis ->
1263 BitField (sopt, vk_type_s bigf t, vk_expr_s bigf expr),
1264 iif iis
1265 ), iif iicomma
1266 )
1267
34e49164
C
1268and vk_struct_fields_s = fun bigf fields ->
1269
1270 let iif ii = vk_ii_s bigf ii in
1271
1272 fields +> List.map (fun (xfield, iiptvirg) ->
1273
1274 (match xfield with
485bce71
C
1275 | (DeclarationField (FieldDeclList (onefield_multivars, iiptvirg))) ->
1276 DeclarationField
1277 (FieldDeclList
1278 (vk_struct_fieldkinds_s bigf onefield_multivars, iif iiptvirg))
34e49164 1279 | EmptyField -> EmptyField
485bce71 1280 | MacroStructDeclTodo ->
91eba41f 1281 pr2_once "MacroStructDeclTodo";
485bce71
C
1282 MacroStructDeclTodo
1283
1284 | CppDirectiveStruct directive ->
1285 CppDirectiveStruct (vk_cpp_directive_s bigf directive)
1286 | IfdefStruct ifdef ->
1287 IfdefStruct (vk_ifdef_directive_s bigf ifdef)
1288
34e49164
C
1289 ), iif iiptvirg
1290 )
1291
1292
1293and vk_def_s = fun bigf d ->
1294 let f = bigf.kdef_s in
1295 let iif ii = vk_ii_s bigf ii in
1296 let rec k d =
1297 match d with
485bce71
C
1298 | {f_name = s;
1299 f_type = (returnt, (paramst, (b, iib)));
1300 f_storage = sto;
1301 f_body = statxs;
1302 f_attr = attrs;
91eba41f 1303 f_old_c_style = oldstyle;
485bce71
C
1304 }, ii
1305 ->
1306 {f_name = s;
1307 f_type =
1308 (vk_type_s bigf returnt,
1309 (paramst +> List.map (fun (param, iicomma) ->
1310 (vk_param_s bigf param, iif iicomma)
1311 ), (b, iif iib)));
1312 f_storage = sto;
1313 f_body =
1314 vk_statement_sequencable_list_s bigf statxs;
1315 f_attr =
91eba41f
C
1316 attrs +> List.map (vk_attribute_s bigf);
1317 f_old_c_style =
1318 oldstyle +> Common.map_option (fun decls ->
1319 decls +> List.map (vk_decl_s bigf)
1320 );
485bce71 1321 },
34e49164
C
1322 iif ii
1323
1324 in f (k, bigf) d
1325
1326and vk_toplevel_s = fun bigf p ->
1327 let f = bigf.ktoplevel_s in
1328 let iif ii = vk_ii_s bigf ii in
1329 let rec k p =
1330 match p with
1331 | Declaration decl -> Declaration (vk_decl_s bigf decl)
1332 | Definition def -> Definition (vk_def_s bigf def)
1333 | EmptyDef ii -> EmptyDef (iif ii)
1334 | MacroTop (s, xs, ii) ->
1335 MacroTop
1336 (s,
1337 xs +> List.map (fun (elem, iicomma) ->
1338 vk_argument_s bigf elem, iif iicomma
1339 ),
1340 iif ii
1341 )
485bce71
C
1342 | CppTop top -> CppTop (vk_cpp_directive_s bigf top)
1343 | IfdefTop ifdefdir -> IfdefTop (vk_ifdef_directive_s bigf ifdefdir)
34e49164
C
1344
1345 | NotParsedCorrectly ii -> NotParsedCorrectly (iif ii)
1346 | FinalDef info -> FinalDef (vk_info_s bigf info)
1347 in f (k, bigf) p
1348
485bce71
C
1349and vk_program_s = fun bigf xs ->
1350 xs +> List.map (vk_toplevel_s bigf)
1351
1352
1353and vk_cpp_directive_s = fun bigf top ->
1354 let iif ii = vk_ii_s bigf ii in
1355 let f = bigf.kcppdirective_s in
1356 let rec k top =
1357 match top with
1358 (* go inside ? *)
1359 | Include {i_include = (s, ii);
1360 i_rel_pos = h_rel_pos;
1361 i_is_in_ifdef = b;
1362 i_content = copt;
1363 }
1364 -> Include {i_include = (s, iif ii);
1365 i_rel_pos = h_rel_pos;
1366 i_is_in_ifdef = b;
1367 i_content = copt +> Common.map_option (fun (file, asts) ->
1368 file, vk_program_s bigf asts
1369 );
1370 }
1371 | Define ((s,ii), (defkind, defval)) ->
1372 Define ((s, iif ii),
1373 (vk_define_kind_s bigf defkind, vk_define_val_s bigf defval))
1374 | Undef (s, ii) -> Undef (s, iif ii)
1375 | PragmaAndCo (ii) -> PragmaAndCo (iif ii)
1376
1377 in f (k, bigf) top
1378
1379and vk_ifdef_directive_s = fun bigf ifdef ->
1380 let iif ii = vk_ii_s bigf ii in
1381 match ifdef with
1382 | IfdefDirective (ifkind, ii) -> IfdefDirective (ifkind, iif ii)
1383
1384
1385
34e49164
C
1386and vk_define_kind_s = fun bigf defkind ->
1387 match defkind with
1388 | DefineVar -> DefineVar
1389 | DefineFunc (params, ii) ->
1390 DefineFunc
1391 (params +> List.map (fun ((s,iis),iicomma) ->
1392 ((s, vk_ii_s bigf iis), vk_ii_s bigf iicomma)
1393 ),
1394 vk_ii_s bigf ii
1395 )
1396
1397
1398and vk_define_val_s = fun bigf x ->
1399 let f = bigf.kdefineval_s in
1400 let iif ii = vk_ii_s bigf ii in
1401 let rec k x =
1402 match x with
1403 | DefineExpr e -> DefineExpr (vk_expr_s bigf e)
1404 | DefineStmt st -> DefineStmt (vk_statement_s bigf st)
485bce71
C
1405 | DefineDoWhileZero ((st,e),ii) ->
1406 let st' = vk_statement_s bigf st in
1407 let e' = vk_expr_s bigf e in
1408 DefineDoWhileZero ((st',e'), iif ii)
34e49164
C
1409 | DefineFunction def -> DefineFunction (vk_def_s bigf def)
1410 | DefineType ty -> DefineType (vk_type_s bigf ty)
1411 | DefineText (s, ii) -> DefineText (s, iif ii)
1412 | DefineEmpty -> DefineEmpty
485bce71
C
1413 | DefineInit ini -> DefineInit (vk_ini_s bigf ini)
1414
1415 | DefineTodo ->
91eba41f 1416 pr2_once "DefineTodo";
485bce71 1417 DefineTodo
34e49164
C
1418 in
1419 f (k, bigf) x
1420
1421
1422and vk_info_s = fun bigf info ->
1423 let rec infof ii = bigf.kinfo_s (k, bigf) ii
1424 and k i = i
1425 in
1426 infof info
1427
1428and vk_ii_s = fun bigf ii ->
1429 List.map (vk_info_s bigf) ii
1430
1431(* ------------------------------------------------------------------------ *)
1432and vk_node_s = fun bigf node ->
1433 let iif ii = vk_ii_s bigf ii in
1434 let infof info = vk_info_s bigf info in
1435
1436 let rec nodef n = bigf.knode_s (k, bigf) n
1437 and k node =
1438 F.rewrap node (
1439 match F.unwrap node with
91eba41f
C
1440 | F.FunHeader (def) ->
1441 assert (null (fst def).f_body);
1442 F.FunHeader (vk_def_s bigf def)
34e49164
C
1443
1444 | F.Decl declb -> F.Decl (vk_decl_s bigf declb)
1445 | F.ExprStatement (st, (eopt, ii)) ->
1446 F.ExprStatement (st, (eopt +> map_option (vk_expr_s bigf), iif ii))
1447
1448 | F.IfHeader (st, (e,ii)) ->
1449 F.IfHeader (st, (vk_expr_s bigf e, iif ii))
1450 | F.SwitchHeader (st, (e,ii)) ->
1451 F.SwitchHeader(st, (vk_expr_s bigf e, iif ii))
1452 | F.WhileHeader (st, (e,ii)) ->
1453 F.WhileHeader (st, (vk_expr_s bigf e, iif ii))
1454 | F.DoWhileTail (e,ii) ->
1455 F.DoWhileTail (vk_expr_s bigf e, iif ii)
1456
1457 | F.ForHeader (st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
1458 F.ForHeader (st,
1459 (((e1opt +> Common.map_option (vk_expr_s bigf), iif i1),
1460 (e2opt +> Common.map_option (vk_expr_s bigf), iif i2),
1461 (e3opt +> Common.map_option (vk_expr_s bigf), iif i3)),
1462 iif ii))
1463
1464 | F.MacroIterHeader (st, ((s,es), ii)) ->
1465 F.MacroIterHeader
1466 (st,
1467 ((s, es +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii)),
1468 iif ii))
1469
1470
1471 | F.ReturnExpr (st, (e,ii)) ->
1472 F.ReturnExpr (st, (vk_expr_s bigf e, iif ii))
1473
1474 | F.Case (st, (e,ii)) -> F.Case (st, (vk_expr_s bigf e, iif ii))
1475 | F.CaseRange (st, ((e1, e2),ii)) ->
1476 F.CaseRange (st, ((vk_expr_s bigf e1, vk_expr_s bigf e2), iif ii))
1477
1478 | F.CaseNode i -> F.CaseNode i
1479
1480 | F.DefineHeader((s,ii), (defkind)) ->
1481 F.DefineHeader ((s, iif ii), (vk_define_kind_s bigf defkind))
1482
1483 | F.DefineExpr e -> F.DefineExpr (vk_expr_s bigf e)
1484 | F.DefineType ft -> F.DefineType (vk_type_s bigf ft)
1485 | F.DefineDoWhileZeroHeader ((),ii) ->
1486 F.DefineDoWhileZeroHeader ((),iif ii)
485bce71
C
1487 | F.DefineTodo -> F.DefineTodo
1488
1489 | F.Include {i_include = (s, ii);
1490 i_rel_pos = h_rel_pos;
1491 i_is_in_ifdef = b;
1492 i_content = copt;
1493 }
1494 ->
1495 assert (copt = None);
1496 F.Include {i_include = (s, iif ii);
1497 i_rel_pos = h_rel_pos;
1498 i_is_in_ifdef = b;
1499 i_content = copt;
1500 }
34e49164 1501
34e49164
C
1502 | F.MacroTop (s, args, ii) ->
1503 F.MacroTop
1504 (s,
1505 args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii),
1506 iif ii)
1507
1508
1509 | F.MacroStmt (st, ((),ii)) -> F.MacroStmt (st, ((),iif ii))
1510 | F.Asm (st, (body,ii)) -> F.Asm (st, (vk_asmbody_s bigf body,iif ii))
1511
1512 | F.Break (st,((),ii)) -> F.Break (st,((),iif ii))
1513 | F.Continue (st,((),ii)) -> F.Continue (st,((),iif ii))
1514 | F.Default (st,((),ii)) -> F.Default (st,((),iif ii))
1515 | F.Return (st,((),ii)) -> F.Return (st,((),iif ii))
1516 | F.Goto (st, (s,ii)) -> F.Goto (st, (s,iif ii))
1517 | F.Label (st, (s,ii)) -> F.Label (st, (s,iif ii))
1518 | F.EndStatement iopt -> F.EndStatement (map_option infof iopt)
1519 | F.DoHeader (st, info) -> F.DoHeader (st, infof info)
1520 | F.Else info -> F.Else (infof info)
1521 | F.SeqEnd (i, info) -> F.SeqEnd (i, infof info)
1522 | F.SeqStart (st, i, info) -> F.SeqStart (st, i, infof info)
1523
485bce71
C
1524 | F.IfdefHeader (info) -> F.IfdefHeader (vk_ifdef_directive_s bigf info)
1525 | F.IfdefElse (info) -> F.IfdefElse (vk_ifdef_directive_s bigf info)
1526 | F.IfdefEndif (info) -> F.IfdefEndif (vk_ifdef_directive_s bigf info)
1527
34e49164
C
1528 | (
1529 (
1530 F.TopNode|F.EndNode|
1531 F.ErrorExit|F.Exit|F.Enter|
1532 F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
1533 F.Fake
1534 ) as x) -> x
1535
1536
1537 )
1538 in
1539 nodef node
1540
1541(* ------------------------------------------------------------------------ *)
1542and vk_param_s = fun bigf ((b, s, t), ii_b_s) ->
1543 let iif ii = vk_ii_s bigf ii in
1544 ((b, s, vk_type_s bigf t), iif ii_b_s)
faf9a90c 1545
34e49164
C
1546let vk_args_splitted_s = fun bigf args_splitted ->
1547 let iif ii = vk_ii_s bigf ii in
1548 args_splitted +> List.map (function
1549 | Left arg -> Left (vk_argument_s bigf arg)
1550 | Right ii -> Right (iif ii)
1551 )
1552
1553let vk_arguments_s = fun bigf args ->
1554 let iif ii = vk_ii_s bigf ii in
1555 args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii)
1556
1557
1558let vk_params_splitted_s = fun bigf args_splitted ->
1559 let iif ii = vk_ii_s bigf ii in
1560 args_splitted +> List.map (function
1561 | Left arg -> Left (vk_param_s bigf arg)
1562 | Right ii -> Right (iif ii)
1563 )
1564
1565let vk_params_s = fun bigf args ->
1566 let iif ii = vk_ii_s bigf ii in
1567 args +> List.map (fun (p,ii) -> vk_param_s bigf p, iif ii)
1568
1569let vk_define_params_splitted_s = fun bigf args_splitted ->
1570 let iif ii = vk_ii_s bigf ii in
1571 args_splitted +> List.map (function
1572 | Left (s, iis) -> Left (s, vk_ii_s bigf iis)
1573 | Right ii -> Right (iif ii)
1574 )
1575
1576let vk_cst_s = fun bigf (cst, ii) ->
1577 let iif ii = vk_ii_s bigf ii in
1578 (match cst with
1579 | Left cst -> Left cst
1580 | Right s -> Right s
1581 ), iif ii