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