hphp/hack/src/providers/provider_backend.ml

   1 (*
   2  * Copyright (c) 2019, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Hh_prelude
  11
  12 module Decl_cache_entry = struct
  13   (* NOTE: we can't simply use a string as a key. In the case of a name
  14   conflict, we may put e.g. a function named 'foo' into the cache whose value is
  15   one type, and then later try to withdraw a class named 'foo' whose value is
  16   another type.
  17
  18   The actual value type for [Class_decl] is a [Typing_classes_heap.Classes.t],
  19   but that module depends on this module, so we can't write it down or else we
  20   will cause a circular dependency. (It could probably be refactored to break
  21   the dependency.) We just use [Obj.t] instead, which is better than using
  22   [Obj.t] for all of the cases here.
  23   *)
  24   type _ t =
  25     | Fun_decl : string -> Typing_defs.fun_elt t
  26     | Class_decl : string -> Obj.t t
  27     | Record_decl : string -> Typing_defs.record_def_type t
  28     | Typedef_decl : string -> Typing_defs.typedef_type t
  29     | Gconst_decl : string -> Typing_defs.decl_ty t
  30
  31   type 'a key = 'a t
  32
  33   type 'a value = 'a
  34
  35   let get_size ~key:_ ~value:_ = 1
  36
  37   let key_to_log_string : type a. a key -> string =
  38    fun key ->
  39     match key with
  40     | Fun_decl s -> "FunDecl" ^ s
  41     | Class_decl s -> "ClassDecl" ^ s
  42     | Record_decl s -> "RecordDecl" ^ s
  43     | Typedef_decl s -> "TypedefDecl" ^ s
  44     | Gconst_decl s -> "GconstDecl" ^ s
  45 end
  46
  47 module Decl_cache = Lru_cache.Cache (Decl_cache_entry)
  48
  49 module Shallow_decl_cache_entry = struct
  50   type _ t = Shallow_class_decl : string -> Shallow_decl_defs.shallow_class t
  51
  52   type 'a key = 'a t
  53
  54   type 'a value = 'a
  55
  56   let get_size ~key:_ ~value =
  57     let words = Obj.reachable_words (Obj.repr value) in
  58     let bytes = words * Sys.word_size / 8 in
  59     bytes
  60
  61   let key_to_log_string : type a. a key -> string =
  62    (fun (Shallow_class_decl key) -> "ClasssShallow" ^ key)
  63 end
  64
  65 module Shallow_decl_cache = Lru_cache.Cache (Shallow_decl_cache_entry)
  66
  67 module Linearization_cache_entry = struct
  68   type _ t =
  69     | Member_resolution_linearization : string -> Decl_defs.mro_element list t
  70     | Ancestor_types_linearization : string -> Decl_defs.mro_element list t
  71
  72   type 'a key = 'a t
  73
  74   type 'a value = 'a
  75
  76   let get_size ~key:_ ~value:_ = 1
  77
  78   let key_to_log_string : type a. a key -> string =
  79    fun key ->
  80     match key with
  81     | Member_resolution_linearization c -> "MemberResolution" ^ c
  82     | Ancestor_types_linearization c -> "AncestorTypes" ^ c
  83 end
  84
  85 module Linearization_cache = Lru_cache.Cache (Linearization_cache_entry)
  86
  87 type fixme_map = Pos.t IMap.t IMap.t [@@deriving show]
  88
  89 module Fixme_store = struct
  90   type t = fixme_map Relative_path.Map.t ref
  91
  92   let empty = ref Relative_path.Map.empty
  93
  94   let get t filename = Relative_path.Map.find_opt !t filename
  95
  96   let add t filename fixmes = t := Relative_path.Map.add !t filename fixmes
  97
  98   let remove t filename = t := Relative_path.Map.remove !t filename
  99
 100   let remove_batch t filenames =
 101     t :=
 102       Relative_path.Set.fold filenames ~init:!t ~f:(fun filename map ->
 103           Relative_path.Map.remove map filename)
 104 end
 105
 106 module Fixmes = struct
 107   type t = {
 108     hh_fixmes: Fixme_store.t;
 109     decl_hh_fixmes: Fixme_store.t;
 110     disallowed_fixmes: Fixme_store.t;
 111   }
 112
 113   let get_telemetry ~(key : string) (t : t) (telemetry : Telemetry.t) :
 114       Telemetry.t =
 115     let hh_fixme_files = Relative_path.Map.cardinal !(t.hh_fixmes) in
 116     let decl_hh_fixme_files = Relative_path.Map.cardinal !(t.decl_hh_fixmes) in
 117     let disallowed_fixme_files =
 118       Relative_path.Map.cardinal !(t.disallowed_fixmes)
 119     in
 120     if hh_fixme_files + decl_hh_fixme_files + disallowed_fixme_files = 0 then
 121       telemetry
 122     else
 123       let sub_telemetry =
 124         Telemetry.create ()
 125         |> Telemetry.int_ ~key:"hh_fixme_files" ~value:hh_fixme_files
 126         |> Telemetry.int_ ~key:"decl_hh_fixme_files" ~value:decl_hh_fixme_files
 127         |> Telemetry.int_
 128              ~key:"disallowed_fixme_files"
 129              ~value:disallowed_fixme_files
 130       in
 131       Telemetry.object_ telemetry ~key ~value:sub_telemetry
 132 end
 133
 134 let empty_fixmes =
 135   Fixmes.
 136     {
 137       hh_fixmes = Fixme_store.empty;
 138       decl_hh_fixmes = Fixme_store.empty;
 139       disallowed_fixmes = Fixme_store.empty;
 140     }
 141
 142 module Reverse_naming_table_delta = struct
 143   type pos = FileInfo.name_type * Relative_path.t
 144
 145   type pos_or_deleted =
 146     | Pos of pos * pos list
 147     | Deleted
 148
 149   type t = {
 150     consts: pos_or_deleted SMap.t ref;
 151     funs: pos_or_deleted SMap.t ref;
 152     types: pos_or_deleted SMap.t ref;
 153     funs_canon_key: pos_or_deleted SMap.t ref;
 154     types_canon_key: pos_or_deleted SMap.t ref;
 155   }
 156
 157   let make () : t =
 158     {
 159       consts = ref SMap.empty;
 160       funs = ref SMap.empty;
 161       types = ref SMap.empty;
 162       funs_canon_key = ref SMap.empty;
 163       types_canon_key = ref SMap.empty;
 164     }
 165
 166   let get_telemetry ~(key : string) (t : t) (telemetry : Telemetry.t) :
 167       Telemetry.t =
 168     let consts = SMap.cardinal !(t.consts) in
 169     let funs = SMap.cardinal !(t.funs) in
 170     let types = SMap.cardinal !(t.types) in
 171     if consts + funs + types = 0 then
 172       telemetry
 173     else
 174       let sub_telemetry =
 175         Telemetry.create ()
 176         |> Telemetry.int_ ~key:"consts" ~value:consts
 177         |> Telemetry.int_ ~key:"funs" ~value:funs
 178         |> Telemetry.int_ ~key:"types" ~value:types
 179       in
 180       Telemetry.object_ telemetry ~key ~value:sub_telemetry
 181 end
 182
 183 type local_memory = {
 184   decl_cache: Decl_cache.t;
 185   shallow_decl_cache: Shallow_decl_cache.t;
 186   linearization_cache: Linearization_cache.t;
 187   reverse_naming_table_delta: Reverse_naming_table_delta.t;
 188   fixmes: Fixmes.t;
 189   naming_db_path_ref: Naming_sqlite.db_path option ref;
 190 }
 191
 192 type t =
 193   | Shared_memory
 194   | Local_memory of local_memory
 195   | Decl_service of {
 196       decl: Decl_service_client.t;
 197       fixmes: Fixmes.t;
 198     }
 199
 200 let t_to_string (t : t) : string =
 201   match t with
 202   | Shared_memory -> "Shared_memory"
 203   | Local_memory _ -> "Local_memory"
 204   | Decl_service _ -> "Decl_service"
 205
 206 let backend_ref = ref Shared_memory
 207
 208 let set_shared_memory_backend () : unit = backend_ref := Shared_memory
 209
 210 let set_local_memory_backend
 211     ~(max_num_decls : int)
 212     ~(max_bytes_shallow_decls : int)
 213     ~(max_num_linearizations : int) : unit =
 214   backend_ref :=
 215     Local_memory
 216       {
 217         decl_cache = Decl_cache.make ~max_size:max_num_decls;
 218         shallow_decl_cache =
 219           Shallow_decl_cache.make ~max_size:max_bytes_shallow_decls;
 220         linearization_cache =
 221           Linearization_cache.make ~max_size:max_num_linearizations;
 222         reverse_naming_table_delta = Reverse_naming_table_delta.make ();
 223         fixmes = empty_fixmes;
 224         naming_db_path_ref = ref None;
 225       }
 226
 227 let set_local_memory_backend_with_defaults () : unit =
 228   (* Shallow decls: some files read ~5k shallow decls, at about 16k / shallow dec,
 229   fitting into 73Mb. Hence we guess at 140Mb. *)
 230   let max_bytes_shallow_decls = 140 * 1024 * 1024 in
 231   (* Linearizations: such files will pick up ~6k linearizations. *)
 232   let max_num_linearizations = 10000 in
 233   (* TODO: justify max_num_decls *)
 234   let max_num_decls = 5000 in
 235   set_local_memory_backend
 236     ~max_num_decls
 237     ~max_bytes_shallow_decls
 238     ~max_num_linearizations
 239
 240 let set_decl_service_backend (decl : Decl_service_client.t) : unit =
 241   backend_ref := Decl_service { decl; fixmes = empty_fixmes }
 242
 243 let get () : t = !backend_ref