3 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
4 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes
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.
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.
19 module F
= Control_flow_c
21 (*****************************************************************************)
23 (*****************************************************************************)
25 (* todo? dont go in Include. Have a visitor flag ? disable_go_include ?
26 * disable_go_type_annotation ?
29 (*****************************************************************************)
31 (*****************************************************************************)
32 let pr2, pr2_once
= Common.mk_pr2_wrappers
Flag_parsing_c.verbose_visit
34 (*****************************************************************************)
35 (* Functions to visit the Ast, and now also the CFG nodes *)
36 (*****************************************************************************)
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:
49 * | Array of expression option * ctype
53 * | FunCall of expression * expression list
55 * | RecordAccess of ..
64 * What we want is really write code like
66 * let my_analysis program =
67 * analyze_all_expressions program (fun expr ->
69 * | FunCall (e, es) -> do_something()
70 * | _ -> <find_a_way_to_recurse_for_all_the_other_cases>
73 * The problem is how to write analyze_all_expressions
74 * and find_a_way_to_recurse_for_all_the_other_cases.
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:
80 * let my_analysis program =
81 * Visitor.visit_iter program {
82 * Visitor.kexpr = (fun k e ->
84 * | FunCall (e, es) -> do_something()
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.
95 * Note: when want to apply recursively, always apply the continuator
96 * on the toplevel expression, otherwise may miss some intermediate steps.
99 * | FunCall (e, es) -> ...
103 * | FunCall (e, es) -> ...
104 * Visitor_c.vk_expr bigf e
107 * | FunCall (e, es) -> ...
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
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'.
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.
143 * Diff with Julia's visitor ? She does:
147 * let expression r k e =
149 * ... (List.map r.V0.combiner_expression expr_list) ...
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
157 * collect_unitary_nonunitary
158 * (List.concat (List.map res.V0.combiner_top_level t))
162 * So she has to remember at which position you must put the 'expression'
163 * function. I use record which is easier.
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'
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'.
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
182 (* old: first version (only visiting expr)
184 let (iter_expr:((expression -> unit) -> expression -> unit) -> expression -> unit)
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;
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;
199 | ArrayAccess (e1, e2) -> f k e1; f k e2;
200 | RecordAccess (e, s) -> f k e
201 | RecordPtAccess (e, s) -> f k e
203 | SizeOfExpr e -> f k e
205 | _ -> failwith "to complete"
209 let ex1 = Sequence (Sequence (Constant (Ident "1"), Constant (Ident "2")),
210 Constant (Ident "4"))
212 iter_expr (fun k e -> match e with
213 | Constant (Ident x) -> Common.pr2 x
223 (*****************************************************************************)
224 (* Side effect style visitor *)
225 (*****************************************************************************)
227 (* Visitors for all langage concept, not just for expression.
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!
236 kexpr
: (expression -> unit) * visitor_c
-> expression -> unit;
237 kstatement
: (statement
-> unit) * visitor_c
-> statement
-> unit;
238 ktype
: (fullType
-> unit) * visitor_c
-> fullType
-> unit;
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;
246 kini
: (initialiser
-> unit) * visitor_c
-> initialiser
-> unit;
247 kfield
: (field
-> unit) * visitor_c
-> field
-> unit;
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;
255 knode
: (F.node
-> unit) * visitor_c
-> F.node
-> unit;
257 ktoplevel
: (toplevel
-> unit) * visitor_c
-> toplevel
-> unit;
259 kinfo
: (info
-> unit) * visitor_c
-> info
-> unit;
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
);
282 (* ------------------------------------------------------------------------ *)
285 let rec vk_expr = fun bigf expr
->
286 let iif ii
= vk_ii bigf ii
in
288 let rec exprf e
= bigf
.kexpr
(k,bigf
) e
289 (* !!! dont go in _typ !!! *)
290 and k ((e
,_typ
), ii
) =
293 | Ident
(name
) -> vk_name bigf name
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
;
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
;
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
312 | SizeOfExpr
(e
) -> exprf e
313 | SizeOfType
(t
) -> vk_type bigf t
314 | Cast
(t
, e
) -> vk_type bigf t
; exprf e
316 (* old: | StatementExpr (((declxs, statxs), is)), is2 ->
317 * List.iter (vk_decl bigf) declxs;
318 * List.iter (vk_statement bigf) statxs
320 | StatementExpr
((statxs
, is
)) ->
322 statxs
+> List.iter
(vk_statement_sequencable bigf
);
324 | Constructor
(t
, init
) ->
325 vk_type bigf t
; vk_ini bigf init
327 | ParenExpr
(e
) -> exprf e
329 | New
(None
, t
) -> vk_argument bigf t
330 | New
(Some ts
, t
) ->
331 vk_argument_list bigf ts
;
333 | Delete e
-> vk_expr bigf e
339 (* ------------------------------------------------------------------------ *)
340 and vk_name
= fun bigf
ident ->
341 let iif ii
= vk_ii bigf ii
in
343 let rec namef x
= bigf
.kname
(k,bigf
) x
346 | RegularName
(s
, ii
) -> iif ii
347 | CppConcatenatedName xs
->
348 xs
+> List.iter
(fun ((x
,ii1
), ii2
) ->
352 | CppVariadicName
(s
, ii
) -> iif ii
353 | CppIdentBuilder
((s
,iis
), xs
) ->
355 xs
+> List.iter
(fun ((x
,iix
), iicomma
) ->
362 (* ------------------------------------------------------------------------ *)
365 and vk_statement
= fun bigf
(st
: Ast_c.statement
) ->
366 let iif ii
= vk_ii bigf ii
in
368 let rec statf x
= bigf
.kstatement
(k,bigf
) x
370 let (unwrap_st
, ii
) = st
in
373 | Labeled
(Label
(name
, st
)) ->
376 | Labeled
(Case
(e
, st
)) -> vk_expr bigf e
; statf st
;
377 | Labeled
(CaseRange
(e
, e2
, st
)) ->
378 vk_expr bigf e
; vk_expr bigf e2
; statf st
;
379 | Labeled
(Default st
) -> statf st
;
382 statxs
+> List.iter
(vk_statement_sequencable bigf
)
383 | ExprStatement
(eopt
) -> do_option
(vk_expr bigf
) eopt
;
385 | Selection
(If
(e
, st1
, st2
)) ->
386 vk_expr bigf e
; statf st1
; statf st2
;
387 | Selection
(Switch
(e
, st
)) ->
388 vk_expr bigf e
; statf st
;
389 | Iteration
(While
(e
, st
)) ->
390 vk_expr bigf e
; statf st
;
391 | Iteration
(DoWhile
(st
, e
)) -> statf st
; vk_expr bigf e
;
392 | Iteration
(For
(first
, (e2opt
,i2
), (e3opt
,i3
), st
)) ->
394 ForExp
(e1opt
,i1
) -> statf (mk_st
(ExprStatement
(e1opt
)) i1
)
395 | ForDecl decl
-> vk_decl bigf decl
);
396 statf (mk_st
(ExprStatement
(e2opt
)) i2
);
397 statf (mk_st
(ExprStatement
(e3opt
)) i3
);
400 | Iteration
(MacroIteration
(s
, es
, st
)) ->
401 vk_argument_list bigf es
;
404 | Jump
(Goto name
) -> vk_name bigf name
405 | Jump
((Continue
|Break
|Return
)) -> ()
406 | Jump
(ReturnExpr e
) -> vk_expr bigf e
;
407 | Jump
(GotoComputed e
) -> vk_expr bigf e
;
409 | Decl decl
-> vk_decl bigf decl
410 | Asm asmbody
-> vk_asmbody bigf asmbody
411 | NestedFunc def
-> vk_def bigf def
416 and vk_statement_sequencable
= fun bigf stseq
->
417 let f = bigf
.kstatementseq
in
421 | StmtElem st
-> vk_statement bigf st
422 | CppDirectiveStmt directive
->
423 vk_cpp_directive bigf directive
425 vk_ifdef_directive bigf ifdef
426 | IfdefStmt2
(ifdef
, xxs
) ->
427 ifdef
+> List.iter
(vk_ifdef_directive bigf
);
428 xxs
+> List.iter
(fun xs
->
429 xs
+> List.iter
(vk_statement_sequencable bigf
)
436 and vk_type
= fun bigf t
->
437 let iif ii
= vk_ii bigf ii
in
439 let rec typef x
= bigf
.ktype
(k, bigf
) x
442 let (unwrap_q
, iiq
) = q
in
443 let (unwrap_t
, iit
) = t
in
449 | Pointer t
-> typef t
451 do_option
(vk_expr bigf
) eopt
;
453 | FunctionType
(returnt
, paramst
) ->
456 | (ts
, (b
,iihas3dots
)) ->
458 vk_param_list bigf ts
461 | Enum
(sopt
, enumt
) ->
462 vk_enum_fields bigf enumt
464 | StructUnion
(sopt
, _su
, fields
) ->
465 vk_struct_fields bigf fields
467 | StructUnionName
(s
, structunion
) -> ()
470 (* dont go in _typ *)
471 | TypeName
(name
,_typ
) ->
474 | ParenType t
-> typef t
475 | TypeOfExpr e
-> vk_expr bigf e
476 | TypeOfType t
-> typef t
481 and vk_attribute
= fun bigf attr
->
482 let iif ii
= vk_ii bigf ii
in
488 (* ------------------------------------------------------------------------ *)
490 and vk_decl
= fun bigf d
->
491 let iif ii
= vk_ii bigf ii
in
493 let f = bigf
.kdecl
in
496 | DeclList
(xs
,ii
) ->
498 xs
+> List.iter
(fun (x
,ii
) ->
502 | MacroDecl
((s
, args
, ptvg
),ii
) ->
504 vk_argument_list bigf args
505 | MacroDeclInit
((s
, args
, ini
),ii
) ->
507 vk_argument_list bigf args
;
511 and vk_decl_list
= fun bigf ts
->
512 ts
+> List.iter
(vk_decl bigf
)
514 and vk_onedecl
= fun bigf onedecl
->
515 let iif ii
= vk_ii bigf ii
in
516 let f = bigf
.konedecl
in
526 (* dont go in tbis *)
527 attrs
+> List.iter
(vk_attribute bigf
);
528 var
+> Common.do_option
(fun (name
, iniopt
) ->
532 | Ast_c.ValInit
(iini
,init
) -> iif [iini
]; vk_ini bigf init
533 | Ast_c.ConstrInit
((init
,ii
)) -> iif ii
; vk_argument_list bigf init
)
535 in f (k, bigf
) onedecl
537 and vk_ini
= fun bigf ini
->
538 let iif ii
= vk_ii bigf ii
in
540 let rec inif x
= bigf
.kini
(k, bigf
) x
544 | InitExpr e
-> vk_expr bigf e
546 initxs
+> List.iter
(fun (ini
, ii
) ->
550 | InitDesignators
(xs
, e
) ->
551 xs
+> List.iter
(vk_designator bigf
);
554 | InitFieldOld
(s
, e
) -> inif e
555 | InitIndexOld
(e1
, e
) ->
556 vk_expr bigf e1
; inif e
561 and vk_ini_list
= fun bigf ts
->
562 let iif ii
= vk_ii bigf ii
in
563 ts
+> List.iter
(fun (ini
,iicomma
) ->
568 and vk_designator
= fun bigf design
->
569 let iif ii
= vk_ii bigf ii
in
570 let (designator
, ii
) = design
in
572 match designator
with
573 | DesignatorField s
-> ()
574 | DesignatorIndex e
-> vk_expr bigf e
575 | DesignatorRange
(e1
, e2
) -> vk_expr bigf e1
; vk_expr bigf e2
578 (* ------------------------------------------------------------------------ *)
580 and vk_struct_fields
= fun bigf fields
->
581 fields
+> List.iter
(vk_struct_field bigf
);
583 and vk_struct_field
= fun bigf field
->
584 let iif ii
= vk_ii bigf ii
in
586 let f = bigf
.kfield
in
591 (FieldDeclList
(onefield_multivars
, iiptvirg
)) ->
592 vk_struct_fieldkinds bigf onefield_multivars
;
594 | EmptyField info
-> iif [info
]
595 | MacroDeclField
((s
, args
),ii
) ->
597 vk_argument_list bigf args
;
599 | CppDirectiveStruct directive
->
600 vk_cpp_directive bigf directive
601 | IfdefStruct ifdef
->
602 vk_ifdef_directive bigf ifdef
609 and vk_struct_fieldkinds
= fun bigf onefield_multivars
->
610 let iif ii
= vk_ii bigf ii
in
611 onefield_multivars
+> List.iter
(fun (field
, iicomma
) ->
614 | Simple
(nameopt
, t
) ->
615 Common.do_option
(vk_name bigf
) nameopt
;
617 | BitField
(nameopt
, t
, info
, expr
) ->
618 Common.do_option
(vk_name bigf
) nameopt
;
625 and vk_enum_fields
= fun bigf enumt
->
626 let iif ii
= vk_ii bigf ii
in
627 enumt
+> List.iter
(fun ((name
, eopt
), iicomma
) ->
628 vk_oneEnum bigf
(name
, eopt
);
631 and vk_oneEnum
= fun bigf
(name
, eopt
) ->
632 let iif ii
= vk_ii bigf ii
in
634 eopt
+> Common.do_option
(fun (info
, e
) ->
639 (* ------------------------------------------------------------------------ *)
642 and vk_def
= fun bigf d
->
643 let iif ii
= vk_ii bigf ii
in
649 f_type
= (returnt
, (paramst
, (b
, iib
)));
653 f_old_c_style
= oldstyle
;
658 attrs
+> List.iter
(vk_attribute bigf
);
659 vk_type bigf returnt
;
661 paramst
+> List.iter
(fun (param
,iicomma
) ->
665 oldstyle
+> Common.do_option
(fun decls
->
666 decls
+> List.iter
(vk_decl bigf
);
669 statxs
+> List.iter
(vk_statement_sequencable bigf
)
675 and vk_toplevel
= fun bigf p
->
676 let f = bigf
.ktoplevel
in
677 let iif ii
= vk_ii bigf ii
in
680 | Declaration decl
-> (vk_decl bigf decl
)
681 | Definition def
-> (vk_def bigf def
)
682 | EmptyDef ii
-> iif ii
683 | MacroTop
(s
, xs
, ii
) ->
684 vk_argument_list bigf xs
;
687 | CppTop top
-> vk_cpp_directive bigf top
688 | IfdefTop ifdefdir
-> vk_ifdef_directive bigf ifdefdir
690 | NotParsedCorrectly ii
-> iif ii
691 | FinalDef info
-> vk_info bigf info
693 | Namespace
(tls
, ii
) -> List.iter
(vk_toplevel bigf
) tls
696 and vk_program
= fun bigf xs
->
697 xs
+> List.iter
(vk_toplevel bigf
)
699 and vk_ifdef_directive bigf directive
=
700 let iif ii
= vk_ii bigf ii
in
702 | IfdefDirective
(ifkind
, ii
) -> iif ii
705 and vk_cpp_directive bigf directive
=
706 let iif ii
= vk_ii bigf ii
in
707 let f = bigf
.kcppdirective
in
708 let rec k directive
=
710 | Include
{i_include
= (s
, ii
);
714 (* go inside ? yes, can be useful, for instance for type_annotater.
715 * The only pb may be that when we want to unparse the code we
716 * don't want to unparse the included file but the unparser
717 * and pretty_print do not use visitor_c so no problem.
720 copt
+> Common.do_option
(fun (file
, asts
) ->
723 | Define
((s
,ii
), (defkind
, defval
)) ->
725 vk_define_kind bigf defkind
;
726 vk_define_val bigf defval
727 | PragmaAndCo
(ii
) ->
729 in f (k, bigf
) directive
732 and vk_define_kind bigf defkind
=
735 | DefineFunc
(params
, ii
) ->
737 params
+> List.iter
(fun ((s
,iis
), iicomma
) ->
743 and vk_define_val bigf defval
=
744 let f = bigf
.kdefineval
in
750 | DefineStmt stmt
-> vk_statement bigf stmt
751 | DefineDoWhileZero
((stmt
, e
), ii
) ->
752 vk_statement bigf stmt
;
755 | DefineFunction def
-> vk_def bigf def
756 | DefineType ty
-> vk_type bigf ty
757 | DefineText
(s
, ii
) -> vk_ii bigf ii
759 | DefineInit ini
-> vk_ini bigf ini
760 (* christia: added multi *)
761 | DefineMulti stmts
->
762 List.fold_left
(fun () d
-> vk_statement bigf d
) () stmts
764 pr2_once
"DefineTodo";
766 in f (k, bigf
) defval
771 (* ------------------------------------------------------------------------ *)
772 (* Now keep fullstatement inside the control flow node,
773 * so that can then get in a MetaStmtVar the fullstatement to later
774 * pp back when the S is in a +. But that means that
775 * Exp will match an Ifnode even if there is no such exp
776 * inside the condition of the Ifnode (because the exp may
777 * be deeper, in the then branch). So have to not visit
778 * all inside a node anymore.
780 * update: j'ai choisi d'accrocher au noeud du CFG a la
781 * fois le fullstatement et le partialstatement et appeler le
782 * visiteur que sur le partialstatement.
785 and vk_node
= fun bigf node
->
786 let iif ii
= vk_ii bigf ii
in
787 let infof info
= vk_info bigf info
in
789 let f = bigf
.knode
in
791 match F.unwrap n
with
793 | F.FunHeader
(def
) ->
794 assert(null
(fst def
).f_body
);
797 | F.Decl decl
-> vk_decl bigf decl
798 | F.ExprStatement
(st
, (eopt
, ii
)) ->
800 eopt
+> do_option
(vk_expr bigf
)
802 | F.IfHeader
(_
, (e
,ii
))
803 | F.SwitchHeader
(_
, (e
,ii
))
804 | F.WhileHeader
(_
, (e
,ii
))
805 | F.DoWhileTail
(e
,ii
) ->
809 | F.ForHeader
(_st
, ((ForExp
(e1opt
,i1
), (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
810 iif i1
; iif i2
; iif i3
;
812 e1opt
+> do_option
(vk_expr bigf
);
813 e2opt
+> do_option
(vk_expr bigf
);
814 e3opt
+> do_option
(vk_expr bigf
);
815 | F.ForHeader
(_st
, ((ForDecl decl
, (e2opt
,i2
), (e3opt
,i3
)), ii
)) ->
818 decl
+> (vk_decl bigf
);
819 e2opt
+> do_option
(vk_expr bigf
);
820 e3opt
+> do_option
(vk_expr bigf
);
821 | F.MacroIterHeader
(_s
, ((s
,es
), ii
)) ->
823 vk_argument_list bigf es
;
825 | F.ReturnExpr
(_st
, (e
,ii
)) -> iif ii
; vk_expr bigf e
827 | F.Case
(_st
, (e
,ii
)) -> iif ii
; vk_expr bigf e
828 | F.CaseRange
(_st
, ((e1
, e2
),ii
)) ->
829 iif ii
; vk_expr bigf e1
; vk_expr bigf e2
834 | F.DefineExpr e
-> vk_expr bigf e
835 | F.DefineType ft
-> vk_type bigf ft
836 | F.DefineHeader
((s
,ii
), (defkind
)) ->
838 vk_define_kind bigf defkind
;
840 | F.DefineDoWhileZeroHeader
(((),ii
)) -> iif ii
842 pr2_once
"DefineTodo";
845 | F.Include
{i_include
= (s
, ii
);} -> iif ii
;
847 | F.MacroTop
(s
, args
, ii
) ->
849 vk_argument_list bigf args
851 | F.IfdefHeader
(info
) -> vk_ifdef_directive bigf info
852 | F.IfdefElse
(info
) -> vk_ifdef_directive bigf info
853 | F.IfdefEndif
(info
) -> vk_ifdef_directive bigf info
855 | F.Break
(st
,((),ii
)) -> iif ii
856 | F.Continue
(st
,((),ii
)) -> iif ii
857 | F.Default
(st
,((),ii
)) -> iif ii
858 | F.Return
(st
,((),ii
)) -> iif ii
859 | F.Goto
(st
, name
, ((),ii
)) -> vk_name bigf name
; iif ii
860 | F.Label
(st
, name
, ((),ii
)) -> vk_name bigf name
; iif ii
862 | F.DoHeader
(st
, info
) -> infof info
864 | F.Else info
-> infof info
865 | F.EndStatement iopt
-> do_option
infof iopt
867 | F.SeqEnd
(i
, info
) -> infof info
868 | F.SeqStart
(st
, i
, info
) -> infof info
870 | F.MacroStmt
(st
, ((),ii
)) -> iif ii
871 | F.Asm
(st
, (asmbody
,ii
)) ->
873 vk_asmbody bigf asmbody
877 F.ErrorExit
|F.Exit
|F.Enter
|F.LoopFallThroughNode
|F.FallThroughNode
|
878 F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
887 (* ------------------------------------------------------------------------ *)
888 and vk_info
= fun bigf info
->
889 let rec infof ii
= bigf
.kinfo
(k, bigf
) ii
894 and vk_ii
= fun bigf ii
->
895 List.iter
(vk_info bigf
) ii
898 (* ------------------------------------------------------------------------ *)
899 and vk_argument
= fun bigf arg
->
900 let rec do_action = function
901 | (ActMisc ii
) -> vk_ii bigf ii
904 | Left e
-> (vk_expr bigf
) e
905 | Right
(ArgType param
) -> vk_param bigf param
906 | Right
(ArgAction action
) -> do_action action
908 and vk_argument_list
= fun bigf es
->
909 let iif ii
= vk_ii bigf ii
in
910 es
+> List.iter
(fun (e
, ii
) ->
917 and vk_param
= fun bigf param
->
918 let iif ii
= vk_ii bigf ii
in
919 let f = bigf
.kparam
in
921 let {p_namei
= swrapopt
; p_register
= (b
, iib
); p_type
=ft
} = param
in
922 swrapopt
+> Common.do_option
(vk_name bigf
);
927 and vk_param_list
= fun bigf ts
->
928 let iif ii
= vk_ii bigf ii
in
929 ts
+> List.iter
(fun (param
,iicomma
) ->
936 (* ------------------------------------------------------------------------ *)
937 and vk_asmbody
= fun bigf
(string_list
, colon_list
) ->
938 let iif ii
= vk_ii bigf ii
in
941 colon_list
+> List.iter
(fun (Colon xs
, ii
) ->
943 xs
+> List.iter
(fun (x
,iicomma
) ->
946 | ColonMisc
, ii
-> iif ii
954 (* ------------------------------------------------------------------------ *)
955 let vk_splitted element
= fun bigf args_splitted
->
956 let iif ii
= vk_ii bigf ii
in
957 args_splitted
+> List.iter
(function
958 | Left arg
-> element bigf arg
962 let vk_args_splitted = vk_splitted vk_argument
963 let vk_define_params_splitted = vk_splitted (fun bigf
(_
,ii
) -> vk_ii bigf ii
)
964 let vk_params_splitted = vk_splitted vk_param
965 let vk_enum_fields_splitted = vk_splitted vk_oneEnum
966 let vk_inis_splitted = vk_splitted vk_ini
968 (* ------------------------------------------------------------------------ *)
969 let vk_cst = fun bigf
(cst
, ii
) ->
970 let iif ii
= vk_ii bigf ii
in
980 (*****************************************************************************)
981 (* "syntetisized attributes" style *)
982 (*****************************************************************************)
984 (* TODO port the xxs_s to new cpp construct too *)
986 type 'a inout
= 'a
-> 'a
988 (* _s for synthetizized attributes
990 * Note that I don't visit necesserally in the order of the token
991 * found in the original file. So don't assume such hypothesis!
994 kexpr_s
: (expression inout
* visitor_c_s
) -> expression inout
;
995 kstatement_s
: (statement inout
* visitor_c_s
) -> statement inout
;
996 ktype_s
: (fullType inout
* visitor_c_s
) -> fullType inout
;
998 kdecl_s
: (declaration inout
* visitor_c_s
) -> declaration inout
;
999 kdef_s
: (definition inout
* visitor_c_s
) -> definition inout
;
1000 kname_s
: (name inout
* visitor_c_s
) -> name inout
;
1002 kini_s
: (initialiser inout
* visitor_c_s
) -> initialiser inout
;
1004 kcppdirective_s
: (cpp_directive inout
* visitor_c_s
) -> cpp_directive inout
;
1005 kdefineval_s
: (define_val inout
* visitor_c_s
) -> define_val inout
;
1006 kstatementseq_s
: (statement_sequencable inout
* visitor_c_s
) -> statement_sequencable inout
;
1007 kstatementseq_list_s
: (statement_sequencable list inout
* visitor_c_s
) -> statement_sequencable list inout
;
1009 knode_s
: (F.node inout
* visitor_c_s
) -> F.node inout
;
1012 ktoplevel_s
: (toplevel inout
* visitor_c_s
) -> toplevel inout
;
1013 kinfo_s
: (info inout
* visitor_c_s
) -> info inout
;
1016 let default_visitor_c_s =
1017 { kexpr_s
= (fun (k,_
) e
-> k e
);
1018 kstatement_s
= (fun (k,_
) st
-> k st
);
1019 ktype_s
= (fun (k,_
) t
-> k t
);
1020 kdecl_s
= (fun (k,_
) d
-> k d
);
1021 kdef_s
= (fun (k,_
) d
-> k d
);
1022 kname_s
= (fun (k,_
) x
-> k x
);
1023 kini_s
= (fun (k,_
) d
-> k d
);
1024 ktoplevel_s
= (fun (k,_
) p
-> k p
);
1025 knode_s
= (fun (k,_
) n
-> k n
);
1026 kinfo_s
= (fun (k,_
) i
-> k i
);
1027 kdefineval_s
= (fun (k,_
) x
-> k x
);
1028 kstatementseq_s
= (fun (k,_
) x
-> k x
);
1029 kstatementseq_list_s
= (fun (k,_
) x
-> k x
);
1030 kcppdirective_s
= (fun (k,_
) x
-> k x
);
1033 let rec vk_expr_s = fun bigf expr
->
1034 let iif ii
= vk_ii_s bigf ii
in
1035 let rec exprf e
= bigf
.kexpr_s
(k, bigf
) e
1037 let ((unwrap_e
, typ
), ii
) = e
in
1038 (* !!! don't analyse optional type !!!
1039 * old: typ +> map_option (vk_type_s bigf) in
1044 | Ident
(name
) -> Ident
(vk_name_s bigf name
)
1045 | Constant
(c
) -> Constant
(c
)
1046 | FunCall
(e, es
) ->
1048 es
+> List.map
(fun (e,ii
) ->
1049 vk_argument_s bigf
e, iif ii
1052 | CondExpr
(e1
, e2
, e3
) -> CondExpr
(exprf e1
, fmap
exprf e2
, exprf e3
)
1053 | Sequence
(e1
, e2
) -> Sequence
(exprf e1
, exprf e2
)
1054 | Assignment
(e1
, op
, e2
) -> Assignment
(exprf e1
, op
, exprf e2
)
1056 | Postfix
(e, op
) -> Postfix
(exprf e, op
)
1057 | Infix
(e, op
) -> Infix
(exprf e, op
)
1058 | Unary
(e, op
) -> Unary
(exprf e, op
)
1059 | Binary
(e1
, op
, e2
) -> Binary
(exprf e1
, op
, exprf e2
)
1061 | ArrayAccess
(e1
, e2
) -> ArrayAccess
(exprf e1
, exprf e2
)
1062 | RecordAccess
(e, name
) -> RecordAccess
(exprf e, vk_name_s bigf name
)
1063 | RecordPtAccess
(e, name
) -> RecordPtAccess
(exprf e, vk_name_s bigf name
)
1065 | SizeOfExpr
(e) -> SizeOfExpr
(exprf e)
1066 | SizeOfType
(t
) -> SizeOfType
(vk_type_s bigf t
)
1067 | Cast
(t
, e) -> Cast
(vk_type_s bigf t
, exprf e)
1069 | StatementExpr
(statxs
, is
) ->
1071 vk_statement_sequencable_list_s bigf statxs
,
1073 | Constructor
(t
, init
) -> Constructor
(vk_type_s bigf t
, vk_ini_s bigf init
)
1075 | ParenExpr
(e) -> ParenExpr
(exprf e)
1077 | New
(None
, t
) -> New
(None
, vk_argument_s bigf t
)
1078 | New
(Some ts
, t
) ->
1079 New
(Some
(ts
+> List.map
(fun (e,ii
) ->
1080 vk_argument_s bigf
e, iif ii
)), vk_argument_s bigf t
)
1081 | Delete
e -> Delete
(vk_expr_s bigf
e)
1084 (e'
, typ'
), (iif ii
)
1088 and vk_argument_s bigf argument
=
1089 let iif ii
= vk_ii_s bigf ii
in
1090 let rec do_action = function
1091 | (ActMisc ii
) -> ActMisc
(iif ii
)
1093 (match argument
with
1094 | Left
e -> Left
(vk_expr_s bigf
e)
1095 | Right
(ArgType param
) -> Right
(ArgType
(vk_param_s bigf param
))
1096 | Right
(ArgAction action
) -> Right
(ArgAction
(do_action action
))
1099 (* ------------------------------------------------------------------------ *)
1102 and vk_name_s
= fun bigf
ident ->
1103 let iif ii
= vk_ii_s bigf ii
in
1104 let rec namef x
= bigf
.kname_s
(k,bigf
) x
1107 | RegularName
(s
,ii
) -> RegularName
(s
, iif ii
)
1108 | CppConcatenatedName xs
->
1109 CppConcatenatedName
(xs
+> List.map
(fun ((x
,ii1
), ii2
) ->
1110 (x
, iif ii1
), iif ii2
1112 | CppVariadicName
(s
, ii
) -> CppVariadicName
(s
, iif ii
)
1113 | CppIdentBuilder
((s
,iis
), xs
) ->
1114 CppIdentBuilder
((s
, iif iis
),
1115 xs
+> List.map
(fun ((x
,iix
), iicomma
) ->
1116 ((x
, iif iix
), iif iicomma
)))
1121 (* ------------------------------------------------------------------------ *)
1125 and vk_statement_s
= fun bigf st
->
1126 let rec statf st
= bigf
.kstatement_s
(k, bigf
) st
1128 let (unwrap_st
, ii
) = st
in
1130 match unwrap_st
with
1131 | Labeled
(Label
(name
, st)) ->
1132 Labeled
(Label
(vk_name_s bigf name
, statf st))
1133 | Labeled
(Case
(e, st)) ->
1134 Labeled
(Case
((vk_expr_s bigf
) e , statf st))
1135 | Labeled
(CaseRange
(e, e2
, st)) ->
1136 Labeled
(CaseRange
((vk_expr_s bigf
) e,
1137 (vk_expr_s bigf
) e2
,
1139 | Labeled
(Default
st) -> Labeled
(Default
(statf st))
1140 | Compound statxs
->
1141 Compound
(vk_statement_sequencable_list_s bigf statxs
)
1142 | ExprStatement
(None
) -> ExprStatement
(None
)
1143 | ExprStatement
(Some
e) -> ExprStatement
(Some
((vk_expr_s bigf
) e))
1144 | Selection
(If
(e, st1
, st2
)) ->
1145 Selection
(If
((vk_expr_s bigf
) e, statf st1
, statf st2
))
1146 | Selection
(Switch
(e, st)) ->
1147 Selection
(Switch
((vk_expr_s bigf
) e, statf st))
1148 | Iteration
(While
(e, st)) ->
1149 Iteration
(While
((vk_expr_s bigf
) e, statf st))
1150 | Iteration
(DoWhile
(st, e)) ->
1151 Iteration
(DoWhile
(statf st, (vk_expr_s bigf
) e))
1152 | Iteration
(For
(first
, (e2opt
,i2
), (e3opt
,i3
), st)) ->
1155 ForExp
(e1opt
,i1
) ->
1156 let e1opt'
= statf (mk_st
(ExprStatement
(e1opt)) i1
) in
1157 let e1'
= Ast_c.unwrap_st
e1opt'
in
1158 let i1'
= Ast_c.get_ii_st_take_care
e1opt'
in
1160 ExprStatement x1
-> ForExp
(x1
,i1'
)
1163 "cant be here if iterator keep ExprStatement as is")
1164 | ForDecl decl
-> ForDecl
(vk_decl_s bigf decl
) in
1165 let e2opt'
= statf (mk_st
(ExprStatement
(e2opt)) i2
) in
1166 let e3opt'
= statf (mk_st
(ExprStatement
(e3opt)) i3
) in
1168 let e2'
= Ast_c.unwrap_st
e2opt'
in
1169 let e3'
= Ast_c.unwrap_st
e3opt'
in
1170 let i2'
= Ast_c.get_ii_st_take_care
e2opt'
in
1171 let i3'
= Ast_c.get_ii_st_take_care
e3opt'
in
1173 (match (e2'
, e3'
) with
1174 | ((ExprStatement x2
), ((ExprStatement x3
))) ->
1175 Iteration
(For
(first, (x2
,i2'
), (x3
,i3'
), statf st))
1177 | x
-> failwith
"cant be here if iterator keep ExprStatement as is"
1180 | Iteration
(MacroIteration
(s
, es
, st)) ->
1184 es
+> List.map
(fun (e, ii
) ->
1185 vk_argument_s bigf
e, vk_ii_s bigf ii
1191 | Jump
(Goto name
) -> Jump
(Goto
(vk_name_s bigf name
))
1192 | Jump
(((Continue
|Break
|Return
) as x
)) -> Jump
(x
)
1193 | Jump
(ReturnExpr
e) -> Jump
(ReturnExpr
((vk_expr_s bigf
) e))
1194 | Jump
(GotoComputed
e) -> Jump
(GotoComputed
(vk_expr_s bigf
e));
1196 | Decl decl
-> Decl
(vk_decl_s bigf decl
)
1197 | Asm asmbody
-> Asm
(vk_asmbody_s bigf asmbody
)
1198 | NestedFunc def
-> NestedFunc
(vk_def_s bigf def
)
1199 | MacroStmt
-> MacroStmt
1201 st'
, vk_ii_s bigf ii
1205 and vk_statement_sequencable_s
= fun bigf stseq
->
1206 let f = bigf
.kstatementseq_s
in
1211 StmtElem
(vk_statement_s bigf
st)
1212 | CppDirectiveStmt directive
->
1213 CppDirectiveStmt
(vk_cpp_directive_s bigf directive
)
1214 | IfdefStmt ifdef
->
1215 IfdefStmt
(vk_ifdef_directive_s bigf ifdef
)
1216 | IfdefStmt2
(ifdef
, xxs
) ->
1217 let ifdef'
= List.map
(vk_ifdef_directive_s bigf
) ifdef in
1218 let xxs'
= xxs +> List.map
(fun xs
->
1219 xs
+> vk_statement_sequencable_list_s bigf
1222 IfdefStmt2
(ifdef'
, xxs'
)
1223 in f (k, bigf
) stseq
1225 and vk_statement_sequencable_list_s
= fun bigf statxs
->
1226 let f = bigf
.kstatementseq_list_s
in
1228 xs
+> List.map
(vk_statement_sequencable_s bigf
)
1234 and vk_asmbody_s
= fun bigf
(string_list
, colon_list
) ->
1235 let iif ii
= vk_ii_s bigf ii
in
1238 colon_list
+> List.map
(fun (Colon xs
, ii
) ->
1240 (xs
+> List.map
(fun (x
, iicomma
) ->
1242 | ColonMisc
, ii
-> ColonMisc
, iif ii
1243 | ColonExpr
e, ii
-> ColonExpr
(vk_expr_s bigf
e), iif ii
1252 (* todo? a visitor for qualifier *)
1253 and vk_type_s
= fun bigf t
->
1254 let rec typef t
= bigf
.ktype_s
(k,bigf
) t
1255 and iif ii
= vk_ii_s bigf ii
1258 let (unwrap_q
, iiq
) = q
in
1259 (* strip_info_visitor needs iiq to be processed before iit *)
1260 let iif_iiq = iif iiq
in
1261 let q'
= unwrap_q
in
1262 let (unwrap_t
, iit
) = t
in
1266 | BaseType x
-> BaseType x
1267 | Pointer
t -> Pointer
(typef t)
1268 | Array
(eopt
, t) -> Array
(fmap
(vk_expr_s bigf
) eopt
, typef t)
1269 | FunctionType
(returnt
, paramst
) ->
1273 | (ts
, (b
, iihas3dots
)) ->
1274 (ts
+> List.map
(fun (param
,iicomma
) ->
1275 (vk_param_s bigf param
, iif iicomma
)),
1276 (b
, iif iihas3dots
))
1279 | Enum
(sopt
, enumt
) ->
1280 Enum
(sopt
, vk_enum_fields_s bigf enumt
)
1281 | StructUnion
(sopt
, su
, fields
) ->
1282 StructUnion
(sopt
, su
, vk_struct_fields_s bigf fields
)
1285 | StructUnionName
(s
, structunion
) -> StructUnionName
(s
, structunion
)
1286 | EnumName s
-> EnumName s
1287 | TypeName
(name
, typ) -> TypeName
(vk_name_s bigf name
, typ)
1289 | ParenType
t -> ParenType
(typef t)
1290 | TypeOfExpr
e -> TypeOfExpr
(vk_expr_s bigf
e)
1291 | TypeOfType
t -> TypeOfType
(typef t)
1299 and vk_attribute_s
= fun bigf attr
->
1300 let iif ii
= vk_ii_s bigf ii
in
1302 | Attribute s
, ii
->
1307 and vk_decl_s
= fun bigf d
->
1308 let f = bigf
.kdecl_s
in
1309 let iif ii
= vk_ii_s bigf ii
in
1312 | DeclList
(xs
, ii
) ->
1313 DeclList
(List.map aux xs
, iif ii
)
1314 | MacroDecl
((s
, args
, ptvg
),ii
) ->
1317 args
+> List.map
(fun (e,ii
) -> vk_argument_s bigf
e, iif ii
),
1320 | MacroDeclInit
((s
, args
, ini
),ii
) ->
1323 args
+> List.map
(fun (e,ii
) -> vk_argument_s bigf
e, iif ii
),
1328 and aux
({v_namei
= var
;
1333 v_attr
= attrs
}, iicomma
) =
1335 (var
+> map_option
(fun (name
, iniopt
) ->
1336 vk_name_s bigf name
,
1338 Ast_c.NoInit
-> iniopt
1339 | Ast_c.ValInit
(iini
,init
) ->
1340 Ast_c.ValInit
(vk_info_s bigf iini
,vk_ini_s bigf init
)
1341 | Ast_c.ConstrInit
((init
,ii
)) ->
1343 init +> List.map
(fun (e,ii
) -> vk_argument_s bigf
e, iif ii
) in
1344 Ast_c.ConstrInit
((init, List.map
(vk_info_s bigf
) ii
)))
1346 v_type
= vk_type_s bigf
t;
1347 (* !!! dont go in semantic related stuff !!! *)
1351 v_attr
= attrs
+> List.map
(vk_attribute_s bigf
);
1357 and vk_decl_list_s
= fun bigf decls
->
1358 decls
+> List.map
(vk_decl_s bigf
)
1360 and vk_ini_s
= fun bigf ini
->
1361 let rec inif ini
= bigf
.kini_s
(k,bigf
) ini
1363 let (unwrap_ini
, ii
) = ini
in
1365 match unwrap_ini
with
1366 | InitExpr
e -> InitExpr
(vk_expr_s bigf
e)
1367 | InitList initxs
->
1368 InitList
(initxs
+> List.map
(fun (ini, ii
) ->
1369 inif ini, vk_ii_s bigf ii
)
1373 | InitDesignators
(xs
, e) ->
1375 (xs
+> List.map
(vk_designator_s bigf
),
1379 | InitFieldOld
(s
, e) -> InitFieldOld
(s
, inif e)
1380 | InitIndexOld
(e1, e) -> InitIndexOld
(vk_expr_s bigf
e1, inif e)
1383 in ini'
, vk_ii_s bigf ii
1387 and vk_designator_s
= fun bigf design
->
1388 let iif ii
= vk_ii_s bigf ii
in
1389 let (designator
, ii
) = design
in
1390 (match designator
with
1391 | DesignatorField s
-> DesignatorField s
1392 | DesignatorIndex
e -> DesignatorIndex
(vk_expr_s bigf
e)
1393 | DesignatorRange
(e1, e2) ->
1394 DesignatorRange
(vk_expr_s bigf
e1, vk_expr_s bigf
e2)
1400 and vk_struct_fieldkinds_s
= fun bigf onefield_multivars
->
1401 let iif ii
= vk_ii_s bigf ii
in
1403 onefield_multivars
+> List.map
(fun (field
, iicomma
) ->
1405 | Simple
(nameopt
, t) ->
1406 Simple
(Common.map_option
(vk_name_s bigf
) nameopt
,
1408 | BitField
(nameopt
, t, info
, expr
) ->
1409 BitField
(Common.map_option
(vk_name_s bigf
) nameopt
,
1411 vk_info_s bigf info
,
1412 vk_expr_s bigf expr
)
1416 and vk_struct_field_s
= fun bigf field
->
1417 let iif ii
= vk_ii_s bigf ii
in
1420 (DeclarationField
(FieldDeclList
(onefield_multivars
, iiptvirg
))) ->
1423 (vk_struct_fieldkinds_s bigf onefield_multivars
, iif iiptvirg
))
1424 | EmptyField info
-> EmptyField
(vk_info_s bigf info
)
1425 | MacroDeclField
((s
, args
),ii
) ->
1428 args
+> List.map
(fun (e,ii
) -> vk_argument_s bigf
e, iif ii
)
1432 | CppDirectiveStruct directive
->
1433 CppDirectiveStruct
(vk_cpp_directive_s bigf directive
)
1434 | IfdefStruct
ifdef ->
1435 IfdefStruct
(vk_ifdef_directive_s bigf
ifdef)
1437 and vk_struct_fields_s
= fun bigf fields
->
1438 fields
+> List.map
(vk_struct_field_s bigf
)
1440 and vk_enum_fields_s
= fun bigf enumt
->
1441 let iif ii
= vk_ii_s bigf ii
in
1442 enumt
+> List.map
(fun ((name
, eopt
), iicomma
) ->
1443 vk_oneEnum_s bigf
(name
, eopt
), iif iicomma
)
1445 and vk_oneEnum_s
= fun bigf oneEnum
->
1446 let (name
,eopt
) = oneEnum
in
1447 (vk_name_s bigf name
,
1448 eopt
+> Common.fmap
(fun (info
, e) ->
1449 vk_info_s bigf info
,
1453 and vk_def_s
= fun bigf d
->
1454 let f = bigf
.kdef_s
in
1455 let iif ii
= vk_ii_s bigf ii
in
1459 f_type
= (returnt
, (paramst
, (b
, iib
)));
1463 f_old_c_style
= oldstyle
;
1466 {f_name
= vk_name_s bigf name
;
1468 (vk_type_s bigf returnt
,
1469 (paramst
+> List.map
(fun (param
, iicomma
) ->
1470 (vk_param_s bigf param
, iif iicomma
)
1474 vk_statement_sequencable_list_s bigf statxs
;
1476 attrs
+> List.map
(vk_attribute_s bigf
);
1478 oldstyle
+> Common.map_option
(fun decls
->
1479 decls
+> List.map
(vk_decl_s bigf
)
1486 and vk_toplevel_s
= fun bigf p
->
1487 let f = bigf
.ktoplevel_s
in
1488 let iif ii
= vk_ii_s bigf ii
in
1491 | Declaration decl
-> Declaration
(vk_decl_s bigf decl
)
1492 | Definition def
-> Definition
(vk_def_s bigf def
)
1493 | EmptyDef ii
-> EmptyDef
(iif ii
)
1494 | MacroTop
(s
, xs
, ii
) ->
1497 xs
+> List.map
(fun (elem
, iicomma
) ->
1498 vk_argument_s bigf elem
, iif iicomma
1502 | CppTop top
-> CppTop
(vk_cpp_directive_s bigf top
)
1503 | IfdefTop ifdefdir
-> IfdefTop
(vk_ifdef_directive_s bigf ifdefdir
)
1505 | NotParsedCorrectly ii
-> NotParsedCorrectly
(iif ii
)
1506 | FinalDef info
-> FinalDef
(vk_info_s bigf info
)
1507 | Namespace
(tls
, ii
) -> Namespace
(List.map
(vk_toplevel_s bigf
) tls
, ii
)
1510 and vk_program_s
= fun bigf xs
->
1511 xs
+> List.map
(vk_toplevel_s bigf
)
1514 and vk_cpp_directive_s
= fun bigf top
->
1515 let iif ii
= vk_ii_s bigf ii
in
1516 let f = bigf
.kcppdirective_s
in
1520 | Include
{i_include
= (s
, ii
);
1521 i_rel_pos
= h_rel_pos
;
1525 -> Include
{i_include
= (s
, iif ii
);
1526 i_rel_pos
= h_rel_pos
;
1528 i_content
= copt
+> Common.map_option
(fun (file
, asts
) ->
1529 file
, vk_program_s bigf asts
1532 | Define
((s
,ii
), (defkind
, defval
)) ->
1533 Define
((s
, iif ii
),
1534 (vk_define_kind_s bigf defkind
, vk_define_val_s bigf defval
))
1535 | PragmaAndCo
(ii
) -> PragmaAndCo
(iif ii
)
1539 and vk_ifdef_directive_s
= fun bigf
ifdef ->
1540 let iif ii
= vk_ii_s bigf ii
in
1542 | IfdefDirective
(ifkind
, ii
) -> IfdefDirective
(ifkind
, iif ii
)
1546 and vk_define_kind_s
= fun bigf defkind
->
1548 | DefineVar
-> DefineVar
1549 | DefineFunc
(params
, ii
) ->
1551 (params
+> List.map
(fun ((s
,iis
),iicomma
) ->
1552 ((s
, vk_ii_s bigf iis
), vk_ii_s bigf iicomma
)
1559 and vk_define_val_s
= fun bigf x
->
1560 let f = bigf
.kdefineval_s
in
1561 let iif ii
= vk_ii_s bigf ii
in
1564 | DefineExpr
e -> DefineExpr
(vk_expr_s bigf
e)
1565 | DefineStmt
st -> DefineStmt
(vk_statement_s bigf
st)
1566 | DefineDoWhileZero
((st,e),ii
) ->
1567 let st'
= vk_statement_s bigf
st in
1568 let e'
= vk_expr_s bigf
e in
1569 DefineDoWhileZero
((st'
,e'
), iif ii
)
1570 | DefineFunction def
-> DefineFunction
(vk_def_s bigf def
)
1571 | DefineType ty
-> DefineType
(vk_type_s bigf ty
)
1572 | DefineText
(s
, ii
) -> DefineText
(s
, iif ii
)
1573 | DefineEmpty
-> DefineEmpty
1574 | DefineInit
ini -> DefineInit
(vk_ini_s bigf
ini)
1575 (* christia: added multi *)
1577 DefineMulti
(List.map
(vk_statement_s bigf
) ds
)
1580 pr2_once
"DefineTodo";
1586 and vk_info_s
= fun bigf info
->
1587 let rec infof ii
= bigf
.kinfo_s
(k, bigf
) ii
1592 and vk_ii_s
= fun bigf ii
->
1593 List.map
(vk_info_s bigf
) ii
1595 (* ------------------------------------------------------------------------ *)
1596 and vk_node_s
= fun bigf node
->
1597 let iif ii
= vk_ii_s bigf ii
in
1598 let infof info
= vk_info_s bigf info
in
1600 let rec nodef n
= bigf
.knode_s
(k, bigf
) n
1603 match F.unwrap node
with
1604 | F.FunHeader
(def
) ->
1605 assert (null
(fst def
).f_body
);
1606 F.FunHeader
(vk_def_s bigf def
)
1608 | F.Decl declb
-> F.Decl
(vk_decl_s bigf declb
)
1609 | F.ExprStatement
(st, (eopt
, ii
)) ->
1610 F.ExprStatement
(st, (eopt
+> map_option
(vk_expr_s bigf
), iif ii
))
1612 | F.IfHeader
(st, (e,ii
)) ->
1613 F.IfHeader
(st, (vk_expr_s bigf
e, iif ii
))
1614 | F.SwitchHeader
(st, (e,ii
)) ->
1615 F.SwitchHeader
(st, (vk_expr_s bigf
e, iif ii
))
1616 | F.WhileHeader
(st, (e,ii
)) ->
1617 F.WhileHeader
(st, (vk_expr_s bigf
e, iif ii
))
1618 | F.DoWhileTail
(e,ii
) ->
1619 F.DoWhileTail
(vk_expr_s bigf
e, iif ii
)
1621 | F.ForHeader
(st, ((first, (e2opt,i2), (e3opt,i3)), ii
)) ->
1624 ForExp
(e1opt,i1) ->
1625 ForExp
(e1opt +> Common.map_option
(vk_expr_s bigf
), iif i1)
1626 | ForDecl decl
-> ForDecl
(vk_decl_s bigf decl
) in
1630 (e2opt +> Common.map_option
(vk_expr_s bigf
), iif i2),
1631 (e3opt +> Common.map_option
(vk_expr_s bigf
), iif i3)),
1634 | F.MacroIterHeader
(st, ((s
,es
), ii
)) ->
1637 ((s
, es
+> List.map
(fun (e, ii
) -> vk_argument_s bigf
e, iif ii
)),
1641 | F.ReturnExpr
(st, (e,ii
)) ->
1642 F.ReturnExpr
(st, (vk_expr_s bigf
e, iif ii
))
1644 | F.Case
(st, (e,ii
)) -> F.Case
(st, (vk_expr_s bigf
e, iif ii
))
1645 | F.CaseRange
(st, ((e1, e2),ii
)) ->
1646 F.CaseRange
(st, ((vk_expr_s bigf
e1, vk_expr_s bigf
e2), iif ii
))
1648 | F.CaseNode i
-> F.CaseNode i
1650 | F.DefineHeader
((s
,ii
), (defkind
)) ->
1651 F.DefineHeader
((s
, iif ii
), (vk_define_kind_s bigf defkind
))
1653 | F.DefineExpr
e -> F.DefineExpr
(vk_expr_s bigf
e)
1654 | F.DefineType ft
-> F.DefineType
(vk_type_s bigf ft
)
1655 | F.DefineDoWhileZeroHeader
((),ii
) ->
1656 F.DefineDoWhileZeroHeader
((),iif ii
)
1657 | F.DefineTodo
-> F.DefineTodo
1659 | F.Include
{i_include
= (s
, ii
);
1660 i_rel_pos
= h_rel_pos
;
1665 assert (copt
=*= None
);
1666 F.Include
{i_include
= (s
, iif ii
);
1667 i_rel_pos
= h_rel_pos
;
1672 | F.MacroTop
(s
, args
, ii
) ->
1675 args
+> List.map
(fun (e, ii
) -> vk_argument_s bigf
e, iif ii
),
1679 | F.MacroStmt
(st, ((),ii
)) -> F.MacroStmt
(st, ((),iif ii
))
1680 | F.Asm
(st, (body
,ii
)) -> F.Asm
(st, (vk_asmbody_s bigf body
,iif ii
))
1682 | F.Break
(st,((),ii
)) -> F.Break
(st,((),iif ii
))
1683 | F.Continue
(st,((),ii
)) -> F.Continue
(st,((),iif ii
))
1684 | F.Default
(st,((),ii
)) -> F.Default
(st,((),iif ii
))
1685 | F.Return
(st,((),ii
)) -> F.Return
(st,((),iif ii
))
1686 | F.Goto
(st, name
, ((),ii
)) ->
1687 F.Goto
(st, vk_name_s bigf name
, ((),iif ii
))
1688 | F.Label
(st, name
, ((),ii
)) ->
1689 F.Label
(st, vk_name_s bigf name
, ((),iif ii
))
1690 | F.EndStatement iopt
-> F.EndStatement
(map_option
infof iopt
)
1691 | F.DoHeader
(st, info
) -> F.DoHeader
(st, infof info
)
1692 | F.Else info
-> F.Else
(infof info
)
1693 | F.SeqEnd
(i
, info
) -> F.SeqEnd
(i
, infof info
)
1694 | F.SeqStart
(st, i
, info
) -> F.SeqStart
(st, i
, infof info
)
1696 | F.IfdefHeader
(info
) -> F.IfdefHeader
(vk_ifdef_directive_s bigf info
)
1697 | F.IfdefElse
(info
) -> F.IfdefElse
(vk_ifdef_directive_s bigf info
)
1698 | F.IfdefEndif
(info
) -> F.IfdefEndif
(vk_ifdef_directive_s bigf info
)
1702 F.TopNode
|F.EndNode
|
1703 F.ErrorExit
|F.Exit
|F.Enter
|F.LoopFallThroughNode
|F.FallThroughNode
|
1704 F.AfterNode
|F.FalseNode
|F.TrueNode
|F.InLoopNode
|
1713 (* ------------------------------------------------------------------------ *)
1714 and vk_param_s
= fun bigf param
->
1715 let iif ii
= vk_ii_s bigf ii
in
1716 let {p_namei
= swrapopt
; p_register
= (b
, iib
); p_type
=ft
} = param
in
1717 { p_namei
= swrapopt
+> Common.map_option
(vk_name_s bigf
);
1718 p_register
= (b
, iif iib
);
1719 p_type
= vk_type_s bigf ft
;
1722 let vk_arguments_s = fun bigf args
->
1723 let iif ii
= vk_ii_s bigf ii
in
1724 args
+> List.map
(fun (e, ii
) -> vk_argument_s bigf
e, iif ii
)
1726 let vk_inis_s = fun bigf inis
->
1727 let iif ii
= vk_ii_s bigf ii
in
1728 inis
+> List.map
(fun (e, ii
) -> vk_ini_s bigf
e, iif ii
)
1730 let vk_params_s = fun bigf args
->
1731 let iif ii
= vk_ii_s bigf ii
in
1732 args
+> List.map
(fun (p
,ii
) -> vk_param_s bigf p
, iif ii
)
1734 let vk_cst_s = fun bigf
(cst
, ii
) ->
1735 let iif ii
= vk_ii_s bigf ii
in
1737 | Left cst
-> Left cst
1738 | Right s
-> Right s
1741 (* ------------------------------------------------------------------------ *)
1743 let vk_splitted_s element
= fun bigf args_splitted
->
1744 let iif ii
= vk_ii_s bigf ii
in
1745 args_splitted
+> List.map
(function
1746 | Left arg
-> Left
(element bigf arg
)
1747 | Right ii
-> Right
(iif ii
)
1750 let vk_args_splitted_s = vk_splitted_s vk_argument_s
1751 let vk_params_splitted_s = vk_splitted_s vk_param_s
1752 let vk_define_params_splitted_s =
1753 vk_splitted_s (fun bigf
(s
,ii
) -> (s
,vk_ii_s bigf ii
))
1754 let vk_enum_fields_splitted_s = vk_splitted_s vk_oneEnum_s
1755 let vk_inis_splitted_s = vk_splitted_s vk_ini_s