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