--- /dev/null
+(* Copyright (C) 2007, 2008 Yoann Padioleau
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ *
+ * This program 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
+ * file license.txt for more details.
+ *)
+
+open Common
+
+open Ast_c
+
+(*****************************************************************************)
+(* Types *)
+(*****************************************************************************)
+
+(* todo? define a new clean fulltype ? as julia did with type_cocci.ml
+ * without the parsing info, with some normalization (for instance have
+ * only structUnionName and enumName, and remove the ParenType), some
+ * abstractions (don't care for instance about name in parameters of
+ * functionType, or size of array), and with new types such as Unknown
+ * or PartialFunctionType (when don't have type of return when infer
+ * the type of function call not based on type of function but on the
+ * type of its arguments).
+ *
+ *
+ *
+ *)
+
+type finalType = Ast_c.fullType
+
+(*****************************************************************************)
+(* expression exp_info annotation vs finalType *)
+(*****************************************************************************)
+
+(* builders, needed because julia added gradually more information in
+ * the expression reference annotation in ast_c.
+ *)
+
+let make_info x =
+ (Some x, Ast_c.NotTest)
+
+let make_exp_type t =
+ (t, Ast_c.NotLocalVar)
+
+let make_info_def t =
+ make_info (make_exp_type t)
+
+
+
+let noTypeHere =
+ (None, Ast_c.NotTest)
+
+
+
+
+
+let do_with_type f (t,_test) =
+ match t with
+ | None -> noTypeHere
+ | Some (t,_local) -> f t
+
+let get_opt_type e =
+ match Ast_c.get_type_expr e with
+ | Some (t,_), _test -> Some t
+ | None, _test -> None
+
+
+
+(*****************************************************************************)
+(* Normalizers *)
+(*****************************************************************************)
+
+
+let structdef_to_struct_name ty =
+ match ty with
+ | qu, (StructUnion (su, sopt, fields), iis) ->
+ (match sopt,iis with
+ (* todo? but what if correspond to a nested struct def ? *)
+ | Some s , [i1;i2;i3;i4] ->
+ qu, (StructUnionName (su, s), [i1;i2])
+ | None, _ ->
+ ty
+ | x -> raise Impossible
+ )
+ | _ -> raise Impossible
+
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+
+let type_of_function (def,ii) =
+ let ftyp = def.f_type in
+
+ (* could use the info in the 'ii' ? *)
+
+ let fake = Ast_c.fakeInfo (Common.fake_parse_info) in
+ let fake_oparen = Ast_c.rewrap_str "(" fake in
+ let fake = Ast_c.fakeInfo (Common.fake_parse_info) in
+ let fake_cparen = Ast_c.rewrap_str ")" fake in
+
+ Ast_c.nQ, (FunctionType ftyp, [fake_oparen;fake_cparen])
+
+
+(* pre: only a single variable *)
+let type_of_decl decl =
+ match decl with
+ | Ast_c.DeclList (xs,ii1) ->
+ (match xs with
+ | [] -> raise Impossible
+
+ (* todo? for other xs ? *)
+ | (x,ii2)::xs ->
+ let {v_namei = _var; v_type = v_type;
+ v_storage = (_storage,_inline)} = x in
+
+ (* TODO normalize ? what if nested structure definition ? *)
+ v_type
+ )
+ | Ast_c.MacroDecl _ ->
+ pr2_once "not handling MacroDecl type yet";
+ raise Todo
+
+
+
+(* pre: it is indeed a struct def decl, and only a single variable *)
+let structdef_of_decl decl =
+
+ match decl with
+ | Ast_c.DeclList (xs,ii1) ->
+ (match xs with
+ | [] -> raise Impossible
+
+ (* todo? for other xs ? *)
+ | (x,ii2)::xs ->
+ let {v_namei = var; v_type = v_type;
+ v_storage = (storage,inline)} = x in
+
+ (match Ast_c.unwrap_typeC v_type with
+ | Ast_c.StructUnion (su, _must_be_some, fields) ->
+ (su, fields)
+ | _ -> raise Impossible
+ )
+ )
+ | Ast_c.MacroDecl _ -> raise Impossible
+
+
+
+
+(*****************************************************************************)
+(* Type builder *)
+(*****************************************************************************)
+
+let (fake_function_type:
+ fullType option -> argument wrap2 list -> fullType option) =
+ fun rettype args ->
+
+ let fake = Ast_c.fakeInfo (Common.fake_parse_info) in
+ let fake_oparen = Ast_c.rewrap_str "(" fake in
+ let fake = Ast_c.fakeInfo (Common.fake_parse_info) in
+ let fake_cparen = Ast_c.rewrap_str ")" fake in
+
+ let (tyargs: parameterType wrap2 list) =
+ args +> Common.map_filter (fun (arg,ii) ->
+ match arg with
+ | Left e ->
+ (match Ast_c.get_onlytype_expr e with
+ | Some ft ->
+ let paramtype =
+ (false, None, ft), []
+ in
+ Some (paramtype, ii)
+ | None -> None
+ )
+ | Right _ -> None
+ )
+ in
+ if List.length args <> List.length tyargs
+ then None
+ else
+ rettype +> Common.map_option (fun rettype ->
+ let (ftyp: functionType) = (rettype, (tyargs, (false,[]))) in
+ let (t: fullType) =
+ (Ast_c.nQ, (FunctionType ftyp, [fake_oparen;fake_cparen]))
+ in
+ t
+ )
+
+
+(*****************************************************************************)
+(* Typing rules *)
+(*****************************************************************************)
+
+
+(* todo: the rules are far more complex, but I prefer to simplify for now.
+ * todo: should take operator as a parameter.
+ *
+ * todo: Also need handle pointer arithmetic! the type of 'pt + 2'
+ * is still the type of pt. cf parsing_cocci/type_infer.ml
+ *
+ * (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *)
+ * | (T.Pointer(ty1),T.Pointer(ty2)) ->
+ * T.Pointer(loop(ty1,ty2))
+ * | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2)
+ * | (T.Pointer(ty1),ty2) -> T.Pointer(ty1)
+ *
+*)
+let lub t1 t2 =
+ let ftopt =
+ match t1, t2 with
+ | None, None -> None
+ | Some t, None -> Some t
+ | None, Some t -> Some t
+ (* check equal ? no cos can have pointer arithmetic so t2 can be <> t1
+ *
+ * todo: right now I favor the first term because usually pointer
+ * arithmetic are written with the pointer in the first position.
+ *
+ * Also when an expression contain a typedef, as in
+ * 'dma_addr + 1' where dma_addr was declared as a varialbe
+ * of type dma_addr_t, then again I want to have in the lub
+ * the typedef and it is often again in the first position.
+ *
+ *)
+ | Some t1, Some t2 ->
+ let t1bis = Ast_c.unwrap_typeC t1 in
+ let t2bis = Ast_c.unwrap_typeC t2 in
+ (match t1bis, t2bis with
+ (* todo, Pointer, Typedef, etc *)
+ | _, _ -> Some t1
+ )
+
+ in
+ match ftopt with
+ | None -> None, Ast_c.NotTest
+ | Some ft -> Some (ft, Ast_c.NotLocalVar), Ast_c.NotTest
+
+
+
+(*****************************************************************************)
+(* type lookup *)
+(*****************************************************************************)
+
+(* old: was using some nested find_some, but easier use ref
+ * update: handling union (used a lot in sparse)
+ * note: it is independent of the environment.
+*)
+let (type_field:
+ string -> (Ast_c.structUnion * Ast_c.structType) -> Ast_c.fullType) =
+ fun fld (su, fields) ->
+
+ let res = ref [] in
+
+ let rec aux_fields fields =
+ fields +> List.iter (fun x ->
+ match Ast_c.unwrap x with
+ | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) ->
+ onefield_multivars +> List.iter (fun fieldkind ->
+ match Ast_c.unwrap (Ast_c.unwrap fieldkind) with
+ | Simple (Some s, t) | BitField (Some s, t, _) ->
+ if s = fld
+ then Common.push2 t res
+ else ()
+
+ | Simple (None, t) ->
+ (match Ast_c.unwrap_typeC t with
+
+ (* union *)
+ | StructUnion (Union, _, fields) ->
+ aux_fields fields
+
+ (* Special case of nested structure definition inside
+ * structure without associated field variable as in
+ * struct top = { ... struct xx { int subfield1; ... }; ... }
+ * cf sparse source, where can access subfields directly.
+ * It can also be used in conjunction with union.
+ *)
+ | StructUnion (Struct, _, fields) ->
+ aux_fields fields
+
+ | _ -> ()
+ )
+ | _ -> ()
+ )
+
+ | EmptyField -> ()
+ | MacroStructDeclTodo -> pr2_once "DeclTodo"; ()
+
+ | CppDirectiveStruct _
+ | IfdefStruct _ -> pr2_once "StructCpp";
+ )
+ in
+ aux_fields fields;
+ match !res with
+ | [t] -> t
+ | [] ->
+ raise Not_found
+ | x::y::xs ->
+ pr2 ("MultiFound field: " ^ fld) ;
+ x
+
+
+
HCoop / bpt / coccinelle.git / blobdiff