You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
131 lines
4.7 KiB
131 lines
4.7 KiB
(*
|
|
* Copyright (c) 2016 - present Facebook, Inc.
|
|
* All rights reserved.
|
|
*
|
|
* This source code is licensed under the BSD style license found in the
|
|
* LICENSE file in the root directory of this source tree. An additional grant
|
|
* of patent rights can be found in the PATENTS file in the same directory.
|
|
*)
|
|
open! IStd
|
|
module Hashtbl = Caml.Hashtbl
|
|
|
|
(** Module for Type Environments. *)
|
|
|
|
(** Hash tables on strings. *)
|
|
module TypenameHash = Hashtbl.Make (struct
|
|
type t = Typ.Name.t
|
|
|
|
let equal tn1 tn2 = Typ.Name.equal tn1 tn2
|
|
|
|
let hash = Hashtbl.hash
|
|
end)
|
|
|
|
(** Type for type environment. *)
|
|
type t = Typ.Struct.t TypenameHash.t
|
|
|
|
let pp fmt (tenv: t) =
|
|
TypenameHash.iter
|
|
(fun name typ ->
|
|
Format.fprintf fmt "@[<6>NAME: %s@." (Typ.Name.to_string name) ;
|
|
Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.Struct.pp Pp.text name) typ)
|
|
tenv
|
|
|
|
(** Create a new type environment. *)
|
|
let create () = TypenameHash.create 1000
|
|
|
|
(** Construct a struct type in a type environment *)
|
|
let mk_struct tenv ?default ?fields ?statics ?methods ?supers ?annots name =
|
|
let struct_typ =
|
|
Typ.Struct.internal_mk_struct ?default ?fields ?statics ?methods ?supers ?annots ()
|
|
in
|
|
TypenameHash.replace tenv name struct_typ ; struct_typ
|
|
|
|
(** Check if typename is found in tenv *)
|
|
let mem tenv name = TypenameHash.mem tenv name
|
|
|
|
(** Look up a name in the global type environment. *)
|
|
let lookup tenv name : Typ.Struct.t option =
|
|
try Some (TypenameHash.find tenv name)
|
|
with Not_found ->
|
|
(* ToDo: remove the following additional lookups once C/C++ interop is resolved *)
|
|
match (name : Typ.Name.t) with
|
|
| CStruct m -> (
|
|
try Some (TypenameHash.find tenv (CppClass (m, NoTemplate)))
|
|
with Not_found -> None )
|
|
| CppClass (m, NoTemplate) -> (
|
|
try Some (TypenameHash.find tenv (CStruct m))
|
|
with Not_found -> None )
|
|
| _
|
|
-> None
|
|
|
|
(** Add a (name,type) pair to the global type environment. *)
|
|
let add tenv name struct_typ = TypenameHash.replace tenv name struct_typ
|
|
|
|
(** Add a field to a given struct in the global type environment. *)
|
|
let add_field tenv class_tn_name field =
|
|
match lookup tenv class_tn_name with
|
|
| Some ({fields} as struct_typ)
|
|
-> let field_equal (f1, _, _) (f2, _, _) = Typ.Fieldname.equal f1 f2 in
|
|
if not (List.mem ~equal:field_equal fields field) then
|
|
let new_fields = field :: fields in
|
|
ignore (mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name)
|
|
| _
|
|
-> ()
|
|
|
|
(** Get method that is being overriden by java_pname (if any) **)
|
|
let get_overriden_method tenv pname_java =
|
|
let struct_typ_get_method_by_name (struct_typ: Typ.Struct.t) method_name =
|
|
List.find_exn
|
|
~f:(fun meth -> String.equal method_name (Typ.Procname.get_method meth))
|
|
struct_typ.methods
|
|
in
|
|
let rec get_overriden_method_in_supers pname_java supers =
|
|
match supers with
|
|
| superclass :: supers_tail -> (
|
|
match lookup tenv superclass with
|
|
| Some struct_typ -> (
|
|
try
|
|
Some (struct_typ_get_method_by_name struct_typ (Typ.Procname.java_get_method pname_java))
|
|
with Not_found ->
|
|
get_overriden_method_in_supers pname_java (supers_tail @ struct_typ.supers) )
|
|
| None
|
|
-> get_overriden_method_in_supers pname_java supers_tail )
|
|
| []
|
|
-> None
|
|
in
|
|
match lookup tenv (Typ.Procname.java_get_class_type_name pname_java) with
|
|
| Some {supers}
|
|
-> get_overriden_method_in_supers pname_java supers
|
|
| _
|
|
-> None
|
|
|
|
(** Serializer for type environments *)
|
|
let tenv_serializer : t Serialization.serializer =
|
|
Serialization.create_serializer Serialization.Key.tenv
|
|
|
|
let global_tenv : t option ref = ref None
|
|
|
|
(** Load a type environment from a file *)
|
|
let load_from_file (filename: DB.filename) : t option =
|
|
if DB.equal_filename filename DB.global_tenv_fname then (
|
|
if is_none !global_tenv then global_tenv
|
|
:= Serialization.read_from_file tenv_serializer DB.global_tenv_fname ;
|
|
!global_tenv )
|
|
else Serialization.read_from_file tenv_serializer filename
|
|
|
|
(** Save a type environment into a file *)
|
|
let store_to_file (filename: DB.filename) (tenv: t) =
|
|
(* update in-memory global tenv for later uses by this process, e.g. in single-core mode the
|
|
frontend and backend run in the same process *)
|
|
if DB.equal_filename filename DB.global_tenv_fname then global_tenv := Some tenv ;
|
|
Serialization.write_to_file tenv_serializer filename ~data:tenv ;
|
|
if Config.debug_mode then
|
|
let debug_filename = DB.filename_to_string (DB.filename_add_suffix filename ".debug") in
|
|
let out_channel = Out_channel.create debug_filename in
|
|
let fmt = Format.formatter_of_out_channel out_channel in
|
|
Format.fprintf fmt "%a" pp tenv ; Out_channel.close out_channel
|
|
|
|
let iter f tenv = TypenameHash.iter f tenv
|
|
|
|
let fold f tenv = TypenameHash.fold f tenv
|