parsing_c/type_c.ml

   1 (* Yoann Padioleau, Julia Lawall
   2  *
   3  * Copyright (C) 2007, 2008, 2009 University of Urbana Champaign and DIKU
   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
  19 (*****************************************************************************)
  20 (* Wrappers *)
  21 (*****************************************************************************)
  22 let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_type
  23
  24 (*****************************************************************************)
  25 (* Types *)
  26 (*****************************************************************************)
  27
  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
  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
  66 type completed_and_simplified = Ast_c.fullType
  67
  68 type completed_typedef = Ast_c.fullType
  69 type removed_typedef = Ast_c.fullType
  70
  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
  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 *)
 121   | TypeName (_name, typ) ->
 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
 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
 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 =
 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
 196       (* todo? but what if correspond to a nested struct def ? *)
 197       | Some s , [i1;i2;i3;i4] ->
 198           qu, Ast_c.mk_tybis (StructUnionName (su, s)) [i1;i2]
 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
 221   Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen]
 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 =
 289                 { Ast_c.p_namei = None;
 290                   p_register = false, Ast_c.noii;
 291                   p_type = ft;
 292                 }
 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) =
 306         Ast_c.mk_ty (FunctionType ftyp) [fake_oparen;fake_cparen]
 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 *)
 330 let lub op t1 t2 =
 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
 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
 397         (* todo, Pointer, Typedef, etc *)
 398         | _, _, _ -> Some t1
 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 ->
 424       match x with
 425       | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) ->
 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
 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
 455       | EmptyField info -> ()
 456       | MacroDeclField _ -> pr2_once "DeclTodo"; ()
 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
 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 *)
 496       | TypeName (_name, Some ft2) ->
 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    *)
 507   | TypeName (_name, Some ft) ->
 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