parsing_c/type_c.ml

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