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