3 * Copyright (C) 2007, 2008, 2009 Ecole des Mines de Nantes
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License (GPL)
7 * version 2 as published by the Free Software Foundation.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * file license.txt for more details.
16 (*****************************************************************************)
18 (*****************************************************************************)
19 let pr2, pr2_once
= Common.mk_pr2_wrappers
Flag_parsing_c.verbose_parsing
21 (*****************************************************************************)
23 (*****************************************************************************)
25 (* todo?: al_expr doit enlever les infos de type ? et doit remettre en
29 (* drop all info information *)
31 let strip_info_visitor _
=
32 { Visitor_c.default_visitor_c_s
with
34 (* traversal should be deterministic... *)
37 function i
-> ctr := !ctr + 1; Ast_c.al_info_cpp
!ctr i
));
39 Visitor_c.kexpr_s
= (fun (k
,_
) e
->
40 let (e'
, ty
), ii'
= k e
in
41 (e'
, Ast_c.noType
()(*ref !ty*)), ii'
(* keep type - jll *)
45 Visitor_c.ktype_s = (fun (k,_) ft ->
47 match Ast_c.unwrap_typeC ft' with
48 | Ast_c.TypeName (s,_typ) ->
49 Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
57 let al_expr x
= Visitor_c.vk_expr_s
(strip_info_visitor()) x
58 let al_statement x
= Visitor_c.vk_statement_s
(strip_info_visitor()) x
59 let al_type x
= Visitor_c.vk_type_s
(strip_info_visitor()) x
60 let al_init x
= Visitor_c.vk_ini_s
(strip_info_visitor()) x
61 let al_param x
= Visitor_c.vk_param_s
(strip_info_visitor()) x
62 let al_params x
= Visitor_c.vk_params_s
(strip_info_visitor()) x
63 let al_arguments x
= Visitor_c.vk_arguments_s
(strip_info_visitor()) x
64 let al_fields x
= Visitor_c.vk_struct_fields_s
(strip_info_visitor()) x
66 let al_node x
= Visitor_c.vk_node_s
(strip_info_visitor()) x
68 let al_program x
= List.map
(Visitor_c.vk_toplevel_s
(strip_info_visitor())) x
69 let al_ii x
= Visitor_c.vk_ii_s
(strip_info_visitor()) x
76 let semi_strip_info_visitor = (* keep position information *)
77 { Visitor_c.default_visitor_c_s
with
78 Visitor_c.kinfo_s
= (fun (k
,_
) i
-> Ast_c.semi_al_info_cpp i
);
80 Visitor_c.kexpr_s
= (fun (k
,_
) e
->
81 let (e'
, ty
),ii'
= k e
in
82 (e'
, Ast_c.noType
()(*ref !ty*)), ii'
(* keep type - jll *)
87 let semi_al_expr = Visitor_c.vk_expr_s
semi_strip_info_visitor
88 let semi_al_statement = Visitor_c.vk_statement_s
semi_strip_info_visitor
89 let semi_al_type = Visitor_c.vk_type_s
semi_strip_info_visitor
90 let semi_al_init = Visitor_c.vk_ini_s
semi_strip_info_visitor
91 let semi_al_param = Visitor_c.vk_param_s
semi_strip_info_visitor
92 let semi_al_params = Visitor_c.vk_params_s
semi_strip_info_visitor
93 let semi_al_arguments = Visitor_c.vk_arguments_s
semi_strip_info_visitor
96 List.map
(Visitor_c.vk_toplevel_s
semi_strip_info_visitor)
101 (* really strip, do not keep position nor anything specificities, true
102 * abstracted form. *)
103 let real_strip_info_visitor _
=
104 { Visitor_c.default_visitor_c_s
with
105 Visitor_c.kinfo_s
= (fun (k
,_
) i
->
106 Ast_c.real_al_info_cpp i
109 Visitor_c.kexpr_s
= (fun (k
,_
) e
->
110 let (e'
, ty
),ii'
= k e
in
111 (e'
, Ast_c.noType
()), ii'
115 Visitor_c.ktype_s = (fun (k,_) ft ->
117 match Ast_c.unwrap_typeC ft' with
118 | Ast_c.TypeName (s,_typ) ->
119 Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
127 let real_al_expr x
= Visitor_c.vk_expr_s
(real_strip_info_visitor()) x
128 let real_al_node x
= Visitor_c.vk_node_s
(real_strip_info_visitor()) x
129 let real_al_type x
= Visitor_c.vk_type_s
(real_strip_info_visitor()) x
132 (*****************************************************************************)
134 (*****************************************************************************)
136 let extract_info_visitor recursor x
=
137 let globals = ref [] in
140 Visitor_c.default_visitor_c
with
141 Visitor_c.kinfo
= (fun (k
, _
) i
-> Common.push2 i
globals)
148 let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
149 let ii_of_node = extract_info_visitor Visitor_c.vk_node
150 let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
151 let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
152 let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
153 let ii_of_type = extract_info_visitor Visitor_c.vk_type
154 let ii_of_ini = extract_info_visitor Visitor_c.vk_ini
155 let ii_of_param = extract_info_visitor Visitor_c.vk_param
156 let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
157 let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
158 (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
159 let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds
160 let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
161 let ii_of_define_params =
162 extract_info_visitor Visitor_c.vk_define_params_splitted
163 let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel
165 (*****************************************************************************)
167 (*****************************************************************************)
168 let max_min_ii_by_pos xs
=
170 | [] -> failwith
"empty list, max_min_ii_by_pos"
173 let pos_leq p1 p2
= (Ast_c.compare_pos p1 p2
) =|= (-1) in
174 xs
+> List.fold_left
(fun (maxii
,minii
) e
->
175 let maxii'
= if pos_leq maxii e
then e
else maxii in
176 let minii'
= if pos_leq e
minii then e
else minii in
180 let info_to_fixpos ii
=
181 match Ast_c.pinfo_of_info ii
with
182 Ast_c.OriginTok pi
-> Ast_cocci.Real pi
.Common.charpos
183 | Ast_c.ExpandedTok
(_
,(pi
,offset
)) ->
184 Ast_cocci.Virt
(pi
.Common.charpos
,offset
)
185 | Ast_c.FakeTok
(_
,(pi
,offset
)) ->
186 Ast_cocci.Virt
(pi
.Common.charpos
,offset
)
187 | Ast_c.AbstractLineTok pi
-> failwith
"unexpected abstract"
189 let max_min_by_pos xs
=
190 let (i1
, i2
) = max_min_ii_by_pos xs
in
191 (info_to_fixpos i1
, info_to_fixpos i2
)
193 let lin_col_by_pos xs
=
194 (* put min before max; no idea why they are backwards above *)
195 let (i2
, i1
) = max_min_ii_by_pos xs
in
196 let posf x
= Ast_c.col_of_info x
in
197 let mposf x
= Ast_c.col_of_info x
+ String.length
(Ast_c.str_of_info x
) in
198 (Ast_c.file_of_info i1
,!Flag.current_element
,
199 (Ast_c.line_of_info i1
, posf i1
), (Ast_c.line_of_info i2
, mposf i2
))
205 let min_pinfo_of_node node
=
206 let ii = ii_of_node node
in
207 let (maxii, minii) = max_min_ii_by_pos ii in
208 Ast_c.parse_info_of_info
minii
211 let (range_of_origin_ii
: Ast_c.info list
-> (int * int) option) =
213 let ii = List.filter
Ast_c.is_origintok
ii in
215 let (max
, min
) = max_min_ii_by_pos ii in
216 assert(Ast_c.is_origintok max
);
217 assert(Ast_c.is_origintok min
);
218 let strmax = Ast_c.str_of_info max
in
220 (Ast_c.pos_of_info min
, Ast_c.pos_of_info max
+ String.length
strmax)
225 (*****************************************************************************)
227 (*****************************************************************************)
229 let names_of_parameters_in_def def
=
230 match def
.Ast_c.f_old_c_style
with
232 pr2_once
"names_of_parameters_in_def: f_old_c_style not handled";
235 let ftyp = def
.Ast_c.f_type
in
236 let (ret
, (params
, bwrap
)) = ftyp in
237 params
+> Common.map_filter
(fun (param
,ii) ->
238 Ast_c.name_of_parameter param
241 let names_of_parameters_in_macro xs
=
242 xs
+> List.map
(fun (xx
, ii) ->
249 (* only used in ast_to_flow, so move it ? *)
250 let rec stmt_elems_of_sequencable xs
=
251 xs
+> Common.map
(fun x
->
253 | Ast_c.StmtElem e
-> [e
]
254 | Ast_c.CppDirectiveStmt _
257 pr2_once
("stmt_elems_of_sequencable: filter a directive");
259 | Ast_c.IfdefStmt2
(_ifdef
, xxs
) ->
260 pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?");
261 xxs
+> List.map
(fun xs
->
262 let xs'
= stmt_elems_of_sequencable xs in