parsing_cocci/type_infer.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./type_infer.ml"
  28 module T = Type_cocci
  29 module Ast = Ast_cocci
  30 module Ast0 = Ast0_cocci
  31 module V0 = Visitor_ast0
  32 module VT0 = Visitor_ast0_types
  33
  34 (* Type inference:
  35 Just propagates information based on declarations.  Could try to infer
  36 more precise information about expression metavariables, but not sure it is
  37 worth it.  The most obvious goal is to distinguish between test expressions
  38 that have pointer, integer, and boolean type when matching isomorphisms,
  39 but perhaps other needs will become apparent. *)
  40
  41 (* "functions" that return a boolean value *)
  42 let bool_functions = ["likely";"unlikely"]
  43
  44 let err wrapped ty s =
  45   T.typeC ty; Format.print_newline();
  46   failwith (Printf.sprintf "line %d: %s" (Ast0.get_line wrapped) s)
  47
  48 type id = Id of string | Meta of Ast.meta_name
  49
  50 let int_type = T.BaseType(T.IntType)
  51 let void_type = T.BaseType(T.VoidType)
  52 let bool_type = T.BaseType(T.BoolType)
  53 let char_type = T.BaseType(T.CharType)
  54 let float_type = T.BaseType(T.FloatType)
  55 let size_type = T.BaseType(T.SizeType)
  56 let ssize_type = T.BaseType(T.SSizeType)
  57 let ptrdiff_type = T.BaseType(T.PtrDiffType)
  58
  59 let rec lub_type t1 t2 =
  60   match (t1,t2) with
  61     (None,None) -> None
  62   | (None,Some t) -> t2
  63   | (Some t,None) -> t1
  64   | (Some t1,Some t2) ->
  65       let rec loop = function
  66           (T.Unknown,t2) -> t2
  67         | (t1,T.Unknown) -> t1
  68         | (T.ConstVol(cv1,ty1),T.ConstVol(cv2,ty2)) when cv1 = cv2 ->
  69             T.ConstVol(cv1,loop(ty1,ty2))
  70
  71         (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *)
  72         | (T.Pointer(ty1),T.Pointer(ty2)) ->
  73             T.Pointer(loop(ty1,ty2))
  74         | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2)
  75         | (T.Pointer(ty1),ty2) -> T.Pointer(ty1)
  76
  77         | (T.Array(ty1),T.Array(ty2)) -> T.Array(loop(ty1,ty2))
  78         | (T.TypeName(s1),t2) -> t2
  79         | (t1,T.TypeName(s1)) -> t1
  80         | (t1,_) -> t1 in (* arbitrarily pick the first, assume type correct *)
  81       Some (loop (t1,t2))
  82
  83 let lub_envs envs =
  84   List.fold_left
  85     (function acc ->
  86       function env ->
  87         List.fold_left
  88           (function acc ->
  89             function (var,ty) ->
  90               let (relevant,irrelevant) =
  91                 List.partition (function (x,_) -> x = var) acc in
  92               match relevant with
  93                 [] -> (var,ty)::acc
  94               | [(x,ty1)] ->
  95                   (match lub_type (Some ty) (Some ty1) with
  96                     Some new_ty -> (var,new_ty)::irrelevant
  97                   | None -> irrelevant)
  98               | _ -> failwith "bad type environment")
  99           acc env)
 100     [] envs
 101
 102 let rec propagate_types env =
 103   let option_default = None in
 104   let bind x y = option_default in (* no generic way of combining types *)
 105
 106   let ident r k i =
 107     match Ast0.unwrap i with
 108       Ast0.Id(id) ->
 109         (try Some(List.assoc (Id(Ast0.unwrap_mcode id)) env)
 110         with Not_found -> None)
 111     | Ast0.MetaId(id,_,_,_) ->
 112         (try Some(List.assoc (Meta(Ast0.unwrap_mcode id)) env)
 113         with Not_found -> None)
 114     | Ast0.DisjId(_,id_list,_,_) ->
 115         let types = List.map Ast0.get_type id_list in
 116         let combined = List.fold_left lub_type None types in
 117         (match combined with
 118           None -> None
 119         | Some t ->
 120             List.iter (function i -> Ast0.set_type i (Some t)) id_list;
 121             Some t)
 122     | Ast0.AsIdent _ -> failwith "not possible"
 123     | _ -> k i in
 124
 125   let strip_cv = function
 126       Some (T.ConstVol(_,t)) -> Some t
 127     | t -> t in
 128
 129   (* types that might be integer types.  should char be allowed? *)
 130   let rec is_int_type = function
 131       T.BaseType(T.IntType)
 132     | T.BaseType(T.LongType)
 133     | T.BaseType(T.ShortType)
 134     | T.BaseType(T.SizeType)
 135     | T.MetaType(_,_,_)
 136     | T.TypeName _
 137     | T.EnumName _
 138     | T.SignedT(_,None) -> true
 139     | T.SignedT(_,Some ty) -> is_int_type ty
 140     | _ -> false in
 141
 142   let expression r k e =
 143     let res = k e in
 144     let ty =
 145       match Ast0.unwrap e with
 146           (* pad: the type of id is set in the ident visitor *)
 147           Ast0.Ident(id) -> Ast0.set_type e res; res
 148         | Ast0.Constant(const) ->
 149             (match Ast0.unwrap_mcode const with
 150                  Ast.String(_) -> Some (T.Pointer(char_type))
 151                | Ast.Char(_) -> Some (char_type)
 152                | Ast.Int(_) -> Some (int_type)
 153                | Ast.Float(_) ->  Some (float_type))
 154               (* pad: note that in C can do either ptr(...) or ( *ptr)(...)
 155                * so I am not sure this code is enough.
 156                *)
 157         | Ast0.FunCall(fn,lp,args,rp) ->
 158             (match Ast0.get_type fn with
 159                  Some (T.FunctionPointer(ty)) -> Some ty
 160                |  _ ->
 161                     (match Ast0.unwrap fn with
 162                          Ast0.Ident(id) ->
 163                            (match Ast0.unwrap id with
 164                                 Ast0.Id(id) ->
 165                                   if List.mem (Ast0.unwrap_mcode id) bool_functions
 166                                   then Some(bool_type)
 167                                   else None
 168                               | _ -> None)
 169                        |        _ -> None))
 170         | Ast0.Assignment(exp1,op,exp2,_) ->
 171             let ty = lub_type (Ast0.get_type exp1) (Ast0.get_type exp2) in
 172               Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty
 173         | Ast0.Sequence(exp1,op,exp2) -> Ast0.get_type exp2
 174         | Ast0.CondExpr(exp1,why,Some exp2,colon,exp3) ->
 175             let ty = lub_type (Ast0.get_type exp2) (Ast0.get_type exp3) in
 176               Ast0.set_type exp2 ty; Ast0.set_type exp3 ty; ty
 177         | Ast0.CondExpr(exp1,why,None,colon,exp3) -> Ast0.get_type exp3
 178         | Ast0.Postfix(exp,op) | Ast0.Infix(exp,op) -> (* op is dec or inc *)
 179             Ast0.get_type exp
 180         | Ast0.Unary(exp,op) ->
 181             (match Ast0.unwrap_mcode op with
 182                  Ast.GetRef ->
 183                    (match Ast0.get_type exp with
 184                         None -> Some (T.Pointer(T.Unknown))
 185                       | Some t -> Some (T.Pointer(t)))
 186                | Ast.GetRefLabel -> Some (T.Pointer(void_type))
 187                | Ast.DeRef ->
 188                    (match Ast0.get_type exp with
 189                         Some (T.Pointer(t)) -> Some t
 190                       | _ -> None)
 191                | Ast.UnPlus -> Ast0.get_type exp
 192                | Ast.UnMinus -> Ast0.get_type exp
 193                | Ast.Tilde -> Ast0.get_type exp
 194                | Ast.Not -> Some(bool_type))
 195         | Ast0.Nested(exp1,op,exp2) -> failwith "nested in type inf not possible"
 196         | Ast0.Binary(exp1,op,exp2) ->
 197             let ty1 = Ast0.get_type exp1 in
 198             let ty2 = Ast0.get_type exp2 in
 199             let same_type = function
 200                 (None,None) -> Some (int_type)
 201
 202               (* pad: pointer arithmetic handling as in ptr+1 *)
 203               | (Some (T.Pointer ty1),Some ty2) when is_int_type ty2 ->
 204                   Some (T.Pointer ty1)
 205               | (Some ty1,Some (T.Pointer ty2)) when is_int_type ty1 ->
 206                   Some (T.Pointer ty2)
 207
 208               | (t1,t2) ->
 209                   let ty = lub_type t1 t2 in
 210                     Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty in
 211               (match Ast0.unwrap_mcode op with
 212                    Ast.Arith(op) -> same_type (ty1, ty2)
 213                  | Ast.Logical(Ast.AndLog) | Ast.Logical(Ast.OrLog) ->
 214                      Some(bool_type)
 215                  | Ast.Logical(op) ->
 216                      let ty = lub_type ty1 ty2 in
 217                      Ast0.set_type exp1 ty; Ast0.set_type exp2 ty;
 218                      Some(bool_type))
 219         | Ast0.Paren(lp,exp,rp) -> Ast0.get_type exp
 220         | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 221             (match strip_cv (Ast0.get_type exp2) with
 222                  None -> Ast0.set_type exp2 (Some(int_type))
 223                | Some(ty) when is_int_type ty -> ()
 224                | Some(Type_cocci.Unknown) ->
 225                    (* unknown comes from param types, not sure why this
 226                       is not just None... *)
 227                    Ast0.set_type exp2 (Some(int_type))
 228                | Some ty -> err exp2 ty "bad type for an array index");
 229             (match strip_cv (Ast0.get_type exp1) with
 230                  None -> None
 231                | Some (T.Array(ty)) -> Some ty
 232                | Some (T.Pointer(ty)) -> Some ty
 233                | Some (T.MetaType(_,_,_)) -> None
 234                | Some x -> err exp1 x "ill-typed array reference")
 235               (* pad: should handle structure one day and look 'field' in environment *)
 236         | Ast0.RecordAccess(exp,pt,field) ->
 237             (match strip_cv (Ast0.get_type exp) with
 238                  None -> None
 239                | Some (T.StructUnionName(_,_)) -> None
 240                | Some (T.TypeName(_)) -> None
 241                | Some (T.MetaType(_,_,_)) -> None
 242                | Some x -> err exp x "non-structure type in field ref")
 243         | Ast0.RecordPtAccess(exp,ar,field) ->
 244             (match strip_cv (Ast0.get_type exp) with
 245                  None -> None
 246                | Some (T.Pointer(t)) ->
 247                    (match strip_cv (Some t) with
 248                       | Some (T.Unknown) -> None
 249                       | Some (T.MetaType(_,_,_)) -> None
 250                       | Some (T.TypeName(_)) -> None
 251                       | Some (T.StructUnionName(_,_)) -> None
 252                       | Some x ->
 253                           err exp (T.Pointer(t))
 254                             "non-structure pointer type in field ref"
 255                       | _ -> failwith "not possible")
 256                | Some (T.MetaType(_,_,_)) -> None
 257                | Some (T.TypeName(_)) -> None
 258                | Some x -> err exp x "non-structure pointer type in field ref")
 259         | Ast0.Cast(lp,ty,rp,exp) -> Some(Ast0.ast0_type_to_type ty)
 260         | Ast0.SizeOfExpr(szf,exp) -> Some(int_type)
 261         | Ast0.SizeOfType(szf,lp,ty,rp) -> Some(int_type)
 262         | Ast0.TypeExp(ty) -> None
 263         | Ast0.Constructor(lp,ty,rp,init) -> Some(Ast0.ast0_type_to_type ty)
 264         | Ast0.MetaErr(name,_,_) -> None
 265         | Ast0.MetaExpr(name,_,Some [ty],_,_) -> Some ty
 266         | Ast0.MetaExpr(name,_,ty,_,_) -> None
 267         | Ast0.MetaExprList(name,_,_) -> None
 268         | Ast0.EComma(cm) -> None
 269         | Ast0.DisjExpr(_,exp_list,_,_) ->
 270             let types = List.map Ast0.get_type exp_list in
 271             let combined = List.fold_left lub_type None types in
 272               (match combined with
 273                    None -> None
 274                  | Some t ->
 275                      List.iter (function e -> Ast0.set_type e (Some t)) exp_list;
 276                      Some t)
 277         | Ast0.NestExpr(starter,expr_dots,ender,None,multi) ->
 278             let _ = r.VT0.combiner_rec_expression_dots expr_dots in None
 279         | Ast0.NestExpr(starter,expr_dots,ender,Some e,multi) ->
 280             let _ = r.VT0.combiner_rec_expression_dots expr_dots in
 281             let _ = r.VT0.combiner_rec_expression e in None
 282         | Ast0.Edots(_,None) | Ast0.Ecircles(_,None) | Ast0.Estars(_,None) ->
 283             None
 284         | Ast0.Edots(_,Some e) | Ast0.Ecircles(_,Some e)
 285         | Ast0.Estars(_,Some e) ->
 286             let _ = r.VT0.combiner_rec_expression e in None
 287         | Ast0.OptExp(exp) -> Ast0.get_type exp
 288         | Ast0.UniqueExp(exp) -> Ast0.get_type exp
 289         | Ast0.AsExpr _ -> failwith "not possible" in
 290       Ast0.set_type e ty;
 291       ty in
 292
 293   let rec strip id =
 294     match Ast0.unwrap id with
 295       Ast0.Id(name)                -> [Id(Ast0.unwrap_mcode name)]
 296     | Ast0.MetaId(name,_,_,_)      -> [Meta(Ast0.unwrap_mcode name)]
 297     | Ast0.MetaFunc(name,_,_)      -> [Meta(Ast0.unwrap_mcode name)]
 298     | Ast0.MetaLocalFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)]
 299     | Ast0.DisjId(_,id_list,_,_)   -> List.concat (List.map strip id_list)
 300     | Ast0.OptIdent(id)            -> strip id
 301     | Ast0.UniqueIdent(id)         -> strip id
 302     | Ast0.AsIdent _ -> failwith "not possible" in
 303
 304   let process_whencode notfn allfn exp = function
 305       Ast0.WhenNot(x) -> let _ = notfn x in ()
 306     | Ast0.WhenAlways(x) -> let _ = allfn x in ()
 307     | Ast0.WhenModifier(_) -> ()
 308     | Ast0.WhenNotTrue(x) -> let _ = exp x in ()
 309     | Ast0.WhenNotFalse(x) -> let _ = exp x in () in
 310
 311   (* assume that all of the declarations are at the beginning of a statement
 312      list, which is required by C, but not actually required by the cocci
 313      parser *)
 314   let rec process_statement_list r acc = function
 315       [] -> acc
 316     | (s::ss) ->
 317         (match Ast0.unwrap s with
 318           Ast0.Decl(_,decl) ->
 319             let new_acc = (process_decl acc decl)@acc in
 320             process_statement_list r new_acc ss
 321         | Ast0.Dots(_,wc) ->
 322             (* why is this case here?  why is there none for nests? *)
 323             List.iter
 324               (process_whencode r.VT0.combiner_rec_statement_dots
 325                  r.VT0.combiner_rec_statement r.VT0.combiner_rec_expression)
 326               wc;
 327             process_statement_list r acc ss
 328         | Ast0.Disj(_,statement_dots_list,_,_) ->
 329             let new_acc =
 330               lub_envs
 331                 (List.map
 332                    (function x -> process_statement_list r acc (Ast0.undots x))
 333                    statement_dots_list) in
 334             process_statement_list r new_acc ss
 335         | _ ->
 336             let _ = (propagate_types acc).VT0.combiner_rec_statement s in
 337             process_statement_list r acc ss)
 338
 339   and process_decl env decl =
 340     match Ast0.unwrap decl with
 341       Ast0.MetaDecl(_,_) | Ast0.MetaField(_,_)
 342     | Ast0.MetaFieldList(_,_,_) -> []
 343     | Ast0.Init(_,ty,id,_,exp,_) ->
 344         let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in
 345         let ty = Ast0.ast0_type_to_type ty in
 346         List.map (function i -> (i,ty)) (strip id)
 347     | Ast0.UnInit(_,ty,id,_) ->
 348         let ty = Ast0.ast0_type_to_type ty in
 349         List.map (function i -> (i,ty)) (strip id)
 350     | Ast0.MacroDecl(_,_,_,_,_) -> []
 351     | Ast0.MacroDeclInit(_,_,_,_,_,exp,_) ->
 352         let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in
 353         []
 354     | Ast0.TyDecl(ty,_) -> []
 355               (* pad: should handle typedef one day and add a binding *)
 356     | Ast0.Typedef(_,_,_,_) -> []
 357     | Ast0.DisjDecl(_,disjs,_,_) ->
 358         List.concat(List.map (process_decl env) disjs)
 359     | Ast0.Ddots(_,_) -> [] (* not in a statement list anyway *)
 360     | Ast0.OptDecl(decl) -> process_decl env decl
 361     | Ast0.UniqueDecl(decl) -> process_decl env decl
 362     | Ast0.AsDecl _ -> failwith "not possible" in
 363
 364   let statement_dots r k d =
 365     match Ast0.unwrap d with
 366       Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) ->
 367         let _ = process_statement_list r env l in option_default in
 368
 369   let post_bool exp =
 370     let rec process_test exp =
 371       match (Ast0.unwrap exp,Ast0.get_type exp) with
 372         (Ast0.Edots(_,_),_) -> None
 373       | (Ast0.NestExpr(_,_,_,_,_),_) -> None
 374       | (Ast0.MetaExpr(_,_,_,_,_),_) ->
 375       (* if a type is known, it is specified in the decl *)
 376           None
 377       | (Ast0.Paren(lp,exp,rp),None) -> process_test exp
 378       (* the following doesn't seem like a good idea - triggers int isos
 379          on all test expressions *)
 380       (*| (_,None) -> Some (int_type) *)
 381       | _ -> None in
 382     let new_expty = process_test exp in
 383     (match new_expty with
 384       None -> () (* leave things as they are *)
 385     | Some ty -> Ast0.set_type exp new_expty) in
 386
 387   let statement r k s =
 388     match Ast0.unwrap s with
 389       Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 390         let rec get_binding p =
 391           match Ast0.unwrap p with
 392             Ast0.Param(ty,Some id) ->
 393               let ty = Ast0.ast0_type_to_type ty in
 394               List.map (function i -> (i,ty)) (strip id)
 395           | Ast0.OptParam(param) -> get_binding param
 396           | _ -> [] in
 397         let fenv = List.concat (List.map get_binding (Ast0.undots params)) in
 398         (propagate_types (fenv@env)).VT0.combiner_rec_statement_dots body
 399     | Ast0.IfThen(_,_,exp,_,_,_) | Ast0.IfThenElse(_,_,exp,_,_,_,_,_)
 400     | Ast0.While(_,_,exp,_,_,_) | Ast0.Do(_,_,_,_,exp,_,_) ->
 401         let _ = k s in
 402         post_bool exp;
 403         None
 404     | Ast0.For(a,b,first,exp,c,d,e,f,g) ->
 405         (match Ast0.unwrap first with
 406           Ast0.ForExp _ ->
 407             (match exp with
 408               Some exp ->
 409                 let _ = k s in
 410                 post_bool exp;
 411                 None
 412             | None -> k s)
 413         | Ast0.ForDecl (_,decl) ->
 414         (* not super elegant..., reuses a ; (d) *)
 415             let newenv = (process_decl env decl)@env in
 416             let dummy = Ast0.rewrap first (Ast0.ForExp (None,c)) in
 417             (propagate_types newenv).VT0.combiner_rec_statement
 418               (Ast0.rewrap s (Ast0.For(a,b,dummy,exp,c,d,e,f,g))))
 419     | Ast0.Switch(_,_,exp,_,_,decls,cases,_) ->
 420         let senv = process_statement_list r env (Ast0.undots decls) in
 421         let res =
 422           (propagate_types (senv@env)).VT0.combiner_rec_case_line_dots cases in
 423         post_bool exp;
 424         res
 425     |  _ -> k s
 426
 427   and case_line r k c =
 428     match Ast0.unwrap c with
 429       Ast0.Case(case,exp,colon,code) ->
 430         let _ = k c in
 431         (match Ast0.get_type exp with
 432           None -> Ast0.set_type exp (Some (int_type))
 433         | _ -> ());
 434         None
 435     | _ -> k c in
 436
 437   V0.combiner bind option_default
 438     {V0.combiner_functions with
 439       VT0.combiner_dotsstmtfn = statement_dots;
 440       VT0.combiner_identfn = ident;
 441       VT0.combiner_exprfn = expression;
 442       VT0.combiner_stmtfn = statement;
 443       VT0.combiner_casefn = case_line}
 444
 445 let type_infer code =
 446   let prop = propagate_types [(Id("NULL"),T.Pointer(T.Unknown))] in
 447   let fn = prop.VT0.combiner_rec_top_level in
 448   let _ = List.map fn code in
 449   ()