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