hphp/hack/src/typing/typing_lenv.ml

   1 (*
   2  * Copyright (c) 2015, 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 module Env = Typing_env
  12 open Typing_env_types
  13 module C = Typing_continuations
  14 module LEnvC = Typing_per_cont_env
  15 module LEnvOps = Typing_per_cont_ops
  16 module Union = Typing_union
  17
  18 (*****************************************************************************)
  19 (* Module dealing with local environments. *)
  20 (*****************************************************************************)
  21
  22 let get_all_locals env = env.lenv.per_cont_env
  23
  24 (*****************************************************************************)
  25 (* Functions dealing with old style local environment *)
  26 (*****************************************************************************)
  27
  28 let union
  29     env
  30     ~join_pos
  31     Typing_local_types.
  32       {
  33         ty = ty1;
  34         defined = defined1;
  35         bound_ty = bound_ty1;
  36         pos = pos1;
  37         eid = eid1;
  38       }
  39     Typing_local_types.
  40       {
  41         ty = ty2;
  42         defined = defined2;
  43         bound_ty = bound_ty2;
  44         pos = pos2;
  45         eid = eid2;
  46       } =
  47   (* TODO(mjt) Use a more specific reason here provided as an argument *)
  48   let reason =
  49     if TypecheckerOptions.using_extended_reasons env.genv.tcopt then
  50       Some (Typing_reason.witness join_pos)
  51     else
  52       None
  53   in
  54   let (env, ty) = Union.union ?reason ~approx_cancel_neg:true env ty1 ty2 in
  55   let (env, bound_ty) =
  56     match (bound_ty1, bound_ty2) with
  57     | (None, None) -> (env, None)
  58     | (Some ty, None)
  59     | (None, Some ty) ->
  60       (env, Some ty)
  61     | (Some ty1, Some ty2) ->
  62       let (env, ty) =
  63         Typing_intersection.intersect
  64           ~r:(Typing_defs_core.get_reason ty1)
  65           env
  66           ty1
  67           ty2
  68       in
  69       (env, Some ty)
  70   in
  71   (* TODO(mjt) Determin if this need updating to if the change to reasons will
  72      be sufficient*)
  73   let pos =
  74     if phys_equal ty ty1 || Pos.equal Pos.none pos2 then
  75       pos1
  76     else if phys_equal ty ty2 || Pos.equal Pos.none pos1 then
  77       pos2
  78     else
  79       Pos.none
  80   in
  81   let eid =
  82     if Expression_id.equal eid1 eid2 then
  83       eid1
  84     else
  85       Env.make_expression_id env
  86   in
  87   match bound_ty with
  88   | None ->
  89     Typing_local_types.
  90       (env, { ty; defined = defined1 && defined2; bound_ty; pos; eid })
  91   | Some bound_ty ->
  92     let (env, err_opt) =
  93       Typing_subtype.sub_type
  94         env
  95         ty
  96         bound_ty
  97         (Some (Typing_error.Reasons_callback.unify_error_at join_pos))
  98     in
  99     let ty =
 100       match err_opt with
 101       | None -> ty
 102       | Some err ->
 103         Typing_error_utils.add_typing_error ~env err;
 104         (* If the new type or bound violates the old one, then we want to
 105            check the remainder of the code with the type of the variable
 106            set to the bound *)
 107         bound_ty
 108     in
 109     Typing_local_types.
 110       ( env,
 111         {
 112           ty;
 113           defined = defined1 && defined2;
 114           bound_ty = Some bound_ty;
 115           pos;
 116           eid;
 117         } )
 118
 119 let get_cont_option env cont =
 120   let local_types = get_all_locals env in
 121   LEnvC.get_cont_option cont local_types
 122
 123 let drop_cont env cont =
 124   let local_types = get_all_locals env in
 125   let local_types = LEnvC.drop_cont cont local_types in
 126   Env.env_with_locals env local_types
 127
 128 let drop_conts env conts =
 129   let local_types = get_all_locals env in
 130   let local_types = LEnvC.drop_conts conts local_types in
 131   Env.env_with_locals env local_types
 132
 133 let replace_cont env cont ctxopt =
 134   let local_types = get_all_locals env in
 135   let local_types = LEnvC.replace_cont cont ctxopt local_types in
 136   Env.env_with_locals env local_types
 137
 138 let restore_conts_from env fromlocals conts =
 139   let local_types = get_all_locals env in
 140   let local_types =
 141     LEnvOps.restore_conts_from local_types ~from:fromlocals conts
 142   in
 143   Env.env_with_locals env local_types
 144
 145 let restore_and_merge_conts_from env ~join_pos fromlocals conts =
 146   let local_types = get_all_locals env in
 147   let (env, local_types) =
 148     LEnvOps.restore_and_merge_conts_from
 149       env
 150       (union ~join_pos)
 151       local_types
 152       ~from:fromlocals
 153       conts
 154   in
 155   Env.env_with_locals env local_types
 156
 157 (* Merge all continuations in the provided list and update the 'next'
 158    * continuation with the result. *)
 159 let update_next_from_conts env ~join_pos cont_list =
 160   let local_types = get_all_locals env in
 161   let (env, local_types) =
 162     LEnvOps.update_next_from_conts env (union ~join_pos) local_types cont_list
 163   in
 164   Env.env_with_locals env local_types
 165
 166 (* After this call, the provided continuation will be the union of itself and
 167    * the next continuation *)
 168 let save_and_merge_next_in_cont env ~join_pos cont =
 169   let local_types = get_all_locals env in
 170   let (env, local_types) =
 171     LEnvOps.save_and_merge_next_in_cont env (union ~join_pos) local_types cont
 172   in
 173   Env.env_with_locals env local_types
 174
 175 let move_and_merge_next_in_cont env ~join_pos cont =
 176   let local_types = get_all_locals env in
 177   let (env, local_types) =
 178     LEnvOps.move_and_merge_next_in_cont env (union ~join_pos) local_types cont
 179   in
 180   Env.env_with_locals env local_types
 181
 182 let union_contextopts ~join_pos = LEnvOps.union_opts (union ~join_pos)
 183
 184 let union_by_cont env ~join_pos lenv1 lenv2 =
 185   let locals1 = lenv1.per_cont_env in
 186   let locals2 = lenv2.per_cont_env in
 187   let (env, locals) =
 188     LEnvOps.union_by_cont env (union ~join_pos) locals1 locals2
 189   in
 190   Env.env_with_locals env locals
 191
 192 let join_fake lenv1 lenv2 =
 193   let nextctxopt1 = LEnvC.get_cont_option C.Next lenv1.per_cont_env in
 194   let nextctxopt2 = LEnvC.get_cont_option C.Next lenv2.per_cont_env in
 195   match (nextctxopt1, nextctxopt2) with
 196   | (Some c1, Some c2) ->
 197     Typing_fake_members.join c1.LEnvC.fake_members c2.LEnvC.fake_members
 198   | (None, None) -> Typing_fake_members.empty
 199   | (Some c1, None) -> c1.LEnvC.fake_members
 200   | (None, Some c2) -> c2.LEnvC.fake_members
 201
 202 let union_lenvs_ env ~join_pos parent_lenv lenv1 lenv2 =
 203   let fake_members = join_fake lenv1 lenv2 in
 204   let local_using_vars = parent_lenv.local_using_vars in
 205   let env = union_by_cont env ~join_pos lenv1 lenv2 in
 206   let lenv = { env.lenv with local_using_vars } in
 207   let per_cont_env =
 208     LEnvC.update_cont_entry C.Next lenv.per_cont_env (fun entry ->
 209         LEnvC.{ entry with fake_members })
 210   in
 211   let lenv = { lenv with per_cont_env } in
 212   ({ env with lenv }, lenv)
 213
 214 (* Used when we want the new local environment to be the union
 215  * of 2 local environments. Typical use case is an if statement.
 216  * $x = 0;
 217  * if(...) { $x = ''; } else { $x = 'foo'; }
 218  * We want $x to be a string past this point.
 219  * We check that the locals are defined in both branches
 220  * when that is the case, their type becomes the union (least upper bound)
 221  * of the types it had in each branch.
 222  *)
 223 let union_lenvs env ~join_pos parent_lenv lenv1 lenv2 =
 224   fst @@ union_lenvs_ env ~join_pos parent_lenv lenv1 lenv2
 225
 226 let rec union_lenv_list env ~join_pos parent_lenv = function
 227   | []
 228   | [_] ->
 229     env
 230   | lenv1 :: lenv2 :: lenvlist ->
 231     let (env, lenv) = union_lenvs_ env ~join_pos parent_lenv lenv1 lenv2 in
 232     union_lenv_list env ~join_pos parent_lenv (lenv :: lenvlist)
 233
 234 let stash_and_do env conts f =
 235   let parent_locals = get_all_locals env in
 236   let env = drop_conts env conts in
 237   let (env, res) = f env in
 238   let env = restore_conts_from env parent_locals conts in
 239   (env, res)
 240
 241 let env_with_empty_fakes env =
 242   let per_cont_env =
 243     LEnvC.update_cont_entry C.Next env.lenv.per_cont_env (fun entry ->
 244         LEnvC.{ entry with fake_members = Typing_fake_members.empty })
 245   in
 246   { env with lenv = { env.lenv with per_cont_env } }
 247
 248 let has_next env =
 249   match get_cont_option env C.Next with
 250   | None -> false
 251   | Some _ -> true