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


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