Commit | Line | Data |
---|---|---|
708f4980 | 1 | (* Yoann Padioleau, Julia Lawall |
0708f913 | 2 | * |
ae4735db | 3 | * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. |
708f4980 | 4 | * Copyright (C) 2007, 2008, 2009 University of Urbana Champaign and DIKU |
91eba41f C |
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. | |
ae4735db | 9 | * |
91eba41f C |
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 | ||
16 | open Common | |
17 | ||
18 | open Ast_c | |
19 | ||
708f4980 C |
20 | (*****************************************************************************) |
21 | (* Wrappers *) | |
22 | (*****************************************************************************) | |
23 | let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_type | |
24 | ||
91eba41f C |
25 | (*****************************************************************************) |
26 | (* Types *) | |
27 | (*****************************************************************************) | |
28 | ||
0708f913 C |
29 | (* What info do we want in a clean C type ? Normally it would help |
30 | * if we remove some of the complexity of C with for instance typedefs | |
31 | * by expanding those typedefs or structname and enumname to their | |
32 | * final value. Then, when we do pattern matching we can conveniently forget | |
33 | * to handle the typedef, enumname and similar cases. But sometimes, | |
34 | * in coccinelle for instance, we want to keep some of those original | |
35 | * info. So right now we have a in-the-middle solution by keeping | |
36 | * the original typename in the ast and expanding some of them | |
37 | * in the type_annotation phase. We don't do this expansion for | |
38 | * structname because usually when we have a struct we actually | |
39 | * prefer to just have the structname. It's only when we access | |
40 | * field that we need that information, but the type_annotater has | |
41 | * already done this job so no need in the parent expression to know | |
42 | * the full definition of the structure. But for typedef, this is different. | |
ae4735db | 43 | * |
0708f913 C |
44 | * So really the finalType we want, the completed_type notion below, |
45 | * corresponds to a type we think is useful enough to work on, to do | |
46 | * pattern matching on, and one where we have all the needed information | |
47 | * and we don't need to look again somewhere else to get the information. | |
48 | * | |
ae4735db C |
49 | * |
50 | * | |
51 | * | |
0708f913 | 52 | * todo? define a new clean fulltype ? as julia did with type_cocci.ml |
91eba41f C |
53 | * without the parsing info, with some normalization (for instance have |
54 | * only structUnionName and enumName, and remove the ParenType), some | |
55 | * abstractions (don't care for instance about name in parameters of | |
56 | * functionType, or size of array), and with new types such as Unknown | |
57 | * or PartialFunctionType (when don't have type of return when infer | |
58 | * the type of function call not based on type of function but on the | |
59 | * type of its arguments). | |
ae4735db C |
60 | * |
61 | * | |
62 | * | |
91eba41f C |
63 | *) |
64 | ||
65 | type finalType = Ast_c.fullType | |
66 | ||
0708f913 C |
67 | type completed_and_simplified = Ast_c.fullType |
68 | ||
69 | type completed_typedef = Ast_c.fullType | |
70 | type removed_typedef = Ast_c.fullType | |
71 | ||
ae4735db C |
72 | (* move in ast_c ? |
73 | * use Ast_c.nQ, Ast_c.defaultInt, Ast_c.emptyAnnotCocci, | |
708f4980 C |
74 | * Ast_c.emptyMetavarsBinding, Ast_c.emptyComments |
75 | *) | |
1eddfd50 | 76 | let mk_fulltype bt str = |
708f4980 | 77 | Ast_c.mk_ty |
1eddfd50 | 78 | (Ast_c.BaseType bt) |
708f4980 C |
79 | [Ast_c.al_info 0 (* al *) |
80 | {Ast_c.pinfo = | |
81 | Ast_c.OriginTok | |
1eddfd50 | 82 | {Common.str = str; Common.charpos = 0; Common.line = -1; |
708f4980 | 83 | Common.column = -1; Common.file = ""}; |
ae4735db | 84 | Ast_c.cocci_tag = |
1eddfd50 C |
85 | {contents = |
86 | Some (Ast_cocci.CONTEXT (Ast_cocci.NoPos, Ast_cocci.NOTHING), [])}; | |
ae4735db | 87 | Ast_c.comments_tag = {contents = |
708f4980 C |
88 | {Ast_c.mbefore = []; Ast_c.mafter = []; |
89 | Ast_c.mbefore2 = []; Ast_c.mafter2 = [] | |
90 | }}}] | |
91 | ||
1eddfd50 C |
92 | let (int_type: Ast_c.fullType) = |
93 | (* Lib_parsing_c.al_type (Parse_c.type_of_string "int")*) | |
94 | mk_fulltype (Ast_c.IntType (Ast_c.Si (Ast_c.Signed, Ast_c.CInt))) "int" | |
708f4980 | 95 | |
1eddfd50 C |
96 | let (ptr_diff_type: Ast_c.fullType) = |
97 | (* Lib_parsing_c.al_type (Parse_c.type_of_string "int")*) | |
98 | mk_fulltype Ast_c.PtrDiffType "ptrdiff_t" | |
0708f913 C |
99 | |
100 | (* normally if the type annotated has done a good job, this should always | |
101 | * return true. Cf type_annotater_c.typedef_fix. | |
102 | *) | |
ae4735db C |
103 | let rec is_completed_and_simplified ty = |
104 | match Ast_c.unwrap_typeC ty with | |
f59c9fb7 | 105 | | NoType -> true |
0708f913 C |
106 | | BaseType x -> true |
107 | | Pointer t -> is_completed_and_simplified t | |
108 | | Array (e, t) -> is_completed_and_simplified t | |
ae4735db C |
109 | | StructUnion (su, sopt, fields) -> |
110 | (* recurse fields ? Normally actually don't want, | |
0708f913 C |
111 | * prefer to have a StructUnionName when it's possible *) |
112 | (match sopt with | |
113 | | None -> true | |
114 | | Some _ -> false (* should have transformed it in a StructUnionName *) | |
115 | ) | |
ae4735db | 116 | | FunctionType ft -> |
0708f913 C |
117 | (* todo? return type is completed ? params completed ? *) |
118 | true | |
ae4735db | 119 | | Enum (s, enumt) -> |
0708f913 | 120 | true |
ae4735db | 121 | | EnumName s -> |
0708f913 C |
122 | true |
123 | ||
124 | (* we prefer StructUnionName to StructUnion when it comes to typed metavar *) | |
125 | | StructUnionName (su, s) -> true | |
126 | ||
127 | (* should have completed with more information *) | |
ae4735db | 128 | | TypeName (_name, typ) -> |
0708f913 C |
129 | (match typ with |
130 | | None -> false | |
ae4735db | 131 | | Some t -> |
0708f913 C |
132 | (* recurse cos what if it's an alias of an alias ? *) |
133 | is_completed_and_simplified t | |
134 | ) | |
135 | ||
136 | (* should have removed paren, for better matching with typed metavar. | |
137 | * kind of iso again *) | |
ae4735db | 138 | | ParenType t -> |
0708f913 C |
139 | false |
140 | (* same *) | |
ae4735db | 141 | | TypeOfType t -> |
0708f913 C |
142 | false |
143 | ||
ae4735db | 144 | | TypeOfExpr e -> |
0708f913 C |
145 | true (* well we don't handle it, so can't really say it's completed *) |
146 | ||
147 | ||
ae4735db | 148 | let is_completed_typedef_fullType x = raise Todo |
0708f913 C |
149 | |
150 | let is_removed_typedef_fullType x = raise Todo | |
ae4735db | 151 | |
0708f913 C |
152 | (*****************************************************************************) |
153 | (* more "virtual" fulltype, the fullType_with_no_typename *) | |
154 | (*****************************************************************************) | |
155 | let remove_typedef x = raise Todo | |
156 | ||
91eba41f C |
157 | (*****************************************************************************) |
158 | (* expression exp_info annotation vs finalType *) | |
159 | (*****************************************************************************) | |
160 | ||
ae4735db | 161 | (* builders, needed because julia added gradually more information in |
91eba41f C |
162 | * the expression reference annotation in ast_c. |
163 | *) | |
164 | ||
ae4735db | 165 | let make_info x = |
91eba41f C |
166 | (Some x, Ast_c.NotTest) |
167 | ||
ae4735db | 168 | let make_exp_type t = |
91eba41f C |
169 | (t, Ast_c.NotLocalVar) |
170 | ||
ae4735db | 171 | let make_info_def t = |
91eba41f C |
172 | make_info (make_exp_type t) |
173 | ||
174 | ||
175 | ||
ae4735db | 176 | let noTypeHere = |
91eba41f C |
177 | (None, Ast_c.NotTest) |
178 | ||
179 | ||
ae4735db | 180 | let do_with_type f (t,_test) = |
91eba41f C |
181 | match t with |
182 | | None -> noTypeHere | |
183 | | Some (t,_local) -> f t | |
184 | ||
ae4735db | 185 | let get_opt_type e = |
91eba41f C |
186 | match Ast_c.get_type_expr e with |
187 | | Some (t,_), _test -> Some t | |
188 | | None, _test -> None | |
189 | ||
190 | ||
191 | ||
192 | (*****************************************************************************) | |
193 | (* Normalizers *) | |
194 | (*****************************************************************************) | |
195 | ||
196 | ||
ae4735db | 197 | let structdef_to_struct_name ty = |
708f4980 | 198 | let (qu, tybis) = ty in |
ae4735db C |
199 | match Ast_c.unwrap_typeC ty with |
200 | | (StructUnion (su, sopt, fields)) -> | |
708f4980 C |
201 | let iis = Ast_c.get_ii_typeC_take_care tybis in |
202 | (match sopt, iis with | |
91eba41f | 203 | (* todo? but what if correspond to a nested struct def ? *) |
ae4735db | 204 | | Some s , [i1;i2;i3;i4] -> |
708f4980 | 205 | qu, Ast_c.mk_tybis (StructUnionName (su, s)) [i1;i2] |
ae4735db | 206 | | None, _ -> |
91eba41f C |
207 | ty |
208 | | x -> raise Impossible | |
209 | ) | |
210 | | _ -> raise Impossible | |
211 | ||
212 | ||
213 | (*****************************************************************************) | |
214 | (* Helpers *) | |
215 | (*****************************************************************************) | |
216 | ||
217 | ||
ae4735db C |
218 | let type_of_function (def,ii) = |
219 | let ftyp = def.f_type in | |
91eba41f C |
220 | |
221 | (* could use the info in the 'ii' ? *) | |
222 | ||
223 | let fake = Ast_c.fakeInfo (Common.fake_parse_info) in | |
224 | let fake_oparen = Ast_c.rewrap_str "(" fake in | |
225 | let fake = Ast_c.fakeInfo (Common.fake_parse_info) in | |
226 | let fake_cparen = Ast_c.rewrap_str ")" fake in | |
227 | ||
708f4980 | 228 | Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen] |
91eba41f C |
229 | |
230 | ||
231 | (* pre: only a single variable *) | |
ae4735db | 232 | let type_of_decl decl = |
91eba41f | 233 | match decl with |
ae4735db | 234 | | Ast_c.DeclList (xs,ii1) -> |
91eba41f C |
235 | (match xs with |
236 | | [] -> raise Impossible | |
ae4735db | 237 | |
91eba41f | 238 | (* todo? for other xs ? *) |
ae4735db | 239 | | (x,ii2)::xs -> |
91eba41f C |
240 | let {v_namei = _var; v_type = v_type; |
241 | v_storage = (_storage,_inline)} = x in | |
242 | ||
243 | (* TODO normalize ? what if nested structure definition ? *) | |
244 | v_type | |
245 | ) | |
17ba0788 | 246 | | Ast_c.MacroDecl _ | Ast_c.MacroDeclInit _ -> |
91eba41f C |
247 | pr2_once "not handling MacroDecl type yet"; |
248 | raise Todo | |
249 | ||
250 | ||
251 | ||
252 | (* pre: it is indeed a struct def decl, and only a single variable *) | |
ae4735db | 253 | let structdef_of_decl decl = |
91eba41f C |
254 | |
255 | match decl with | |
ae4735db | 256 | | Ast_c.DeclList (xs,ii1) -> |
91eba41f C |
257 | (match xs with |
258 | | [] -> raise Impossible | |
ae4735db | 259 | |
91eba41f | 260 | (* todo? for other xs ? *) |
ae4735db | 261 | | (x,ii2)::xs -> |
91eba41f C |
262 | let {v_namei = var; v_type = v_type; |
263 | v_storage = (storage,inline)} = x in | |
ae4735db | 264 | |
91eba41f | 265 | (match Ast_c.unwrap_typeC v_type with |
ae4735db | 266 | | Ast_c.StructUnion (su, _must_be_some, fields) -> |
91eba41f C |
267 | (su, fields) |
268 | | _ -> raise Impossible | |
269 | ) | |
270 | ) | |
17ba0788 | 271 | | Ast_c.MacroDecl _ | Ast_c.MacroDeclInit _ -> raise Impossible |
91eba41f C |
272 | |
273 | ||
274 | ||
275 | ||
276 | (*****************************************************************************) | |
277 | (* Type builder *) | |
278 | (*****************************************************************************) | |
279 | ||
ae4735db C |
280 | let (fake_function_type: |
281 | fullType option -> argument wrap2 list -> fullType option) = | |
91eba41f C |
282 | fun rettype args -> |
283 | ||
284 | let fake = Ast_c.fakeInfo (Common.fake_parse_info) in | |
285 | let fake_oparen = Ast_c.rewrap_str "(" fake in | |
286 | let fake = Ast_c.fakeInfo (Common.fake_parse_info) in | |
287 | let fake_cparen = Ast_c.rewrap_str ")" fake in | |
288 | ||
ae4735db C |
289 | let (tyargs: parameterType wrap2 list) = |
290 | args +> Common.map_filter (fun (arg,ii) -> | |
91eba41f | 291 | match arg with |
ae4735db | 292 | | Left e -> |
91eba41f | 293 | (match Ast_c.get_onlytype_expr e with |
ae4735db C |
294 | | Some ft -> |
295 | let paramtype = | |
b1b2de81 C |
296 | { Ast_c.p_namei = None; |
297 | p_register = false, Ast_c.noii; | |
298 | p_type = ft; | |
299 | } | |
91eba41f C |
300 | in |
301 | Some (paramtype, ii) | |
302 | | None -> None | |
303 | ) | |
304 | | Right _ -> None | |
305 | ) | |
306 | in | |
307 | if List.length args <> List.length tyargs | |
308 | then None | |
309 | else | |
ae4735db | 310 | rettype +> Common.map_option (fun rettype -> |
91eba41f | 311 | let (ftyp: functionType) = (rettype, (tyargs, (false,[]))) in |
ae4735db | 312 | let (t: fullType) = |
708f4980 | 313 | Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen] |
91eba41f C |
314 | in |
315 | t | |
316 | ) | |
317 | ||
318 | ||
319 | (*****************************************************************************) | |
320 | (* Typing rules *) | |
321 | (*****************************************************************************) | |
322 | ||
323 | ||
324 | (* todo: the rules are far more complex, but I prefer to simplify for now. | |
325 | * todo: should take operator as a parameter. | |
ae4735db | 326 | * |
91eba41f C |
327 | * todo: Also need handle pointer arithmetic! the type of 'pt + 2' |
328 | * is still the type of pt. cf parsing_cocci/type_infer.ml | |
ae4735db | 329 | * |
91eba41f C |
330 | * (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *) |
331 | * | (T.Pointer(ty1),T.Pointer(ty2)) -> | |
332 | * T.Pointer(loop(ty1,ty2)) | |
333 | * | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2) | |
334 | * | (T.Pointer(ty1),ty2) -> T.Pointer(ty1) | |
ae4735db | 335 | * |
91eba41f | 336 | *) |
708f4980 | 337 | let lub op t1 t2 = |
ae4735db | 338 | let ftopt = |
91eba41f C |
339 | match t1, t2 with |
340 | | None, None -> None | |
341 | | Some t, None -> Some t | |
342 | | None, Some t -> Some t | |
ae4735db C |
343 | (* check equal ? no cos can have pointer arithmetic so t2 can be <> t1 |
344 | * | |
345 | * todo: right now I favor the first term because usually pointer | |
91eba41f | 346 | * arithmetic are written with the pointer in the first position. |
ae4735db C |
347 | * |
348 | * Also when an expression contain a typedef, as in | |
91eba41f C |
349 | * 'dma_addr + 1' where dma_addr was declared as a varialbe |
350 | * of type dma_addr_t, then again I want to have in the lub | |
351 | * the typedef and it is often again in the first position. | |
ae4735db | 352 | * |
91eba41f | 353 | *) |
ae4735db | 354 | | Some t1, Some t2 -> |
91eba41f C |
355 | let t1bis = Ast_c.unwrap_typeC t1 in |
356 | let t2bis = Ast_c.unwrap_typeC t2 in | |
708f4980 C |
357 | (* a small attempt to do better, no consideration of typedefs *) |
358 | (match op, t1bis, t2bis with | |
359 | (* these rules follow ANSI C. See eg: | |
360 | http://flexor.uwaterloo.ca/library/SGI_bookshelves/SGI_Developer/books/CLanguageRef/sgi_html/ch05.html *) | |
361 | _,Ast_c.BaseType(bt1),Ast_c.BaseType(bt2) -> | |
362 | (match bt1,bt2 with | |
363 | Ast_c.Void,_ -> Some t2 (* something has gone wrong *) | |
364 | | _,Ast_c.Void -> Some t1 (* something has gone wrong *) | |
365 | | Ast_c.FloatType(Ast_c.CLongDouble),_ -> Some t1 | |
366 | | _,Ast_c.FloatType(Ast_c.CLongDouble) -> Some t2 | |
367 | | Ast_c.FloatType(Ast_c.CDouble),_ -> Some t1 | |
368 | | _,Ast_c.FloatType(Ast_c.CDouble) -> Some t2 | |
369 | | Ast_c.FloatType(Ast_c.CFloat),_ -> Some t1 | |
370 | | _,Ast_c.FloatType(Ast_c.CFloat) -> Some t2 | |
371 | ||
1eddfd50 C |
372 | | Ast_c.PtrDiffType,_ -> Some t1 |
373 | | _,Ast_c.PtrDiffType -> Some t2 | |
374 | | Ast_c.SSizeType,_ -> Some t1 | |
375 | | _,Ast_c.SSizeType -> Some t2 | |
376 | | Ast_c.SizeType,_ -> Some t1 | |
377 | | _,Ast_c.SizeType -> Some t2 | |
378 | ||
708f4980 C |
379 | | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLongLong)),_ -> |
380 | Some t1 | |
381 | | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLongLong)) -> | |
382 | Some t2 | |
383 | | Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLongLong)),_ -> | |
384 | Some t1 | |
385 | | _,Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLongLong)) -> | |
386 | Some t2 | |
387 | | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLong)),_ -> | |
388 | Some t1 | |
389 | | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CLong)) -> | |
390 | Some t2 | |
391 | | Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLong)),_ -> | |
392 | Some t1 | |
393 | | _,Ast_c.IntType(Ast_c.Si(Ast_c.Signed,Ast_c.CLong)) -> | |
394 | Some t2 | |
395 | | Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CInt)),_ -> | |
396 | Some t1 | |
397 | | _,Ast_c.IntType(Ast_c.Si(Ast_c.UnSigned,Ast_c.CInt)) -> | |
398 | Some t2 | |
399 | | _ -> Some int_type) | |
400 | ||
401 | | Ast_c.Plus,Ast_c.Pointer _,Ast_c.BaseType(Ast_c.IntType _) -> | |
402 | Some t1 | |
403 | | Ast_c.Plus,Ast_c.BaseType(Ast_c.IntType _),Ast_c.Pointer _ -> | |
404 | Some t2 | |
405 | | Ast_c.Minus,Ast_c.Pointer _,Ast_c.BaseType(Ast_c.IntType _) -> | |
406 | Some t1 | |
407 | | Ast_c.Minus,Ast_c.BaseType(Ast_c.IntType _),Ast_c.Pointer _ -> | |
408 | Some t2 | |
97111a47 C |
409 | | Ast_c.Minus,(Ast_c.Pointer _ | Ast_c.Array _), |
410 | (Ast_c.Pointer _ | Ast_c.Array _) -> | |
1eddfd50 | 411 | Some ptr_diff_type |
91eba41f | 412 | (* todo, Pointer, Typedef, etc *) |
708f4980 | 413 | | _, _, _ -> Some t1 |
91eba41f C |
414 | ) |
415 | ||
416 | in | |
417 | match ftopt with | |
418 | | None -> None, Ast_c.NotTest | |
419 | | Some ft -> Some (ft, Ast_c.NotLocalVar), Ast_c.NotTest | |
420 | ||
91eba41f C |
421 | (*****************************************************************************) |
422 | (* type lookup *) | |
423 | (*****************************************************************************) | |
424 | ||
ae4735db | 425 | (* old: was using some nested find_some, but easier use ref |
91eba41f | 426 | * update: handling union (used a lot in sparse) |
ae4735db | 427 | * note: it is independent of the environment. |
91eba41f | 428 | *) |
ae4735db C |
429 | let (type_field: |
430 | string -> (Ast_c.structUnion * Ast_c.structType) -> Ast_c.fullType) = | |
431 | fun fld (su, fields) -> | |
91eba41f C |
432 | |
433 | let res = ref [] in | |
ae4735db C |
434 | |
435 | let rec aux_fields fields = | |
436 | fields +> List.iter (fun x -> | |
708f4980 | 437 | match x with |
ae4735db C |
438 | | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) -> |
439 | onefield_multivars +> List.iter (fun (fieldkind, iicomma) -> | |
b1b2de81 | 440 | match fieldkind with |
ae4735db | 441 | | Simple (Some name, t) | BitField (Some name, t, _, _) -> |
b1b2de81 | 442 | let s = Ast_c.str_of_name name in |
ae4735db | 443 | if s =$= fld |
91eba41f C |
444 | then Common.push2 t res |
445 | else () | |
ae4735db C |
446 | |
447 | | Simple (None, t) -> | |
91eba41f C |
448 | (match Ast_c.unwrap_typeC t with |
449 | ||
450 | (* union *) | |
ae4735db | 451 | | StructUnion (Union, _, fields) -> |
91eba41f | 452 | aux_fields fields |
ae4735db C |
453 | |
454 | (* Special case of nested structure definition inside | |
455 | * structure without associated field variable as in | |
91eba41f C |
456 | * struct top = { ... struct xx { int subfield1; ... }; ... } |
457 | * cf sparse source, where can access subfields directly. | |
458 | * It can also be used in conjunction with union. | |
459 | *) | |
ae4735db | 460 | | StructUnion (Struct, _, fields) -> |
91eba41f | 461 | aux_fields fields |
ae4735db | 462 | |
91eba41f C |
463 | | _ -> () |
464 | ) | |
465 | | _ -> () | |
466 | ) | |
ae4735db | 467 | |
708f4980 C |
468 | | EmptyField info -> () |
469 | | MacroDeclField _ -> pr2_once "DeclTodo"; () | |
ae4735db | 470 | |
91eba41f | 471 | | CppDirectiveStruct _ |
ae4735db | 472 | | IfdefStruct _ -> pr2_once "StructCpp"; |
91eba41f C |
473 | ) |
474 | in | |
475 | aux_fields fields; | |
476 | match !res with | |
477 | | [t] -> t | |
ae4735db | 478 | | [] -> |
91eba41f | 479 | raise Not_found |
ae4735db | 480 | | x::y::xs -> |
91eba41f C |
481 | pr2 ("MultiFound field: " ^ fld) ; |
482 | x | |
ae4735db | 483 | |
91eba41f C |
484 | |
485 | ||
0708f913 C |
486 | (*****************************************************************************) |
487 | (* helpers *) | |
488 | (*****************************************************************************) | |
489 | ||
490 | ||
491 | (* was in aliasing_function_c.ml before*) | |
492 | ||
ae4735db | 493 | (* assume normalized/completed ? so no ParenType handling to do ? |
0708f913 | 494 | *) |
ae4735db | 495 | let rec is_function_type x = |
0708f913 C |
496 | match Ast_c.unwrap_typeC x with |
497 | | FunctionType _ -> true | |
498 | | _ -> false | |
499 | ||
500 | ||
501 | (* assume normalized/completed ? so no ParenType handling to do ? *) | |
ae4735db | 502 | let rec function_pointer_type_opt x = |
0708f913 | 503 | match Ast_c.unwrap_typeC x with |
ae4735db | 504 | | Pointer y -> |
0708f913 C |
505 | (match Ast_c.unwrap_typeC y with |
506 | | FunctionType ft -> Some ft | |
507 | ||
508 | (* fix *) | |
ae4735db | 509 | | TypeName (_name, Some ft2) -> |
0708f913 C |
510 | (match Ast_c.unwrap_typeC ft2 with |
511 | | FunctionType ft -> Some ft | |
512 | | _ -> None | |
513 | ) | |
514 | ||
515 | | _ -> None | |
516 | ) | |
ae4735db C |
517 | (* bugfix: for many fields in structure, the field is a typename |
518 | * like irq_handler_t to a function pointer | |
0708f913 | 519 | *) |
ae4735db | 520 | | TypeName (_name, Some ft) -> |
0708f913 C |
521 | function_pointer_type_opt ft |
522 | (* bugfix: in field, usually it has some ParenType *) | |
523 | ||
ae4735db | 524 | | ParenType ft -> |
0708f913 C |
525 | function_pointer_type_opt ft |
526 | ||
527 | | _ -> None | |
528 | ||
529 |