make tenv a typename -> struct_typ map

Reviewed By: cristianoc

Differential Revision: D2988297

fb-gh-sync-id: 7cff941
shipit-source-id: 7cff941
master
Sam Blackshear 9 years ago committed by Facebook Github Bot 3
parent 878bf938eb
commit 82f2b7b6de

@ -1608,7 +1608,8 @@ let get_overrides_of tenv supertype pname =
| Sil.Tstruct { Sil.def_methods } -> | Sil.Tstruct { Sil.def_methods } ->
IList.exists (fun m -> Procname.equal pname m) def_methods IList.exists (fun m -> Procname.equal pname m) def_methods
| _ -> false in | _ -> 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] *) (* 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 if not (Sil.typ_equal typ supertype) && Subtyping_check.check_subtype tenv typ supertype then
(* only select the ones that implement [pname] as overrides *) (* only select the ones that implement [pname] as overrides *)

@ -1970,23 +1970,8 @@ and pp_const pe f = function
and pp_typ pe f te = and pp_typ pe f te =
if !Config.print_types then pp_typ_full pe f te else () if !Config.print_types then pp_typ_full pe f te else ()
(** Pretty print a type declaration. and pp_struct_typ pe pp_base f struct_typ = match struct_typ.struct_name with
pp_base prints the variable for a declaration, or can be skip to print only the type | Some name when false ->
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 ->
(* remove "when false" to print the details of struct *) (* remove "when false" to print the details of struct *)
F.fprintf f "%s %a {%a} %a" F.fprintf f "%s %a {%a} %a"
(Csu.name struct_typ.csu) (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 (pp_typ_full pe) t
Ident.pp_fieldname fld)) struct_typ.instance_fields Ident.pp_fieldname fld)) struct_typ.instance_fields
pp_base () pp_base ()
| Tstruct ({struct_name = Some name} as struct_typ) -> | Some name ->
F.fprintf f "%s %a %a" F.fprintf f "%s %a %a"
(Csu.name struct_typ.csu) (Csu.name struct_typ.csu)
Mangled.pp name Mangled.pp name
pp_base () pp_base ()
| Tstruct ({struct_name = None} as struct_typ) -> | None ->
F.fprintf f "%s {%a} %a" F.fprintf f "%s {%a} %a"
(Csu.name struct_typ.csu) (Csu.name struct_typ.csu)
(pp_seq (fun f (fld, t, _) -> (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 (pp_typ_full pe) t
Ident.pp_fieldname fld)) struct_typ.instance_fields Ident.pp_fieldname fld)) struct_typ.instance_fields
pp_base () 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) -> | Tarray (typ, size) ->
let pp_base' fmt () = F.fprintf fmt "%a[%a]" pp_base () (pp_size pe) size in 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 pp_type_decl pe pp_base' pp_size f typ
@ -3756,7 +3759,7 @@ module TypenameHash =
end) end)
(** Type for type environment. *) (** Type for type environment. *)
type tenv = typ TypenameHash.t type tenv = struct_typ TypenameHash.t
(** Create a new type environment. *) (** Create a new type environment. *)
let create_tenv () = TypenameHash.create 1000 let create_tenv () = TypenameHash.create 1000
@ -3767,14 +3770,14 @@ let tenv_mem tenv name =
(** Look up a name in the global type environment. *) (** Look up a name in the global type environment. *)
let tenv_lookup tenv name = let tenv_lookup tenv name =
try Some (TypenameHash.find tenv name) try Some (Tstruct (TypenameHash.find tenv name))
with Not_found -> None with Not_found -> None
(** Add a (name,type) pair to the global type environment. *) (** Add a (name,type) pair to the global type environment. *)
let tenv_add tenv name typ = let tenv_add tenv name typ =
match typ with match typ with
| Tvar _ -> assert false | Tstruct struct_typ -> TypenameHash.replace tenv name struct_typ
| _ -> TypenameHash.replace tenv name typ | _ -> assert false
(** expand a type if it is a typename by looking it up in the type environment *) (** expand a type if it is a typename by looking it up in the type environment *)
let expand_type tenv typ = let expand_type tenv typ =
@ -3783,7 +3786,6 @@ let expand_type tenv typ =
begin begin
match tenv_lookup tenv tname with match tenv_lookup tenv tname with
| None -> assert false | None -> assert false
| Some (Tvar _) -> assert false
| Some typ' -> typ' | Some typ' -> typ'
end end
| _ -> typ | _ -> typ
@ -3818,7 +3820,7 @@ let pp_tenv f (tenv : tenv) =
TypenameHash.iter TypenameHash.iter
(fun name typ -> (fun name typ ->
Format.fprintf f "@[<6>NAME: %s@." (Typename.to_string name); 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 tenv
(** {2 Functions for constructing or destructing entities in this module} *) (** {2 Functions for constructing or destructing entities in this module} *)

@ -540,9 +540,9 @@ val load_tenv_from_file : DB.filename -> tenv option
val store_tenv_to_file : DB.filename -> tenv -> unit val store_tenv_to_file : DB.filename -> tenv -> unit
(** iterate over a type environment *) (** 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 *) (** print a type environment *)
val pp_tenv : Format.formatter -> tenv -> unit val pp_tenv : Format.formatter -> tenv -> unit

@ -39,30 +39,25 @@ struct
pp Format.std_formatter fmt pp Format.std_formatter fmt
let print_tenv tenv = let print_tenv tenv =
Sil.tenv_iter (fun typname typ -> Sil.tenv_iter (fun typname struct_t ->
match typname with match typname with
| Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> | 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 ( print_endline (
(Typename.to_string typname) ^ " " ^ (Typename.to_string typname) ^ " " ^
(Sil.item_annotation_to_string struct_annotations) ^ "\n" ^ (Sil.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^
"---> superclass and protocols " ^ (IList.to_string (fun tn -> "---> superclass and protocols " ^ (IList.to_string (fun tn ->
"\t" ^ (Typename.to_string tn) ^ "\n") superclasses) ^ "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^
"---> methods " ^ "---> methods " ^
(IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") def_methods) (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods)
^ " " ^ ^ " " ^
"\t---> fields " ^ (IList.to_string field_to_string instance_fields) ^ "\n") "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n")
| _ -> ())
| _ -> () | _ -> ()
) tenv ) tenv
let print_tenv_struct_unions tenv = let print_tenv_struct_unions tenv =
Sil.tenv_iter (fun typname typ -> Sil.tenv_iter (fun typname struct_t ->
match typname with match typname with
| Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) -> | Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) ->
(match typ with
| Sil.Tstruct { Sil.instance_fields } ->
print_endline ( print_endline (
(Typename.to_string typname)^"\n"^ (Typename.to_string typname)^"\n"^
"\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) ->
@ -70,13 +65,12 @@ struct
| Sil.Tvar tname -> "tvar"^(Typename.to_string tname) | Sil.Tvar tname -> "tvar"^(Typename.to_string tname)
| Sil.Tstruct _ | _ -> | Sil.Tstruct _ | _ ->
"\t struct "^(Ident.fieldname_to_string fieldname)^" "^ "\t struct "^(Ident.fieldname_to_string fieldname)^" "^
(Sil.typ_to_string typ)^"\n") instance_fields (Sil.typ_to_string typ)^"\n") struct_t.instance_fields
) )
) )
| _ -> ()
)
| Typename.TN_typedef typname -> | 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 ) tenv
@ -466,12 +460,9 @@ struct
let sort_fields_tenv tenv = let sort_fields_tenv tenv =
let sort_fields_struct typname typ = let sort_fields_struct typname st =
match typ with
| Sil.Tstruct st ->
let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in
Sil.tenv_add tenv typname (Sil.Tstruct st') Sil.tenv_add tenv typname (Sil.Tstruct st') in
| _ -> () in
Sil.tenv_iter sort_fields_struct tenv Sil.tenv_iter sort_fields_struct tenv
let rec collect_list_tuples l (a, a1, b, c, d) = let rec collect_list_tuples l (a, a1, b, c, d) =

@ -175,7 +175,8 @@ let create_android_harness proc_file_map tenv =
| Some (framework_typ, framework_procs) -> | Some (framework_typ, framework_procs) ->
(* iterate through the type environment and generate a lifecycle harness for each subclass of (* iterate through the type environment and generate a lifecycle harness for each subclass of
* [lifecycle_typ] *) * [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 match try_create_lifecycle_trace typ framework_typ framework_procs tenv with
| [] -> () | [] -> ()
| lifecycle_trace -> | lifecycle_trace ->

@ -465,9 +465,9 @@ let return_type program tenv ms meth_kind =
let add_models_types tenv = 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 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 Sil.tenv_iter (add_type tenv) !JClasspath.models_tenv

Loading…
Cancel
Save