hphp/hack/src/typing/deferred_decl.ml

   1 (*
   2  * Copyright (c) Facebook, Inc. and its affiliates.
   3  *
   4  * This source code is licensed under the MIT license found in the
   5  * LICENSE file in the "hack" directory of this source tree.
   6  *
   7  *)
   8
   9 open Hh_prelude
  10
  11 exception Defer of Relative_path.t
  12
  13 type deferment = Relative_path.t
  14
  15 type deferments_t = Relative_path.Set.t
  16
  17 type state = {
  18   enabled: bool;
  19   deferments: deferments_t;
  20   counter: int;
  21   threshold_opt: int option;
  22 }
  23
  24 let state : state ref =
  25   ref
  26     {
  27       enabled = true;
  28       deferments = Relative_path.Set.empty;
  29       counter = 0;
  30       threshold_opt = None;
  31     }
  32
  33 let reset ~(enable : bool) ~(threshold_opt : int option) : unit =
  34   state :=
  35     {
  36       enabled = enable;
  37       counter = 0;
  38       deferments = Relative_path.Set.empty;
  39       threshold_opt;
  40     }
  41
  42 let increment_counter () : unit =
  43   if !state.enabled then state := { !state with counter = !state.counter + 1 }
  44
  45 let raise_if_should_defer ~(d : Relative_path.t) : unit =
  46   match (!state.enabled, !state.threshold_opt) with
  47   | (true, Some threshold) when !state.counter >= threshold -> raise (Defer d)
  48   | _ -> ()
  49
  50 let add_deferment ~(d : deferment) : unit =
  51   state :=
  52     { !state with deferments = Relative_path.Set.add !state.deferments d }
  53
  54 let get_deferments ~(f : deferment -> 'a) : 'a list =
  55   !state.deferments |> Relative_path.Set.elements |> List.map ~f