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