hphp/hack/src/typing/typing_tyvar_occurrences.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 Common
  10
  11 type t = {
  12   tyvar_occurrences: ISet.t IMap.t;
  13       (** A map to track where each type variable occurs,
  14           more precisely in the type of which other type variables.
  15           E.g. if #1 is bound to (#2 | int), then this map contains the entry
  16             #2 -> { #1 }
  17           This is based on shallow binding, i.e. in the example above, if #2
  18           is mapped to #3, then tyvar_occurrences would be:
  19             #2 -> { #1 }
  20             #3 -> { #2 }
  21           but we would not record that #3 occurs in #1.
  22           When a type variable v gets solved or the type bound to it gets simplified,
  23           we simplify the unions and intersections of the types bound to the
  24           type variables associated to v in this map.
  25           So in our example, if #2 gets solved to int,
  26           we simplify #1 to (int | int) = int.
  27           There are only entries for variables that are unsolved or contain
  28           other unsolved type variables. Variables that are solved and contain
  29           no other unsolved type variables get removed from this map. *)
  30   tyvars_in_tyvar: ISet.t IMap.t;
  31       (** Mapping of type variables to the type variables contained in their
  32           types which are either unsolved or themselves contain unsolved type
  33           variables.
  34           This is the dual of tyvar_occurrences. *)
  35 }
  36
  37 module Log = struct
  38   open Typing_log_value
  39
  40   let iset_imap_as_value map =
  41     Map
  42       (IMap.fold
  43          (fun i vars m -> SMap.add (var_as_string i) (varset_as_value vars) m)
  44          map
  45          SMap.empty)
  46
  47   let tyvar_occurrences_as_value = iset_imap_as_value
  48
  49   let tyvars_in_tyvar_as_value = iset_imap_as_value
  50
  51   let as_value x =
  52     let { tyvar_occurrences; tyvars_in_tyvar } = x in
  53     make_map
  54       [
  55         ("tyvar_occurrences", tyvar_occurrences_as_value tyvar_occurrences);
  56         ("tyvars_in_tyvar", tyvars_in_tyvar_as_value tyvars_in_tyvar);
  57       ]
  58 end
  59
  60 let init = { tyvar_occurrences = IMap.empty; tyvars_in_tyvar = IMap.empty }
  61
  62 let get_tyvar_occurrences x v =
  63   Option.value (IMap.find_opt v x.tyvar_occurrences) ~default:ISet.empty
  64
  65 let get_tyvars_in_tyvar x v =
  66   Option.value (IMap.find_opt v x.tyvars_in_tyvar) ~default:ISet.empty
  67
  68 let set_tyvar_occurrences x v vars =
  69   { x with tyvar_occurrences = IMap.add v vars x.tyvar_occurrences }
  70
  71 (** Make v occur in v', i.e. add v' to the occurrences of v. *)
  72 let add_tyvar_occurrence x v ~occurs_in:v' =
  73   let vars = get_tyvar_occurrences x v in
  74   let vars = ISet.add v' vars in
  75   let x = set_tyvar_occurrences x v vars in
  76   x
  77
  78 let add_tyvar_occurrences x vars ~occur_in:v =
  79   ISet.fold (fun v' x -> add_tyvar_occurrence x v' ~occurs_in:v) vars x
  80
  81 let set_tyvars_in_tyvar x v vars =
  82   { x with tyvars_in_tyvar = IMap.add v vars x.tyvars_in_tyvar }
  83
  84 let make_tyvars_occur_in_tyvar x vars ~occur_in:v =
  85   let x = add_tyvar_occurrences x vars ~occur_in:v in
  86   let x = set_tyvars_in_tyvar x v vars in
  87   x
  88
  89 let remove_tyvar_occurrence x v ~no_more_occurs_in:v' =
  90   let vars = get_tyvar_occurrences x v in
  91   let vars = ISet.remove v' vars in
  92   let x = set_tyvar_occurrences x v vars in
  93   x
  94
  95 let remove_tyvar_from_tyvar x ~from:v v' =
  96   let vars = get_tyvars_in_tyvar x v in
  97   let vars = ISet.remove v' vars in
  98   let x = set_tyvars_in_tyvar x v vars in
  99   x
 100
 101 let make_tyvar_no_more_occur_in_tyvar x v ~no_more_in:v' =
 102   let x = remove_tyvar_occurrence x v ~no_more_occurs_in:v' in
 103   let x = remove_tyvar_from_tyvar x ~from:v' v in
 104   x
 105
 106 let contains_unsolved_tyvars x v =
 107   not @@ ISet.is_empty (get_tyvars_in_tyvar x v)
 108
 109 (** Update the tyvar occurrences after unbinding a type variable. *)
 110 let unbind_tyvar x v =
 111   let vars_in_v = get_tyvars_in_tyvar x v in
 112   (* update tyvar_occurrences. *)
 113   let x =
 114     ISet.fold
 115       (fun v' x -> remove_tyvar_occurrence x v' ~no_more_occurs_in:v)
 116       vars_in_v
 117       x
 118   in
 119   (* update tyvars_in_tyvar *)
 120   let x = set_tyvars_in_tyvar x v ISet.empty in
 121   x
 122
 123 let occurs_in x occuring_tv ~in_:containing_tv =
 124   let occurs = ISet.mem containing_tv (get_tyvar_occurrences x occuring_tv) in
 125   let contains = ISet.mem occuring_tv (get_tyvars_in_tyvar x containing_tv) in
 126   assert (occurs = contains);
 127   occurs
 128
 129 let remove_var x v =
 130   let occurrences = get_tyvar_occurrences x v in
 131   let x =
 132     ISet.fold
 133       (fun occ x -> make_tyvar_no_more_occur_in_tyvar x v ~no_more_in:occ)
 134       occurrences
 135       x
 136   in
 137   let x = { x with tyvar_occurrences = IMap.remove v x.tyvar_occurrences } in
 138   let vars_in_v = get_tyvars_in_tyvar x v in
 139   let x =
 140     ISet.fold
 141       (fun var_in_v x ->
 142         make_tyvar_no_more_occur_in_tyvar x var_in_v ~no_more_in:v)
 143       vars_in_v
 144       x
 145   in
 146   let x = { x with tyvars_in_tyvar = IMap.remove v x.tyvars_in_tyvar } in
 147   x