(**
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)

module RequireMap = MyMap.Make (struct
  (* If file A.js imports module 'Foo', this will be ('Foo' * A.js) *)
  type t = string * File_key.t

  let compare (r1, f1) (r2, f2) =
    match String.compare r1 r2 with
    | 0 -> File_key.compare f1 f2
    | n -> n
end)

module FilenameMap = Utils_js.FilenameMap
module ALocSet = Utils_js.ALocSet

module Reqs = struct
  type impl = ALocSet.t
  type dep_impl = Context.sig_t * ALocSet.t
  type unchecked = ALocSet.t
  type res = ALocSet.t
  type decl = ALocSet.t * Modulename.t
  type t = {
    impls: impl RequireMap.t;
    dep_impls: dep_impl RequireMap.t;
    unchecked: unchecked RequireMap.t;
    res: res RequireMap.t;
    decls: decl RequireMap.t;
  }

  let empty = {
    impls = RequireMap.empty;
    dep_impls = RequireMap.empty;
    unchecked = RequireMap.empty;
    res = RequireMap.empty;
    decls = RequireMap.empty;
  }

  let add_impl require requirer require_locs reqs =
    let impls = RequireMap.add ~combine:ALocSet.union (require, requirer) require_locs reqs.impls in
    { reqs with impls }

  let add_dep_impl =
    let combine (from_cx, locs1) (_, locs2) = from_cx, ALocSet.union locs1 locs2 in
    fun require requirer (from_cx, require_locs) reqs ->
      let dep_impls =
        RequireMap.add ~combine (require, requirer) (from_cx, require_locs) reqs.dep_impls
      in
      { reqs with dep_impls }

  let add_unchecked require requirer require_locs reqs =
    let unchecked =
      RequireMap.add ~combine:ALocSet.union (require, requirer) require_locs reqs.unchecked
    in
    { reqs with unchecked }

  let add_res require requirer require_locs reqs =
    let res = RequireMap.add ~combine:ALocSet.union (require, requirer) require_locs reqs.res in
    { reqs with res }

  let add_decl =
    let combine (locs1, modulename) (locs2, _) = ALocSet.union locs1 locs2, modulename in
    fun require requirer (require_locs, modulename) reqs ->
    let decls = RequireMap.add ~combine (require, requirer) (require_locs, modulename) reqs.decls in
    { reqs with decls }
end

(* Connect the builtins object in master_cx to the builtins reference in some
   arbitrary cx. *)
let implicit_require_strict cx master_cx cx_to =
  let from_t = Context.find_module_sig master_cx Files.lib_module_ref in
  let to_t = Context.find_module cx_to Files.lib_module_ref in
  Flow_js.flow_t cx (from_t, to_t)

(* Connect the export of cx_from to its import in cx_to. This happens in some
   arbitrary cx, so cx_from and cx_to should have already been copied to cx. *)
let explicit_impl_require_strict cx (cx_from, m, loc, cx_to) =
  let from_t = Context.find_module_sig cx_from m in
  let to_t = Context.find_require cx_to loc in
  Flow_js.flow_t cx (from_t, to_t)

(* Create the export of a resource file on the fly and connect it to its import
   in cxs_to. This happens in some arbitrary cx, so cx_to should have already
   been copied to cx. *)
let explicit_res_require_strict cx (loc, f, cx_to) =
  (* Recall that a resource file is not parsed, so its export doesn't depend on
     its contents, just its extension. So, we create the export of a resource
     file on the fly by looking at its extension. The general alternative of
     writing / reading these exports to / from separate contexts that live in a
     shared heap takes more time / space (linear in the number of resource
     files), so we avoid it. This optimization is analogous to what we do for
     unchecked files: we create the export (`any`) on the fly instead of writing
     / reading it to / from the context of each unchecked file. *)
  let from_t = Import_export.mk_resource_module_t cx loc f in
  let to_t = Context.find_require cx_to loc in
  Flow_js.flow_t cx (from_t, to_t)

(* Connect a export of a declared module to its import in cxs_to. This happens
   in some arbitrary cx, so cx_to should have already been copied to cx. *)
let explicit_decl_require_strict cx (m, loc, resolved_m, cx_to) =
  let reason = Reason.(mk_reason (RCustom m) loc) in

  (* lookup module declaration from builtin context *)
  let m_name =
    resolved_m
    |> Modulename.to_string
    |> Reason.internal_module_name
  in
  let from_t = Tvar.mk cx reason in
  Flow_js.lookup_builtin cx m_name reason
    (Type.Strict reason) from_t;

  (* flow the declared module type to importing context *)
  let to_t = Context.find_require cx_to loc in
  Flow_js.flow_t cx (from_t, to_t)

(* Connect exports of an unchecked module to its import in cx_to. Note that we
   still lookup the module instead of returning `any` directly. This is because
   a resolved-unchecked dependency is superceded by a possibly-checked libdef.
   See unchecked_*_module_vs_lib tests for examples. *)
let explicit_unchecked_require_strict cx (m, loc, cx_to) =
  (* Use a special reason so we can tell the difference between an any-typed type import
   * from an untyped module and an any-typed type import from a nonexistent module. *)
  let reason = Reason.(mk_reason (RUntypedModule m) loc) in
  let m_name = Reason.internal_module_name m in
  let from_t = Tvar.mk cx reason in
  Flow_js.lookup_builtin cx m_name reason
    (Type.NonstrictReturning (Some (Type.DefT (reason,
       Type.AnyT Type.Untyped), from_t), None)) from_t;

  (* flow the declared module type to importing context *)
  let to_t = Context.find_require cx_to loc in
  Flow_js.flow_t cx (from_t, to_t)

let detect_sketchy_null_checks cx =
  let add_error ~loc ~null_loc kind falsy_loc =
    let msg = Flow_error.ESketchyNullLint { kind; loc; null_loc; falsy_loc } in
    Flow_error.error_of_msg ~trace_reasons:[] ~source_file:(Context.file cx) msg
    |> Context.add_error cx
  in

  let detect_function exists_excuses loc exists_check =
    let open ExistsCheck in

    let exists_excuse = Utils_js.ALocMap.get loc exists_excuses
      |> Option.value ~default:empty in

    begin match exists_check.null_loc with
      | None -> ()
      | Some null_loc ->
        let add_error = add_error ~loc ~null_loc in
        if (Option.is_none exists_excuse.bool_loc) then
          Option.iter exists_check.bool_loc ~f:(add_error Lints.SketchyNullBool);
        if (Option.is_none exists_excuse.number_loc) then
          Option.iter exists_check.number_loc ~f:(add_error Lints.SketchyNullNumber);
        if (Option.is_none exists_excuse.string_loc) then
          Option.iter exists_check.string_loc ~f:(add_error Lints.SketchyNullString);
        if (Option.is_none exists_excuse.mixed_loc) then
          Option.iter exists_check.mixed_loc ~f:(add_error Lints.SketchyNullMixed);
        ()
    end
  in

  Utils_js.ALocMap.iter (detect_function (Context.exists_excuses cx)) (Context.exists_checks cx)

let detect_test_prop_misses cx =
  let misses = Context.test_prop_get_never_hit cx in
  Core_list.iter ~f:(fun (name, reasons, use_op) ->
    Flow_js.add_output cx (Flow_error.EPropNotFound (name, reasons, use_op))
  ) misses

let detect_unnecessary_optional_chains cx =
  Core_list.iter ~f:(fun (loc, lhs_reason) ->
    Flow_js.add_output cx (Flow_error.EUnnecessaryOptionalChain (loc, lhs_reason))
  ) (Context.unnecessary_optional_chains cx)

let detect_unnecessary_invariants cx =
  Core_list.iter ~f:(fun (loc, reason) ->
    Flow_js.add_output cx (Flow_error.EUnnecessaryInvariant (loc, reason))
  ) (Context.unnecessary_invariants cx)

let check_type_visitor wrap =
  let open Ty in
  object(self)
  inherit [_] iter_ty as super

  method! private on_prop env = function
    | NamedProp (_, p) -> self#on_named_prop env p
    | IndexProp d -> self#on_dict env d
    | CallProp _ -> wrap (Reason.RCustom "object Call Property")
    | SpreadProp _ -> wrap (Reason.RCustom "object Spread Property")

  method! private on_named_prop env = function
    | Field (t, _) -> self#on_t env t
    | Method _ -> wrap (Reason.RMethod None)
    | Get _ | Set _ -> wrap (Reason.RGetterSetterProperty)

  method! on_t env = function
    | TVar _ -> wrap (Reason.RCustom "recursive type")
    | Fun _ -> wrap Reason.RFunctionType
    | Generic (_, _, Some _) -> wrap (Reason.RCustom "class with generics")
    | Mu _ -> wrap (Reason.RCustom "recursive type")
    | Any Implicit -> Reason.RAnyImplicit |> wrap
    | Any Explicit -> Reason.RAnyExplicit |> wrap
    | Bound (_, name) -> wrap (Reason.RCustom ("bound type var " ^ name))
    | Top -> wrap Reason.RMixed
    | Bot -> wrap Reason.REmpty
    | Module { Ty.name; _ } -> wrap (Reason.RModule name)
    | TypeAlias { ta_name = { Ty.name; _ }; _} ->
      wrap (Reason.RCustom ("type alias " ^ name))
    | (Obj _ | Arr _ | Tup _ | Union _ | Inter _) as t -> super#on_t env t
    | (Void|Null|Num _|Str _|Bool _|NumLit _|StrLit _|BoolLit _|TypeOf _|
      Generic _|ClassDecl _|InterfaceDecl _|Utility _) -> ()

  end

let detect_invalid_type_assert_calls ~full_cx file_sigs cxs =
  let options = {
    Ty_normalizer_env.
    fall_through_merged = false;
    expand_internal_types = false;
    expand_type_aliases = true;
    flag_shadowed_type_params = false;
    preserve_inferred_literal_types = false;
    optimize_types = true;
  } in
  let check_valid_call ~genv ~targs_map call_loc (_, targ_loc) =
    Option.iter (Hashtbl.find_opt targs_map targ_loc) ~f:(fun scheme ->
      let desc = Reason.RCustom "TypeAssert library function" in
      let reason_main = Reason.mk_reason desc call_loc in
      let wrap reason = Flow_js.add_output full_cx (Flow_error.EInvalidTypeArgs (
        reason_main, Reason.mk_reason reason call_loc
      )) in
      match Ty_normalizer.from_scheme ~options ~genv scheme with
      | Ok ty ->
        (check_type_visitor wrap)#on_t () ty
      | Error _ ->
        let { Type.TypeScheme.type_ = t; _ } = scheme in
        wrap (Type.desc_of_t t)
    )
  in
  Core_list.iter ~f:(fun cx ->
    let file = Context.file cx in
    let type_table = Context.type_table cx in
    let targs_map = Type_table.targs_hashtbl type_table in
    let file_sig = FilenameMap.find_unsafe file file_sigs in
    let genv = Ty_normalizer_env.mk_genv ~full_cx ~file ~type_table ~file_sig in
    Utils_js.ALocMap.iter (check_valid_call ~genv ~targs_map) (Context.type_asserts cx)
  ) cxs

let force_annotations leader_cx other_cxs =
  Core_list.iter ~f:(fun cx ->
    Context.module_ref cx
    |> Flow_js.lookup_module leader_cx
    |> Flow_js.enforce_strict leader_cx
  ) (leader_cx::other_cxs)

let apply_docblock_overrides (mtdt: Context.metadata) docblock_info =
  let open Context in

  let metadata =
    let jsx = match Docblock.jsx docblock_info with
    | Some (Docblock.Jsx_pragma (expr, jsx_expr)) ->
      let jsx_expr = Ast_loc_utils.abstractify_mapper#expression jsx_expr in
      Options.Jsx_pragma (expr, jsx_expr)
    | Some Docblock.Csx_pragma -> Options.Jsx_csx
    | None -> Options.Jsx_react
    in
    { mtdt with jsx }
  in

  let metadata = match Docblock.flow docblock_info with
  | None -> metadata
  | Some Docblock.OptIn -> { metadata with checked = true; }
  | Some Docblock.OptInStrict -> { metadata with checked = true; strict = true; }
  | Some Docblock.OptInStrictLocal -> { metadata with checked = true; strict_local = true; }
  | Some Docblock.OptInWeak -> { metadata with checked = true; weak = true }

  (* --all (which sets metadata.checked = true) overrides @noflow, so there are
     currently no scenarios where we'd change checked = true to false. in the
     future, there may be a case where checked defaults to true (but is not
     forced to be true ala --all), but for now we do *not* want to force
     checked = false here. *)
  | Some Docblock.OptOut -> metadata
  in

  let metadata = match Docblock.preventMunge docblock_info with
  | Some value -> { metadata with munge_underscores = not value; }
  | None -> metadata
  in

  metadata


(* Merge a component with its "implicit requires" and "explicit requires." The
   implicit requires are those defined in libraries. For the explicit
   requires, we need to merge only those parts of the dependency graph that the
   component immediately depends on. (We assume that this merging is part of a
   recursive process that has already handled recursive dependencies.)

   Now, by definition, files in a component can bidirectionally depend only on
   other files in the component. All other dependencies are unidirectional.

   Let dep_cxs contain the (optimized) contexts of all dependencies that are
   unidirectional, and let component_cxs contain the contexts of the files in
   the component. Let master_cx be the (optimized) context of libraries.

   Let implementations contain the dependency edges between contexts in
   component_cxs and dep_cxs, resources contain the dependency edges between
   contexts in component_cxs and resource files, and declarations contain the
   dependency edges from component_cxs to master_cx.

   We assume that the first context in component_cxs is that of the leader (cx):
   this serves as the "host" for the merging. Let the remaining contexts in
   component_cxs be other_cxs.

   1. Copy dep_cxs, other_cxs, and master_cx to the host cx.

   2. Link the edges in implementations.

   3. Link the edges in resources.

   4. Link the edges in declarations.

   5. Link the local references to libraries in master_cx and component_cxs.
*)
let merge_component_strict ~metadata ~lint_severities ~file_options ~strict_mode ~file_sigs
  ~get_ast_unsafe ~get_docblock_unsafe ?(do_gc=false)
  component reqs dep_cxs (master_cx: Context.sig_t) =

  let sig_cx = Context.make_sig () in
  let need_merge_master_cx = ref true in

  let init_gc_state = if do_gc then Some (Gc_js.init ~master_cx) else None in

  let rev_cxs, rev_tasts, impl_cxs, _ =
    Nel.fold_left (fun (cxs, tasts, impl_cxs, gc_state) filename ->

    (* create cx *)
    let info = get_docblock_unsafe filename in
    let metadata = apply_docblock_overrides metadata info in
    let module_ref = Files.module_ref filename in
    let cx = Context.make sig_cx metadata filename module_ref in

    (* create builtins *)
    if !need_merge_master_cx then (
      need_merge_master_cx := false;
      Flow_js.mk_builtins cx;
      Context.merge_into sig_cx master_cx;
      implicit_require_strict cx master_cx cx
    );

    (* local inference *)
    let ast = get_ast_unsafe filename in
    let lint_severities =
      if metadata.Context.strict || metadata.Context.strict_local
      then StrictModeSettings.fold
        (fun lint_kind lint_severities ->
          LintSettings.set_value lint_kind (Severity.Err, None) lint_severities
        ) strict_mode lint_severities
      else lint_severities in
    let file_sig = FilenameMap.find_unsafe filename file_sigs in
    let tast =
      Type_inference_js.infer_ast cx filename ast
        ~lint_severities ~file_options ~file_sig
    in

    let gc_state = Option.map gc_state Gc_js.(fun gc_state ->
      let gc_state = mark cx gc_state in
      sweep ~master_cx cx gc_state;
      gc_state
    ) in

    cx::cxs, tast::tasts, FilenameMap.add filename cx impl_cxs, gc_state
  ) ([], [], FilenameMap.empty, init_gc_state) component in
  let cxs = Core_list.rev rev_cxs in
  let tasts = Core_list.rev rev_tasts in

  let cx, other_cxs = Core_list.hd_exn cxs, Core_list.tl_exn cxs in

  Flow_js.Cache.clear();

  dep_cxs |> Core_list.iter ~f:(Context.merge_into sig_cx);

  let open Reqs in

  reqs.impls
  |> RequireMap.iter (fun (m, fn_to) locs ->
    let cx_to = FilenameMap.find_unsafe fn_to impl_cxs in
    ALocSet.iter (fun loc ->
      explicit_impl_require_strict cx (sig_cx, m, loc, cx_to);
    ) locs;
  );

  reqs.dep_impls
  |> RequireMap.iter (fun (m, fn_to) (cx_from, locs) ->
    let cx_to = FilenameMap.find_unsafe fn_to impl_cxs in
    ALocSet.iter (fun loc ->
      explicit_impl_require_strict cx (cx_from, m, loc, cx_to)
    ) locs
  );

  reqs.res
  |> RequireMap.iter (fun (f, fn_to) locs ->
    let cx_to = FilenameMap.find_unsafe fn_to impl_cxs in
    ALocSet.iter (fun loc ->
      explicit_res_require_strict cx (loc, f, cx_to)
    ) locs
  );

  reqs.decls
  |> RequireMap.iter (fun (m, fn_to) (locs, resolved_m) ->
    let cx_to = FilenameMap.find_unsafe fn_to impl_cxs in
    ALocSet.iter (fun loc ->
      explicit_decl_require_strict cx (m, loc, resolved_m, cx_to)
    ) locs
  );

  reqs.unchecked
  |> RequireMap.iter (fun (m, fn_to) locs ->
    let cx_to = FilenameMap.find_unsafe fn_to impl_cxs in
    ALocSet.iter (fun loc ->
      explicit_unchecked_require_strict cx (m, loc, cx_to)
    ) locs
  );

  (* Post-merge errors.
   *
   * At this point, all dependencies have been merged and the component has been
   * linked together. Any constraints should have already been evaluated, which
   * means we can complain about things that either haven't happened yet, or
   * which require complete knowledge of tvar bounds.
   *)
  detect_sketchy_null_checks cx;
  detect_test_prop_misses cx;
  detect_unnecessary_optional_chains cx;
  detect_unnecessary_invariants cx;
  detect_invalid_type_assert_calls ~full_cx:cx file_sigs cxs;

  force_annotations cx other_cxs;

  match Core_list.zip_exn cxs tasts with
  | [] -> failwith "there is at least one cx"
  | x::xs -> x, xs

let merge_tvar =
  let open Type in
  let possible_types = Flow_js.possible_types in
  let rec collect_lowers ~filter_empty cx seen acc = function
    | [] -> Core_list.rev acc
    | t::ts ->
      match t with
      (* Recursively unwrap unseen tvars *)
      | OpenT (_, id) ->
        if ISet.mem id seen
        then collect_lowers ~filter_empty cx seen acc ts (* already unwrapped *)
        else
          let seen = ISet.add id seen in
          collect_lowers ~filter_empty cx seen acc (possible_types cx id @ ts)
      (* Ignore empty in existentials. This behavior is sketchy, but the error
         behavior without this filtering is worse. If an existential accumulates
         an empty, we error but it's very non-obvious how the empty arose. *)
      | DefT (_, EmptyT) when filter_empty ->
        collect_lowers ~filter_empty cx seen acc ts
      (* Everything else becomes part of the merge typed *)
      | _ -> collect_lowers ~filter_empty cx seen (t::acc) ts
  in
  fun cx r id ->
    (* Because the behavior of existentials are so difficult to predict, they
       enjoy some special casing here. When existential types are finally
       removed, this logic can be removed. *)
    let existential =
      let open Reason in
      match desc_of_reason r with
      | RExistential -> true
      | _ -> false
    in
    let lowers =
      let seen = ISet.singleton id in
      collect_lowers cx seen [] (possible_types cx id)
        ~filter_empty:existential
    in
    match lowers with
      | [t] -> t
      | t0::t1::ts -> DefT (r, UnionT (UnionRep.make t0 t1 ts))
      | [] ->
        let uses = Flow_js.possible_uses cx id in
        if uses = [] || existential
          then AnyT.locationless Unsoundness.existential
          else MergedT (r, uses)

(****************** signature contexts *********************)

(* Once a context is merged with other contexts it depends on, it is ready to be
   optimized for use by contexts that in turn depend on it. The only interesting
   part of the context for such use is its exports. Thus, we call a context
   optimized for such use a "signature context."

   A signature context should contain only descriptions of its exports. Anything
   that does not contribute to those descriptions are redundant and should be
   discarded: otherwise, we would end up paying significant hidden costs, in
   terms of memory (storing in the heap) and time (serializing / deserializing
   from the heap, garbage collection pauses).

   As it turns out, it is not always possible or even desirable to describe the
   exports in "closed form" as types: instead, the descriptions take the form of
   a (mutually) recursive system of "equations" relating type variables to
   "solved" types, and the types themselves may contain these type variables
   inside. As indicated above, such descriptions are both necessary (due to
   recursive types) and desirable (due to sharing, and for cyclically depending
   contexts, due to the need to deal with the exports of all such contexts at
   once). This form is quite adequate for type checking (indeed, it can be
   thought of as merely a condensed form of usual contexts, which already
   exhibit this "interlinked" behavior).

   Unsurprisingly, since types also make references to some other maps in a
   context (property maps, envs), these references need to be carried around
   as well for the descriptions to be complete.

   We can collect compact and complete descriptions of exports by using a custom
   type visitor that marks relevant things that need to be carried over as it
   walks the context from its exports. Once the walk is done, we can replace the
   corresponding parts of the context (graph, property maps, envs) by their
   reduced forms.

   NOTE: Changing ids of entities stored in the Context is dangerous here,
   since it would require changing every occurence of that id. As such, the mapper
   currently only traverses ids for side-effects, but returns the original id.

   There are also several places where we add something to a map, recurse, then
   readd. The original add makes sure we don't visit the same entity twice, the
   second actually changes the entity in the exports.
*)
module ContextOptimizer = struct
  open Constraint
  open Type

  class context_optimizer = object(self)
    inherit [Polarity.t] Type_mapper.t_with_uses as super

    val sig_hash = Xx.init ()
    method sig_hash () = Xx.digest sig_hash

    val mutable next_stable_id = 0
    method fresh_stable_id =
      let stable_id = next_stable_id in
      next_stable_id <- next_stable_id + 1;
      stable_id

    val mutable stable_tvar_ids = IMap.empty
    val mutable stable_eval_ids = IMap.empty
    val mutable stable_poly_ids = IMap.empty
    val mutable reduced_module_map = SMap.empty;
    val mutable reduced_graph = IMap.empty;
    val mutable reduced_property_maps = Properties.Map.empty;
    val mutable reduced_call_props = IMap.empty;
    val mutable reduced_export_maps = Exports.Map.empty;
    val mutable reduced_evaluated = IMap.empty;

    method reduce cx module_ref =
      let export = Context.find_module cx module_ref in
      let export' = self#type_ cx Neutral export in
      reduced_module_map <- SMap.add module_ref export' reduced_module_map

    method tvar cx pole r id =
      let root_id, _ = Context.find_constraints cx id in
      if id == root_id then
        if IMap.mem id reduced_graph then
          let stable_id = IMap.find_unsafe root_id stable_tvar_ids in
          SigHash.add_int sig_hash stable_id;
          id
        else
          let t = merge_tvar cx r id in
          let node = Root { rank = 0; constraints = FullyResolved t } in
          reduced_graph <- IMap.add id node reduced_graph;
          let () =
            let stable_id = self#fresh_stable_id in
            stable_tvar_ids <- IMap.add id stable_id stable_tvar_ids
          in
          let t = (self#type_ cx pole t) in
          let node = Root { rank = 0; constraints = FullyResolved t } in
          reduced_graph <- IMap.add id node reduced_graph;
          id
      else (
        ignore (self#tvar cx pole r root_id);
        let node = Goto root_id in
        reduced_graph <- IMap.add id node reduced_graph;
        id
      )

    method props cx pole id =
      if (Properties.Map.mem id reduced_property_maps)
      then
        let () = SigHash.add_int sig_hash (id :> int) in
        id
      else
        let pmap = Context.find_props cx id in
        let () = SigHash.add_props_map sig_hash pmap in
        reduced_property_maps <- Properties.Map.add id pmap reduced_property_maps;
        let pmap' = SMap.ident_map (self#prop cx pole) pmap in
        reduced_property_maps <- Properties.Map.add id pmap' reduced_property_maps;
        id

    method call_prop cx pole id =
      if (IMap.mem id reduced_call_props)
      then
        let () = SigHash.add_int sig_hash id in
        id
      else
        let t = Context.find_call cx id in
        reduced_call_props <- IMap.add id t reduced_call_props;
        let t' = self#type_ cx pole t in
        reduced_call_props <- IMap.add id t' reduced_call_props;
        id

    method exports cx pole id =
      if (Exports.Map.mem id reduced_export_maps) then id
      else
        let tmap = Context.find_exports cx id in
        let map_pair (loc, t) = (loc, self#type_ cx pole t) in
        reduced_export_maps <- Exports.Map.add id tmap reduced_export_maps;
        let tmap' = SMap.ident_map map_pair tmap in
        reduced_export_maps <- Exports.Map.add id tmap' reduced_export_maps;
        SigHash.add_exports_map sig_hash tmap';
        id

    method eval_id cx pole id =
      if IMap.mem id reduced_evaluated
      then
        let stable_id = IMap.find_unsafe id stable_eval_ids in
        SigHash.add_int sig_hash stable_id;
        id
      else
        let stable_id = self#fresh_stable_id in
        stable_eval_ids <- IMap.add id stable_id stable_eval_ids;
        match IMap.get id (Context.evaluated cx) with
        | None -> id
        | Some t ->
          reduced_evaluated <- IMap.add id t reduced_evaluated;
          let t' = self#type_ cx pole t in
          reduced_evaluated <- IMap.add id t' reduced_evaluated;
          id

    method! dict_type cx pole dicttype =
      let dicttype' = super#dict_type cx pole dicttype in
      SigHash.add_polarity sig_hash dicttype'.dict_polarity;
      dicttype'

    method! type_ cx pole t =
      SigHash.add_reason sig_hash (reason_of_t t);
      match t with
      | InternalT _ -> Utils_js.assert_false "internal types should not appear in signatures"
      | OpenT _ -> super#type_ cx pole t
      | DefT (_, InstanceT (_, _, _, { class_id; _ })) ->
        let id = class_id in
        SigHash.add_aloc sig_hash id;
        super#type_ cx pole t
      | OpaqueT (_, { opaque_id; _ }) ->
        let id = opaque_id in
        SigHash.add_aloc sig_hash id;
        super#type_ cx pole t
      | DefT (_, PolyT (_, _, _, poly_id)) ->
        let id =
          if Context.mem_nominal_id cx poly_id
          then match IMap.get poly_id stable_poly_ids with
          | None ->
            let id = self#fresh_stable_id in
            stable_poly_ids <- IMap.add poly_id id stable_poly_ids;
            id
          | Some id -> id
          else poly_id
        in
        SigHash.add_int sig_hash id;
        super#type_ cx pole t
      | _ ->
        let t' = super#type_ cx pole t in
        SigHash.add_type sig_hash t';
        t'

    method! use_type cx pole use =
      SigHash.add_reason sig_hash (reason_of_use_t use);
      match use with
      | UseT (u, t) ->
          let t' = self#type_ cx Neutral t in
          if t' == t then use
          else UseT (u, t')
      | _ ->
        SigHash.add_use sig_hash use;
        super#use_type cx pole use

    method! choice_use_tool cx pole t =
      match t with
      | FullyResolveType id ->
          ignore @@ self#type_graph cx pole ISet.empty id;
          t
      | _ -> super#choice_use_tool cx pole t

    method private type_graph cx pole seen id =
      let open Graph_explorer in
      let seen' = ISet.add id seen in
      if seen' == seen then (seen, id) else
      let graph = Context.type_graph cx in
      ignore @@ self#eval_id cx pole id;
      let seen' = match IMap.get id graph.explored_nodes with
      | None -> seen'
      | Some {deps} ->
        ISet.fold (fun id seen -> fst @@ self#type_graph cx pole seen id) deps seen'
      in
      let seen' =
        match IMap.get id graph.unexplored_nodes with
        | None -> seen'
        | Some {rev_deps} ->
          ISet.fold (fun id seen -> fst @@ self#type_graph cx pole seen id) rev_deps seen'
      in
      (seen', id)

    method get_stable_tvar_ids = stable_tvar_ids
    method get_stable_eval_ids = stable_eval_ids
    method get_stable_poly_ids = stable_poly_ids
    method get_reduced_module_map = reduced_module_map
    method get_reduced_graph = reduced_graph
    method get_reduced_property_maps = reduced_property_maps
    method get_reduced_call_props = reduced_call_props
    method get_reduced_export_maps = reduced_export_maps
    method get_reduced_evaluated = reduced_evaluated
  end

  (* walk a context from a list of exports *)
  let reduce_context cx module_refs =
    let reducer = new context_optimizer in
    Core_list.iter ~f:(reducer#reduce cx) module_refs;
    reducer#sig_hash (), reducer

  (* reduce a context to a "signature context" *)
  let sig_context cx module_refs =
    let sig_hash, reducer = reduce_context cx module_refs in
    Context.set_module_map cx reducer#get_reduced_module_map;
    Context.set_graph cx reducer#get_reduced_graph;
    Context.set_property_maps cx reducer#get_reduced_property_maps;
    Context.set_call_props cx reducer#get_reduced_call_props;
    Context.set_export_maps cx reducer#get_reduced_export_maps;
    Context.set_evaluated cx reducer#get_reduced_evaluated;
    Context.set_type_graph cx (
      Graph_explorer.new_graph
        (IMap.fold (fun k _ -> ISet.add k) reducer#get_reduced_graph ISet.empty)
    );
    sig_hash

end
