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