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