HCoop / bpt / coccinelle.git / blob
? search:


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