Coccinelle release-1.0.0-rc11
[bpt/coccinelle.git] / parsing_cocci / type_infer.ml
index 5d96ce6..292b580 100644 (file)
@@ -1,4 +1,8 @@
 (*
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  * This file is part of Coccinelle.
@@ -40,12 +44,16 @@ let err wrapped ty s =
   T.typeC ty; Format.print_newline();
   failwith (Printf.sprintf "line %d: %s" (Ast0.get_line wrapped) s)
 
-type id = Id of string | Meta of (string * string)
+type id = Id of string | Meta of Ast.meta_name
 
 let int_type = T.BaseType(T.IntType)
+let void_type = T.BaseType(T.VoidType)
 let bool_type = T.BaseType(T.BoolType)
 let char_type = T.BaseType(T.CharType)
 let float_type = T.BaseType(T.FloatType)
+let size_type = T.BaseType(T.SizeType)
+let ssize_type = T.BaseType(T.SSizeType)
+let ptrdiff_type = T.BaseType(T.PtrDiffType)
 
 let rec lub_type t1 t2 =
   match (t1,t2) with
@@ -99,9 +107,17 @@ let rec propagate_types env =
       Ast0.Id(id) ->
        (try Some(List.assoc (Id(Ast0.unwrap_mcode id)) env)
        with Not_found -> None)
-    | Ast0.MetaId(id,_,_) ->
+    | Ast0.MetaId(id,_,_,_) ->
        (try Some(List.assoc (Meta(Ast0.unwrap_mcode id)) env)
        with Not_found -> None)
+    | Ast0.DisjId(_,id_list,_,_) ->
+       let types = List.map Ast0.get_type id_list in
+       let combined = List.fold_left lub_type None types in
+       (match combined with
+         None -> None
+       | Some t ->
+           List.iter (function i -> Ast0.set_type i (Some t)) id_list;
+           Some t)
     | _ -> k i in
 
   let strip_cv = function
@@ -151,6 +167,7 @@ let rec propagate_types env =
        | Ast0.Assignment(exp1,op,exp2,_) ->
            let ty = lub_type (Ast0.get_type exp1) (Ast0.get_type exp2) in
              Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty
+       | Ast0.Sequence(exp1,op,exp2) -> Ast0.get_type exp2
        | Ast0.CondExpr(exp1,why,Some exp2,colon,exp3) ->
            let ty = lub_type (Ast0.get_type exp2) (Ast0.get_type exp3) in
              Ast0.set_type exp2 ty; Ast0.set_type exp3 ty; ty
@@ -163,6 +180,7 @@ let rec propagate_types env =
                   (match Ast0.get_type exp with
                        None -> Some (T.Pointer(T.Unknown))
                      | Some t -> Some (T.Pointer(t)))
+              | Ast.GetRefLabel -> Some (T.Pointer(void_type))
               | Ast.DeRef ->
                   (match Ast0.get_type exp with
                        Some (T.Pointer(t)) -> Some t
@@ -189,15 +207,21 @@ let rec propagate_types env =
                    Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty in
              (match Ast0.unwrap_mcode op with
                   Ast.Arith(op) -> same_type (ty1, ty2)
+                | Ast.Logical(Ast.AndLog) | Ast.Logical(Ast.OrLog) ->
+                    Some(bool_type)
                 | Ast.Logical(op) ->
                     let ty = lub_type ty1 ty2 in
-                      Ast0.set_type exp1 ty; Ast0.set_type exp2 ty;
-                      Some(bool_type))
+                    Ast0.set_type exp1 ty; Ast0.set_type exp2 ty;
+                    Some(bool_type))
        | Ast0.Paren(lp,exp,rp) -> Ast0.get_type exp
        | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
            (match strip_cv (Ast0.get_type exp2) with
                 None -> Ast0.set_type exp2 (Some(int_type))
               | Some(ty) when is_int_type ty -> ()
+              | Some(Type_cocci.Unknown) ->
+                  (* unknown comes from param types, not sure why this
+                     is not just None... *)
+                  Ast0.set_type exp2 (Some(int_type))
               | Some ty -> err exp2 ty "bad type for an array index");
            (match strip_cv (Ast0.get_type exp1) with
                 None -> None
@@ -209,7 +233,7 @@ let rec propagate_types env =
        | Ast0.RecordAccess(exp,pt,field) ->
            (match strip_cv (Ast0.get_type exp) with
                 None -> None
-              | Some (T.StructUnionName(_,_,_)) -> None
+              | Some (T.StructUnionName(_,_)) -> None
               | Some (T.TypeName(_)) -> None
               | Some (T.MetaType(_,_,_)) -> None
               | Some x -> err exp x "non-structure type in field ref")
@@ -221,7 +245,7 @@ let rec propagate_types env =
                      | Some (T.Unknown) -> None
                      | Some (T.MetaType(_,_,_)) -> None
                      | Some (T.TypeName(_)) -> None
-                     | Some (T.StructUnionName(_,_,_)) -> None
+                     | Some (T.StructUnionName(_,_)) -> None
                      | Some x ->
                          err exp (T.Pointer(t))
                            "non-structure pointer type in field ref"
@@ -233,6 +257,7 @@ let rec propagate_types env =
        | Ast0.SizeOfExpr(szf,exp) -> Some(int_type)
        | Ast0.SizeOfType(szf,lp,ty,rp) -> Some(int_type)
        | Ast0.TypeExp(ty) -> None
+       | Ast0.Constructor(lp,ty,rp,init) -> Some(Ast0.ast0_type_to_type ty)
        | Ast0.MetaErr(name,_,_) -> None
        | Ast0.MetaExpr(name,_,Some [ty],_,_) -> Some ty
        | Ast0.MetaExpr(name,_,ty,_,_) -> None
@@ -257,16 +282,18 @@ let rec propagate_types env =
        | Ast0.Estars(_,Some e) ->
            let _ = r.VT0.combiner_rec_expression e in None
        | Ast0.OptExp(exp) -> Ast0.get_type exp
-       | Ast0.UniqueExp(exp) -> Ast0.get_type exp in
+       | Ast0.UniqueExp(exp) -> Ast0.get_type exp
+       | Ast0.AsExpr _ -> failwith "not possible" in
       Ast0.set_type e ty;
       ty in
 
   let rec strip id =
     match Ast0.unwrap id with
-      Ast0.Id(name)                -> Id(Ast0.unwrap_mcode name)
-    | Ast0.MetaId(name,_,_)        -> Meta(Ast0.unwrap_mcode name)
-    | Ast0.MetaFunc(name,_,_)      -> Meta(Ast0.unwrap_mcode name)
-    | Ast0.MetaLocalFunc(name,_,_) -> Meta(Ast0.unwrap_mcode name)
+      Ast0.Id(name)                -> [Id(Ast0.unwrap_mcode name)]
+    | Ast0.MetaId(name,_,_,_)      -> [Meta(Ast0.unwrap_mcode name)]
+    | Ast0.MetaFunc(name,_,_)      -> [Meta(Ast0.unwrap_mcode name)]
+    | Ast0.MetaLocalFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)]
+    | Ast0.DisjId(_,id_list,_,_)   -> List.concat (List.map strip id_list)
     | Ast0.OptIdent(id)            -> strip id
     | Ast0.UniqueIdent(id)         -> strip id in
 
@@ -307,13 +334,19 @@ let rec propagate_types env =
 
   and process_decl env decl =
     match Ast0.unwrap decl with
-      Ast0.Init(_,ty,id,_,exp,_) ->
-       let _ =
-         (propagate_types env).VT0.combiner_rec_initialiser exp in
-       [(strip id,Ast0.ast0_type_to_type ty)]
+      Ast0.MetaDecl(_,_) | Ast0.MetaField(_,_)
+    | Ast0.MetaFieldList(_,_,_) -> []
+    | Ast0.Init(_,ty,id,_,exp,_) ->
+       let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in
+       let ty = Ast0.ast0_type_to_type ty in
+       List.map (function i -> (i,ty)) (strip id)
     | Ast0.UnInit(_,ty,id,_) ->
-       [(strip id,Ast0.ast0_type_to_type ty)]
+       let ty = Ast0.ast0_type_to_type ty in
+       List.map (function i -> (i,ty)) (strip id)
     | Ast0.MacroDecl(_,_,_,_,_) -> []
+    | Ast0.MacroDeclInit(_,_,_,_,_,exp,_) ->
+        let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in
+       []
     | Ast0.TyDecl(ty,_) -> []
               (* pad: should handle typedef one day and add a binding *)
     | Ast0.Typedef(_,_,_,_) -> []
@@ -321,7 +354,8 @@ let rec propagate_types env =
        List.concat(List.map (process_decl env) disjs)
     | Ast0.Ddots(_,_) -> [] (* not in a statement list anyway *)
     | Ast0.OptDecl(decl) -> process_decl env decl
-    | Ast0.UniqueDecl(decl) -> process_decl env decl in
+    | Ast0.UniqueDecl(decl) -> process_decl env decl
+    | Ast0.AsDecl _ -> failwith "not possible" in
 
   let statement_dots r k d =
     match Ast0.unwrap d with
@@ -337,7 +371,9 @@ let rec propagate_types env =
       (* if a type is known, it is specified in the decl *)
          None
       | (Ast0.Paren(lp,exp,rp),None) -> process_test exp
-      | (_,None) -> Some (int_type)
+      (* the following doesn't seem like a good idea - triggers int isos
+        on all test expressions *)
+      (*| (_,None) -> Some (int_type) *)
       | _ -> None in
     let new_expty = process_test exp in
     (match new_expty with
@@ -350,7 +386,8 @@ let rec propagate_types env =
        let rec get_binding p =
          match Ast0.unwrap p with
            Ast0.Param(ty,Some id) ->
-             [(strip id,Ast0.ast0_type_to_type ty)]
+             let ty = Ast0.ast0_type_to_type ty in
+             List.map (function i -> (i,ty)) (strip id)
          | Ast0.OptParam(param) -> get_binding param
          | _ -> [] in
        let fenv = List.concat (List.map get_binding (Ast0.undots params)) in