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