From 82f2b7b6dead4d3f1dd750775f41100e0094adf2 Mon Sep 17 00:00:00 2001 From: Sam Blackshear Date: Mon, 29 Feb 2016 16:31:56 -0800 Subject: [PATCH] make tenv a typename -> struct_typ map Reviewed By: cristianoc Differential Revision: D2988297 fb-gh-sync-id: 7cff941 shipit-source-id: 7cff941 --- infer/src/backend/prover.ml | 3 +- infer/src/backend/sil.ml | 52 +++++++++++++------------- infer/src/backend/sil.mli | 4 +- infer/src/clang/cFrontend_utils.ml | 59 +++++++++++++----------------- infer/src/harness/harness.ml | 3 +- infer/src/java/jTransType.ml | 4 +- 6 files changed, 60 insertions(+), 65 deletions(-) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 657dbdbbe..8b554549a 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -1608,7 +1608,8 @@ let get_overrides_of tenv supertype pname = | Sil.Tstruct { Sil.def_methods } -> IList.exists (fun m -> Procname.equal pname m) def_methods | _ -> false in - let gather_overrides tname typ overrides_acc = + let gather_overrides tname struct_typ overrides_acc = + let typ = Sil.Tstruct struct_typ in (* get all types in the type environment that are non-reflexive subtypes of [supertype] *) if not (Sil.typ_equal typ supertype) && Subtyping_check.check_subtype tenv typ supertype then (* only select the ones that implement [pname] as overrides *) diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index f04ab3cd5..52dd2f048 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -1970,23 +1970,8 @@ and pp_const pe f = function and pp_typ pe f te = if !Config.print_types then pp_typ_full pe f te else () -(** Pretty print a type declaration. - pp_base prints the variable for a declaration, or can be skip to print only the type - pp_size prints the expression for the array size *) -and pp_type_decl pe pp_base pp_size f = function - | Tvar tname -> F.fprintf f "%s %a" (Typename.to_string tname) pp_base () - | Tint ik -> F.fprintf f "%s %a" (ikind_to_string ik) pp_base () - | Tfloat fk -> F.fprintf f "%s %a" (fkind_to_string fk) pp_base () - | Tvoid -> F.fprintf f "void %a" pp_base () - | Tfun false -> F.fprintf f "_fn_ %a" pp_base () - | Tfun true -> F.fprintf f "_fn_noreturn_ %a" pp_base () - | Tptr ((Tarray _ | Tfun _) as typ, pk) -> - let pp_base' fmt () = F.fprintf fmt "(%s%a)" (ptr_kind_string pk) pp_base () in - pp_type_decl pe pp_base' pp_size f typ - | Tptr (typ, pk) -> - let pp_base' fmt () = F.fprintf fmt "%s%a" (ptr_kind_string pk) pp_base () in - pp_type_decl pe pp_base' pp_size f typ - | Tstruct ({struct_name = Some name} as struct_typ) when false -> +and pp_struct_typ pe pp_base f struct_typ = match struct_typ.struct_name with + | Some name when false -> (* remove "when false" to print the details of struct *) F.fprintf f "%s %a {%a} %a" (Csu.name struct_typ.csu) @@ -1996,12 +1981,12 @@ and pp_type_decl pe pp_base pp_size f = function (pp_typ_full pe) t Ident.pp_fieldname fld)) struct_typ.instance_fields pp_base () - | Tstruct ({struct_name = Some name} as struct_typ) -> + | Some name -> F.fprintf f "%s %a %a" (Csu.name struct_typ.csu) Mangled.pp name pp_base () - | Tstruct ({struct_name = None} as struct_typ) -> + | None -> F.fprintf f "%s {%a} %a" (Csu.name struct_typ.csu) (pp_seq (fun f (fld, t, _) -> @@ -2009,6 +1994,24 @@ and pp_type_decl pe pp_base pp_size f = function (pp_typ_full pe) t Ident.pp_fieldname fld)) struct_typ.instance_fields pp_base () + +(** Pretty print a type declaration. + pp_base prints the variable for a declaration, or can be skip to print only the type + pp_size prints the expression for the array size *) +and pp_type_decl pe pp_base pp_size f = function + | Tvar tname -> F.fprintf f "%s %a" (Typename.to_string tname) pp_base () + | Tint ik -> F.fprintf f "%s %a" (ikind_to_string ik) pp_base () + | Tfloat fk -> F.fprintf f "%s %a" (fkind_to_string fk) pp_base () + | Tvoid -> F.fprintf f "void %a" pp_base () + | Tfun false -> F.fprintf f "_fn_ %a" pp_base () + | Tfun true -> F.fprintf f "_fn_noreturn_ %a" pp_base () + | Tptr ((Tarray _ | Tfun _) as typ, pk) -> + let pp_base' fmt () = F.fprintf fmt "(%s%a)" (ptr_kind_string pk) pp_base () in + pp_type_decl pe pp_base' pp_size f typ + | Tptr (typ, pk) -> + let pp_base' fmt () = F.fprintf fmt "%s%a" (ptr_kind_string pk) pp_base () in + pp_type_decl pe pp_base' pp_size f typ + | Tstruct struct_typ -> pp_struct_typ pe pp_base f struct_typ | Tarray (typ, size) -> let pp_base' fmt () = F.fprintf fmt "%a[%a]" pp_base () (pp_size pe) size in pp_type_decl pe pp_base' pp_size f typ @@ -3756,7 +3759,7 @@ module TypenameHash = end) (** Type for type environment. *) -type tenv = typ TypenameHash.t +type tenv = struct_typ TypenameHash.t (** Create a new type environment. *) let create_tenv () = TypenameHash.create 1000 @@ -3767,14 +3770,14 @@ let tenv_mem tenv name = (** Look up a name in the global type environment. *) let tenv_lookup tenv name = - try Some (TypenameHash.find tenv name) + try Some (Tstruct (TypenameHash.find tenv name)) with Not_found -> None (** Add a (name,type) pair to the global type environment. *) let tenv_add tenv name typ = match typ with - | Tvar _ -> assert false - | _ -> TypenameHash.replace tenv name typ + | Tstruct struct_typ -> TypenameHash.replace tenv name struct_typ + | _ -> assert false (** expand a type if it is a typename by looking it up in the type environment *) let expand_type tenv typ = @@ -3783,7 +3786,6 @@ let expand_type tenv typ = begin match tenv_lookup tenv tname with | None -> assert false - | Some (Tvar _) -> assert false | Some typ' -> typ' end | _ -> typ @@ -3818,7 +3820,7 @@ let pp_tenv f (tenv : tenv) = TypenameHash.iter (fun name typ -> Format.fprintf f "@[<6>NAME: %s@." (Typename.to_string name); - Format.fprintf f "@[<6>TYPE: %a@." (pp_typ_full pe_text) typ) + Format.fprintf f "@[<6>TYPE: %a@." (pp_struct_typ pe_text (fun _ () -> ())) typ) tenv (** {2 Functions for constructing or destructing entities in this module} *) diff --git a/infer/src/backend/sil.mli b/infer/src/backend/sil.mli index 80f556df7..2715db000 100644 --- a/infer/src/backend/sil.mli +++ b/infer/src/backend/sil.mli @@ -540,9 +540,9 @@ val load_tenv_from_file : DB.filename -> tenv option val store_tenv_to_file : DB.filename -> tenv -> unit (** iterate over a type environment *) -val tenv_iter : (Typename.t -> typ -> unit) -> tenv -> unit +val tenv_iter : (Typename.t -> struct_typ -> unit) -> tenv -> unit -val tenv_fold : (Typename.t -> typ -> 'a -> 'a) -> tenv -> 'a -> 'a +val tenv_fold : (Typename.t -> struct_typ -> 'a -> 'a) -> tenv -> 'a -> 'a (** print a type environment *) val pp_tenv : Format.formatter -> tenv -> unit diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 71bee0144..43e9b0443 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -39,44 +39,38 @@ struct pp Format.std_formatter fmt let print_tenv tenv = - Sil.tenv_iter (fun typname typ -> + Sil.tenv_iter (fun typname struct_t -> match typname with | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> - (match typ with - | Sil.Tstruct { Sil.instance_fields; superclasses; def_methods; struct_annotations } -> - print_endline ( - (Typename.to_string typname) ^ " " ^ - (Sil.item_annotation_to_string struct_annotations) ^ "\n" ^ - "---> superclass and protocols " ^ (IList.to_string (fun tn -> - "\t" ^ (Typename.to_string tn) ^ "\n") superclasses) ^ - "---> methods " ^ - (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") def_methods) - ^ " " ^ - "\t---> fields " ^ (IList.to_string field_to_string instance_fields) ^ "\n") - | _ -> ()) + print_endline ( + (Typename.to_string typname) ^ " " ^ + (Sil.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ + "---> superclass and protocols " ^ (IList.to_string (fun tn -> + "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^ + "---> methods " ^ + (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods) + ^ " " ^ + "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n") | _ -> () ) tenv let print_tenv_struct_unions tenv = - Sil.tenv_iter (fun typname typ -> + Sil.tenv_iter (fun typname struct_t -> match typname with | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) -> - (match typ with - | Sil.Tstruct { Sil.instance_fields } -> - print_endline ( - (Typename.to_string typname)^"\n"^ - "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> - match typ with - | Sil.Tvar tname -> "tvar"^(Typename.to_string tname) - | Sil.Tstruct _ | _ -> - "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ - (Sil.typ_to_string typ)^"\n") instance_fields - ) - ) - | _ -> () + print_endline ( + (Typename.to_string typname)^"\n"^ + "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> + match typ with + | Sil.Tvar tname -> "tvar"^(Typename.to_string tname) + | Sil.Tstruct _ | _ -> + "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ + (Sil.typ_to_string typ)^"\n") struct_t.instance_fields + ) ) | Typename.TN_typedef typname -> - print_endline ((Mangled.to_string typname)^"-->"^(Sil.typ_to_string typ)) + print_endline + ((Mangled.to_string typname)^"-->"^(Sil.typ_to_string (Sil.Tstruct struct_t))) | _ -> () ) tenv @@ -466,12 +460,9 @@ struct let sort_fields_tenv tenv = - let sort_fields_struct typname typ = - match typ with - | Sil.Tstruct st -> - let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in - Sil.tenv_add tenv typname (Sil.Tstruct st') - | _ -> () in + let sort_fields_struct typname st = + let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in + Sil.tenv_add tenv typname (Sil.Tstruct st') in Sil.tenv_iter sort_fields_struct tenv let rec collect_list_tuples l (a, a1, b, c, d) = diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index b135644e7..d516bd5b9 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -175,7 +175,8 @@ let create_android_harness proc_file_map tenv = | Some (framework_typ, framework_procs) -> (* iterate through the type environment and generate a lifecycle harness for each subclass of * [lifecycle_typ] *) - Sil.tenv_iter (fun _ typ -> + Sil.tenv_iter (fun _ struct_typ -> + let typ = Sil.Tstruct struct_typ in match try_create_lifecycle_trace typ framework_typ framework_procs tenv with | [] -> () | lifecycle_trace -> diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 3ab1c339e..5a51690f2 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -465,9 +465,9 @@ let return_type program tenv ms meth_kind = let add_models_types tenv = - let add_type t typename typ = + let add_type t typename struct_typ = if not (Sil.tenv_mem t typename) then - Sil.tenv_add tenv typename typ in + Sil.tenv_add tenv typename (Sil.Tstruct struct_typ) in Sil.tenv_iter (add_type tenv) !JClasspath.models_tenv