X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/7f00441914f5b9bd4f845a1c866da65e1946083e..755320b0f64ab4fe487507104d2929cfb19dcee1:/parsing_cocci/type_infer.ml diff --git a/parsing_cocci/type_infer.ml b/parsing_cocci/type_infer.ml index 9f68611..8a2b4b7 100644 --- a/parsing_cocci/type_infer.ml +++ b/parsing_cocci/type_infer.ml @@ -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 . + * + * 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 =