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