Coccinelle release 1.0.0-rc15
[bpt/coccinelle.git] / parsing_cocci / type_infer.ml
index 9f68611..8a2b4b7 100644 (file)
@@ -1,3 +1,30 @@
+(*
+ * 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.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
+# 0 "./type_infer.ml"
 module T = Type_cocci
 module Ast = Ast_cocci
 module Ast0 = Ast0_cocci
@@ -18,12 +45,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
@@ -77,9 +108,18 @@ 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)
+    | Ast0.AsIdent _ -> failwith "not possible"
     | _ -> k i in
 
   let strip_cv = function
@@ -91,6 +131,7 @@ let rec propagate_types env =
       T.BaseType(T.IntType)
     | T.BaseType(T.LongType)
     | T.BaseType(T.ShortType)
+    | T.BaseType(T.SizeType)
     | T.MetaType(_,_,_)
     | T.TypeName _
     | T.EnumName _
@@ -129,6 +170,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
@@ -141,6 +183,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
@@ -167,15 +210,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
@@ -187,7 +236,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")
@@ -199,7 +248,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"
@@ -211,6 +260,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
@@ -235,18 +285,21 @@ 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
+    | Ast0.UniqueIdent(id)         -> strip id
+    | Ast0.AsIdent _ -> failwith "not possible" in
 
   let process_whencode notfn allfn exp = function
       Ast0.WhenNot(x) -> let _ = notfn x in ()
@@ -285,13 +338,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(_,_,_,_) -> []
@@ -299,7 +358,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
@@ -315,7 +375,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
@@ -328,17 +390,32 @@ 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
        (propagate_types (fenv@env)).VT0.combiner_rec_statement_dots body
     | Ast0.IfThen(_,_,exp,_,_,_) | Ast0.IfThenElse(_,_,exp,_,_,_,_,_)
-    | Ast0.While(_,_,exp,_,_,_) | Ast0.Do(_,_,_,_,exp,_,_)
-    | Ast0.For(_,_,_,_,Some exp,_,_,_,_,_) ->
+    | Ast0.While(_,_,exp,_,_,_) | Ast0.Do(_,_,_,_,exp,_,_) ->
        let _ = k s in
-       post_bool exp;
-       None
+        post_bool exp;
+        None
+    | Ast0.For(a,b,first,exp,c,d,e,f,g) ->
+       (match Ast0.unwrap first with
+         Ast0.ForExp _ ->
+           (match exp with
+             Some exp ->
+               let _ = k s in
+               post_bool exp;
+               None
+           | None -> k s)
+       | Ast0.ForDecl (_,decl) ->
+       (* not super elegant..., reuses a ; (d) *)
+           let newenv = (process_decl env decl)@env in
+           let dummy = Ast0.rewrap first (Ast0.ForExp (None,c)) in
+           (propagate_types newenv).VT0.combiner_rec_statement
+             (Ast0.rewrap s (Ast0.For(a,b,dummy,exp,c,d,e,f,g))))
     | Ast0.Switch(_,_,exp,_,_,decls,cases,_) ->
        let senv = process_statement_list r env (Ast0.undots decls) in
        let res =