fixing erroneous comment
[hiphop-php.git] / hphp / hack / src / typing / typing_env.ml
blob8b9a6f364dc2df1c773400c7b80100031bfcd628
1 (*
2 * Copyright (c) 2015, Facebook, Inc.
3 * All rights reserved.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
8 *)
10 open Core_kernel
11 open Common
12 open Typing_env_types
13 open Decl_env
14 open Typing_defs
15 open Aast
16 open Typing_env_return_info
17 module Dep = Typing_deps.Dep
18 module LID = Local_id
19 module SG = SN.Superglobals
20 module LEnvC = Typing_per_cont_env
21 module C = Typing_continuations
22 module TL = Typing_logic
23 module Cls = Decl_provider.Class
24 module Fake = Typing_fake_members
25 module ITySet = Internal_type_set
26 module TPEnv = Type_parameter_env
27 module TySet = Typing_set
29 let show_env _ = "<env>"
31 let pp_env _ _ = Printf.printf "%s\n" "<env>"
33 let get_tcopt env = env.genv.tcopt
35 let set_log_level env key log_level =
36 { env with log_levels = SMap.add key log_level env.log_levels }
38 let get_log_level env key =
39 Option.value (SMap.get key env.log_levels) ~default:0
41 let env_log_function = ref (fun _pos _name _old_env _new_env -> ())
43 let set_env_log_function f = env_log_function := f
45 let log_env_change name ?(level = 1) old_env new_env =
46 ( if get_log_level new_env name >= 1 || get_log_level new_env "env" >= level
47 then
48 let pos =
49 match old_env.tyvars_stack with
50 | (p, _) :: _ -> p
51 | _ -> old_env.function_pos
53 !env_log_function pos name old_env new_env );
54 new_env
56 let add_subst env x x' =
57 if x <> x' then
58 { env with subst = IMap.add x x' env.subst }
59 else
60 env
62 (* Apply variable-to-variable substitution from environment. Update environment
63 if we ended up iterating (cf path compression in union-find) *)
64 let rec get_var env x =
65 let x' = IMap.get x env.subst in
66 match x' with
67 | None -> (env, x)
68 | Some x' ->
69 let (env, x') = get_var env x' in
70 let env = add_subst env x x' in
71 (env, x')
73 (* This is basically union from union-find, but without balancing
74 * (linking the smaller tree to the larger tree). In practice this
75 * isn't important: path compression is much more significant. *)
76 let rename env x x' =
77 let (env, x) = get_var env x in
78 let (env, x') = get_var env x' in
79 let env = add_subst env x x' in
80 env
82 let add env x ty =
83 let (env, x) = get_var env x in
84 match ty with
85 | (_, Tvar x') -> add_subst env x x'
86 | _ -> { env with tenv = IMap.add x ty env.tenv }
88 let empty_bounds = TySet.empty
90 let env_with_tvenv env tvenv = { env with tvenv }
92 let env_with_global_tvenv env global_tvenv = { env with global_tvenv }
94 let empty_tyvar_info =
96 tyvar_pos = Pos.none;
97 eager_solve_fail = false;
98 lower_bounds = ITySet.empty;
99 upper_bounds = ITySet.empty;
100 appears_covariantly = false;
101 appears_contravariantly = false;
102 type_constants = SMap.empty;
105 let create_tyvar_info ?variance pos =
106 let tyvar_info =
107 match variance with
108 | Some Ast_defs.Invariant ->
110 empty_tyvar_info with
111 appears_covariantly = true;
112 appears_contravariantly = true;
114 | Some Ast_defs.Covariant ->
115 { empty_tyvar_info with appears_covariantly = true }
116 | Some Ast_defs.Contravariant ->
117 { empty_tyvar_info with appears_contravariantly = true }
118 | None -> empty_tyvar_info
120 { tyvar_info with tyvar_pos = pos }
122 let add_current_tyvar ?variance env p v =
123 match env.tyvars_stack with
124 | (expr_pos, tyvars) :: rest ->
125 let tyvar_info = create_tyvar_info ?variance p in
126 let env =
127 env_with_tvenv
129 (IMap.add v (LocalTyvar { tyvar_info with tyvar_pos = p }) env.tvenv)
131 { env with tyvars_stack = (expr_pos, v :: tyvars) :: rest }
132 | _ -> env
134 let fresh_type_reason ?variance env r =
135 let v = Ident.tmp () in
136 let env =
137 log_env_change "fresh_type" env
138 @@ add_current_tyvar ?variance env (Reason.to_pos r) v
140 (env, (r, Tvar v))
142 let fresh_type env p = fresh_type_reason env (Reason.Rtype_variable p)
144 let open_tyvars env p = { env with tyvars_stack = (p, []) :: env.tyvars_stack }
146 let close_tyvars env =
147 match env.tyvars_stack with
148 | [] -> failwith "close_tyvars: empty stack"
149 | _ :: rest -> { env with tyvars_stack = rest }
151 let get_current_tyvars env =
152 match env.tyvars_stack with
153 | [] -> []
154 | (_, tyvars) :: _ -> tyvars
156 let get_type env x_reason x =
157 let (env, x) = get_var env x in
158 let ty = IMap.get x env.tenv in
159 match ty with
160 | None -> (env, (x_reason, Tvar x))
161 | Some ty -> (env, ty)
163 let get_tyvar_info_opt env var =
164 let tyvaropt = IMap.get var env.tvenv in
165 match tyvaropt with
166 | None -> None
167 | Some GlobalTyvar -> IMap.get var env.global_tvenv
168 | Some (LocalTyvar tyvar) -> Some tyvar
170 let get_tyvar_info env var =
171 Option.value (get_tyvar_info_opt env var) ~default:empty_tyvar_info
173 let is_global_tyvar env var = IMap.get var env.tvenv = Some GlobalTyvar
175 let update_tyvar_info env var tyvar_info =
176 if IMap.get var env.tvenv = Some GlobalTyvar then
177 let env = env_with_tvenv env (IMap.add var GlobalTyvar env.tvenv) in
178 env_with_global_tvenv env (IMap.add var tyvar_info env.global_tvenv)
179 else
180 env_with_tvenv env (IMap.add var (LocalTyvar tyvar_info) env.tvenv)
182 let create_global_tyvar ?variance env var pos =
183 let tyvar_info = create_tyvar_info ?variance pos in
184 let env = env_with_tvenv env (IMap.add var GlobalTyvar env.tvenv) in
185 if not @@ IMap.mem var env.global_tvenv then
186 update_tyvar_info env var tyvar_info
187 else
190 let get_tyvar_eager_solve_fail env var =
191 let tvinfo = get_tyvar_info env var in
192 tvinfo.eager_solve_fail
194 let expand_var env r v =
195 let (env, ty) = get_type env r v in
196 if get_tyvar_eager_solve_fail env v then
197 (env, (Reason.Rsolve_fail (Reason.to_pos r), snd ty))
198 else
199 (env, ty)
201 let expand_type env x =
202 match x with
203 | (r, Tvar x) -> expand_var env r x
204 | x -> (env, x)
206 let expand_internal_type env ty =
207 match ty with
208 | ConstraintType _ -> (env, ty)
209 | LoclType ty ->
210 let (env, ty) = expand_type env ty in
211 (env, LoclType ty)
213 let get_shape_field_name = function
214 | Ast_defs.SFlit_int (_, s)
215 | Ast_defs.SFlit_str (_, s) ->
217 | Ast_defs.SFclass_const ((_, s1), (_, s2)) -> s1 ^ "::" ^ s2
219 let get_shape_field_name_pos = function
220 | Ast_defs.SFlit_int (p, _)
221 | Ast_defs.SFlit_str (p, _)
222 | Ast_defs.SFclass_const ((p, _), _) ->
225 let next_cont_opt env = LEnvC.get_cont_option C.Next env.lenv.per_cont_env
227 let all_continuations env = LEnvC.all_continuations env.lenv.per_cont_env
229 let get_tpenv env =
230 match next_cont_opt env with
231 | None -> TPEnv.empty
232 | Some entry -> entry.Typing_per_cont_env.tpenv
234 let get_lower_bounds env name =
235 let tpenv = get_tpenv env in
236 let local = TPEnv.get_lower_bounds tpenv name in
237 let global = TPEnv.get_lower_bounds env.global_tpenv name in
238 TySet.union local global
240 let get_upper_bounds env name =
241 let tpenv = get_tpenv env in
242 let local = TPEnv.get_upper_bounds tpenv name in
243 let global = TPEnv.get_upper_bounds env.global_tpenv name in
244 TySet.union local global
246 let get_reified env name =
247 let tpenv = get_tpenv env in
248 let local = TPEnv.get_reified tpenv name in
249 let global = TPEnv.get_reified env.global_tpenv name in
250 match (local, global) with
251 | (Reified, _)
252 | (_, Reified) ->
253 Reified
254 | (SoftReified, _)
255 | (_, SoftReified) ->
256 SoftReified
257 | _ -> Erased
259 let get_enforceable env name =
260 let tpenv = get_tpenv env in
261 let local = TPEnv.get_enforceable tpenv name in
262 let global = TPEnv.get_enforceable env.global_tpenv name in
263 local || global
265 let get_newable env name =
266 let tpenv = get_tpenv env in
267 let local = TPEnv.get_newable tpenv name in
268 let global = TPEnv.get_newable env.global_tpenv name in
269 local || global
271 (* Get bounds that are both an upper and lower of a given generic *)
272 let get_equal_bounds env name =
273 let lower = get_lower_bounds env name in
274 let upper = get_upper_bounds env name in
275 TySet.inter lower upper
277 let env_with_tpenv env tpenv =
279 env with
280 lenv =
282 env.lenv with
283 per_cont_env =
284 Typing_per_cont_env.(
285 update_cont_entry C.Next env.lenv.per_cont_env (fun entry ->
286 { entry with tpenv }));
290 let env_with_global_tpenv env global_tpenv = { env with global_tpenv }
292 let add_upper_bound_global env name ty =
293 let tpenv =
294 match ty with
295 | (r, Tabstract (AKgeneric formal_super, _)) ->
296 TPEnv.add_lower_bound
297 env.global_tpenv
298 formal_super
299 (r, Tabstract (AKgeneric name, None))
300 | _ -> env.global_tpenv
302 { env with global_tpenv = TPEnv.add_upper_bound tpenv name ty }
304 (* Add a single new upper bound [ty] to generic parameter [name] in the local
305 * type parameter environment of [env].
306 * If the optional [intersect] operation is supplied, then use this to avoid
307 * adding redundant bounds by merging the type with existing bounds. This makes
308 * sense because a conjunction of upper bounds
309 * (T <: t1) /\ ... /\ (T <: tn)
310 * is equivalent to a single upper bound
311 * T <: (t1 & ... & tn)
313 let add_upper_bound ?intersect env name ty =
314 env_with_tpenv env (TPEnv.add_upper_bound ?intersect (get_tpenv env) name ty)
316 (* Add a single new upper lower [ty] to generic parameter [name] in the
317 * local type parameter environment [env].
318 * If the optional [union] operation is supplied, then use this to avoid
319 * adding redundant bounds by merging the type with existing bounds. This makes
320 * sense because a conjunction of lower bounds
321 * (t1 <: T) /\ ... /\ (tn <: T)
322 * is equivalent to a single lower bound
323 * (t1 | ... | tn) <: T
325 let add_lower_bound ?union env name ty =
326 env_with_tpenv env (TPEnv.add_lower_bound ?union (get_tpenv env) name ty)
328 (* Add type parameters to environment, initially with no bounds.
329 * Existing type parameters with the same name will be overridden. *)
330 let add_generic_parameters env tparaml =
331 env_with_tpenv env (TPEnv.add_generic_parameters (get_tpenv env) tparaml)
333 let is_generic_parameter env name =
334 TPEnv.mem name (get_tpenv env) || SSet.mem name env.fresh_typarams
336 let get_generic_parameters env =
337 TPEnv.get_names (TPEnv.union (get_tpenv env) env.global_tpenv)
339 let get_tpenv_size env =
340 TPEnv.size (get_tpenv env) + TPEnv.size env.global_tpenv
342 let is_consistent env = TPEnv.is_consistent (get_tpenv env)
344 let mark_inconsistent env =
345 env_with_tpenv env (TPEnv.mark_inconsistent (get_tpenv env))
347 (*****************************************************************************
348 * Operations to get or add bounds to type variables.
349 * There is a lot of code duplication from the tpenv code here, which we
350 * should consider sharing in future.
351 *****************************************************************************)
353 let get_tyvar_lower_bounds env var : ITySet.t =
354 match get_tyvar_info_opt env var with
355 | None -> ITySet.empty
356 | Some { lower_bounds; _ } -> lower_bounds
358 let get_tyvar_upper_bounds env var : ITySet.t =
359 match get_tyvar_info_opt env var with
360 | None -> ITySet.empty
361 | Some { upper_bounds; _ } -> upper_bounds
363 let set_tyvar_lower_bounds env var lower_bounds =
364 let tyvar_info = get_tyvar_info env var in
365 let tyvar_info = { tyvar_info with lower_bounds } in
366 let env = update_tyvar_info env var tyvar_info in
369 let set_tyvar_upper_bounds env var upper_bounds =
370 let tyvar_info = get_tyvar_info env var in
371 let tyvar_info = { tyvar_info with upper_bounds } in
372 let env = update_tyvar_info env var tyvar_info in
375 let rec is_tvar ~elide_nullable ty var =
376 match ty with
377 | LoclType (_, Tvar var') -> var = var'
378 | LoclType (_, Toption ty) when elide_nullable ->
379 is_tvar ~elide_nullable (LoclType ty) var
380 | _ -> false
382 let remove_tyvar env var =
383 (* Don't remove it entirely if we have marked it as eager_solve_fail *)
384 log_env_change "remove_tyvar" env
386 let tvinfo = get_tyvar_info env var in
387 if tvinfo.eager_solve_fail then
388 update_tyvar_info env var { empty_tyvar_info with eager_solve_fail = true }
389 else
390 env_with_tvenv env (IMap.remove var env.tvenv)
392 let set_tyvar_eager_solve_fail env var =
393 let tvinfo = get_tyvar_info env var in
394 update_tyvar_info env var { tvinfo with eager_solve_fail = true }
396 let get_tyvar_appears_covariantly env var =
397 let tvinfo = get_tyvar_info env var in
398 tvinfo.appears_covariantly
400 let get_tyvar_appears_contravariantly env var =
401 let tvinfo = get_tyvar_info env var in
402 tvinfo.appears_contravariantly
404 let get_tyvar_appears_invariantly env var =
405 get_tyvar_appears_covariantly env var
406 && get_tyvar_appears_contravariantly env var
408 let get_tyvar_type_consts env var =
409 let tvinfo = get_tyvar_info env var in
410 tvinfo.type_constants
412 let get_tyvar_type_const env var (_, tyconstid) =
413 SMap.get tyconstid (get_tyvar_type_consts env var)
415 let set_tyvar_type_const env var ((_, tyconstid_) as tyconstid) ty =
416 let tvinfo = get_tyvar_info env var in
417 let type_constants =
418 SMap.add tyconstid_ (tyconstid, ty) tvinfo.type_constants
420 update_tyvar_info env var { tvinfo with type_constants }
422 (* Conjoin a subtype proposition onto the subtype_prop in the environment *)
423 let add_subtype_prop env prop =
424 log_env_change "add_subtype_prop" env
425 @@ { env with subtype_prop = TL.conj env.subtype_prop prop }
427 (* Generate a fresh generic parameter with a specified prefix but distinct
428 * from all generic parameters in the environment *)
429 let add_fresh_generic_parameter env prefix ~reified ~enforceable ~newable =
430 let rec iterate i =
431 let name = Printf.sprintf "%s#%d" prefix i in
432 if is_generic_parameter env name then
433 iterate (i + 1)
434 else
435 name
437 let name = iterate 1 in
438 let env = { env with fresh_typarams = SSet.add name env.fresh_typarams } in
439 let env =
440 env_with_tpenv
442 (TPEnv.add
443 name
444 TPEnv.
446 lower_bounds = empty_bounds;
447 upper_bounds = empty_bounds;
448 reified;
449 enforceable;
450 newable;
452 (get_tpenv env))
454 (env, name)
456 let is_fresh_generic_parameter name =
457 String.contains name '#' && not (AbstractKind.is_generic_dep_ty name)
459 let tparams_visitor env =
460 object (this)
461 inherit [SSet.t] Type_visitor.locl_type_visitor
463 method! on_tabstract acc _ ak _ty_opt =
464 match ak with
465 | AKgeneric s -> SSet.add s acc
466 | _ -> acc
468 method! on_tvar acc r ix =
469 let (_env, ty) = get_type env r ix in
470 match ty with
471 | (_, Tvar _) -> acc
472 | _ -> this#on_type acc ty
475 let get_tparams_aux env acc ty = (tparams_visitor env)#on_type acc ty
477 let get_tparams env ty = get_tparams_aux env SSet.empty ty
479 let get_tpenv_tparams env =
480 TPEnv.fold
481 begin
482 fun _x
483 TPEnv.
485 lower_bounds;
486 upper_bounds;
487 reified = _;
488 enforceable = _;
489 newable = _;
491 acc ->
492 let folder ty acc =
493 match ty with
494 | (_, Tabstract (AKgeneric _, _)) -> acc
495 | _ -> get_tparams_aux env acc ty
497 TySet.fold folder lower_bounds @@ TySet.fold folder upper_bounds acc
499 (get_tpenv env)
500 SSet.empty
502 (* Replace types for locals with empty environment *)
503 let env_with_locals env locals =
504 { env with lenv = { env.lenv with per_cont_env = locals } }
506 (* This is used whenever we start checking a method. Retain tpenv from the class type parameters *)
507 let reinitialize_locals env =
508 env_with_locals
510 LEnvC.(initial_locals { empty_entry with tpenv = get_tpenv env })
512 let initial_local tpenv local_reactive =
514 per_cont_env = LEnvC.(initial_locals { empty_entry with tpenv });
515 local_using_vars = LID.Set.empty;
516 local_mutability = LID.Map.empty;
517 local_reactive;
520 let empty ?(mode = FileInfo.Mstrict) tcopt file ~droot =
522 function_pos = Pos.none;
523 tenv = IMap.empty;
524 subst = IMap.empty;
525 fresh_typarams = SSet.empty;
526 lenv = initial_local TPEnv.empty Nonreactive;
527 in_loop = false;
528 in_try = false;
529 in_case = false;
530 inside_constructor = false;
531 inside_ppl_class = false;
532 decl_env = { mode; droot; decl_tcopt = tcopt };
533 genv =
535 tcopt;
536 return =
538 (* Actually should get set straight away anyway *)
539 return_type =
540 { et_type = (Reason.Rnone, Tunion []); et_enforced = false };
541 return_disposable = false;
542 return_mutable = false;
543 return_explicit = false;
544 return_void_to_rx = false;
546 params = LID.Map.empty;
547 condition_types = SMap.empty;
548 self_id = "";
549 self = (Reason.none, Typing_defs.make_tany ());
550 static = false;
551 val_kind = Other;
552 parent_id = "";
553 parent = (Reason.none, Typing_defs.make_tany ());
554 fun_kind = Ast_defs.FSync;
555 fun_mutable = None;
556 anons = IMap.empty;
557 file;
559 global_tpenv = TPEnv.empty;
560 subtype_prop = TL.valid;
561 log_levels = TypecheckerOptions.log_levels tcopt;
562 tvenv = IMap.empty;
563 global_tvenv = IMap.empty;
564 tyvars_stack = [];
565 allow_wildcards = false;
566 big_envs = ref [];
567 pessimize = false;
570 let set_env_reactive env reactive =
571 { env with lenv = { env.lenv with local_reactive = reactive } }
573 let set_env_pessimize env =
574 let pessimize_coefficient =
575 TypecheckerOptions.simple_pessimize (get_tcopt env)
577 let pessimize =
578 Pos.pessimize_enabled env.function_pos pessimize_coefficient
580 { env with pessimize }
582 let set_env_function_pos env function_pos = { env with function_pos }
584 let set_condition_type env n ty =
586 env with
587 genv =
589 env.genv with
590 condition_types = SMap.add n ty env.genv.condition_types;
594 let get_condition_type env n = SMap.get n env.genv.condition_types
596 (* Some form (strict/shallow/local) of reactivity *)
597 let env_local_reactive env = env_reactivity env <> Nonreactive
599 let function_is_mutable env = env.genv.fun_mutable
601 let set_fun_mutable env mut =
602 { env with genv = { env.genv with fun_mutable = mut } }
604 let error_if_reactive_context env f =
606 env_local_reactive env && not (TypecheckerOptions.unsafe_rx env.genv.tcopt)
607 then
608 f ()
610 let error_if_shallow_reactive_context env f =
611 match env_reactivity env with
612 | Reactive _
613 | Shallow _
614 when not (TypecheckerOptions.unsafe_rx env.genv.tcopt) ->
615 f ()
616 | _ -> ()
618 let add_wclass env x =
619 let dep = Dep.Class x in
620 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep);
623 let get_typedef env x =
624 add_wclass env x;
625 Decl_provider.get_typedef x
627 let is_typedef x =
628 match Naming_table.Types.get_pos x with
629 | Some (_p, Naming_table.TTypedef) -> true
630 | _ -> false
632 let get_class env x =
633 add_wclass env x;
634 Decl_provider.get_class x
636 let get_class_dep env x =
637 Decl_env.add_extends_dependency env.decl_env x;
638 get_class env x
640 let get_enum_constraint env x =
641 match get_class env x with
642 | None -> None
643 | Some tc ->
644 (match Cls.enum_type tc with
645 | None -> None
646 | Some e -> e.te_constraint)
648 let env_with_mut env local_mutability =
649 { env with lenv = { env.lenv with local_mutability } }
651 let get_env_mutability env = env.lenv.local_mutability
653 let get_enum env x =
654 add_wclass env x;
655 match Decl_provider.get_class x with
656 | Some tc when Cls.enum_type tc <> None -> Some tc
657 | _ -> None
659 let is_enum env x = get_enum env x <> None
661 let get_typeconst env class_ mid =
662 add_wclass env (Cls.name class_);
663 let dep = Dep.Const (Cls.name class_, mid) in
664 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep);
665 Cls.get_typeconst class_ mid
667 let get_pu_enum env class_ mid =
668 add_wclass env (Cls.name class_);
669 let dep = Dep.Const (Cls.name class_, mid) in
670 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep);
671 Cls.get_pu_enum class_ mid
673 (* Used to access class constants. *)
674 let get_const env class_ mid =
675 add_wclass env (Cls.name class_);
676 let dep = Dep.Const (Cls.name class_, mid) in
677 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep);
678 Cls.get_const class_ mid
680 (* Used to access "global constants". That is constants that were
681 * introduced with "const X = ...;" at topelevel, or "define('X', ...);"
683 let get_gconst env cst_name =
684 let dep = Dep.GConst cst_name in
685 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep);
686 Decl_provider.get_gconst cst_name
688 let get_static_member is_method env class_ mid =
689 add_wclass env (Cls.name class_);
690 let add_dep x =
691 let dep =
692 if is_method then
693 Dep.SMethod (x, mid)
694 else
695 Dep.SProp (x, mid)
697 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep)
699 add_dep (Cls.name class_);
701 (* The type of a member is stored separately in the heap. This means that
702 * any user of the member also has a dependency on the class where the member
703 * originated.
705 let ce_opt =
706 if is_method then
707 Cls.get_smethod class_ mid
708 else
709 Cls.get_sprop class_ mid
711 Option.iter ce_opt (fun ce -> add_dep ce.ce_origin);
712 ce_opt
714 (* Given a list of things whose name we can extract with `f`, return
715 the item whose name is closest to `name`. *)
716 let most_similar
717 (name : string) (possibilities : 'a Sequence.t) (f : 'a -> string) :
718 'a option =
719 let distance = String_utils.levenshtein_distance in
720 let choose_closest x y =
721 if distance (f x) name < distance (f y) name then
723 else
726 Sequence.fold possibilities ~init:None ~f:(fun acc possibility ->
727 match acc with
728 | None -> Some possibility
729 | Some current_best -> Some (choose_closest current_best possibility))
731 let suggest_member members mid =
732 let pairs =
733 Sequence.map members ~f:(fun (x, { ce_type = (lazy (r, _)); _ }) ->
734 (Reason.to_pos r, x))
736 most_similar mid pairs snd
738 let suggest_static_member is_method class_ mid =
739 let mid = String.lowercase mid in
740 let members =
741 if is_method then
742 Cls.smethods class_
743 else
744 Cls.sprops class_
746 suggest_member members mid
748 let get_member is_method env class_ mid =
749 add_wclass env (Cls.name class_);
750 let add_dep x =
751 let dep =
752 if is_method then
753 Dep.Method (x, mid)
754 else
755 Dep.Prop (x, mid)
757 Option.iter env.decl_env.droot (fun root -> Typing_deps.add_idep root dep)
759 add_dep (Cls.name class_);
761 (* The type of a member is stored separately in the heap. This means that
762 * any user of the member also has a dependency on the class where the member
763 * originated.
765 let ce_opt =
766 if is_method then
767 Cls.get_method class_ mid
768 else
769 Cls.get_prop class_ mid
771 Option.iter ce_opt (fun ce -> add_dep ce.ce_origin);
772 ce_opt
774 let suggest_member is_method class_ mid =
775 let mid = String.lowercase mid in
776 let members =
777 if is_method then
778 Cls.methods class_
779 else
780 Cls.props class_
782 suggest_member members mid
784 let get_construct env class_ =
785 add_wclass env (Cls.name class_);
786 let add_dep x =
787 let dep = Dep.Cstr x in
788 Option.iter env.decl_env.Decl_env.droot (fun root ->
789 Typing_deps.add_idep root dep)
791 add_dep (Cls.name class_);
792 Option.iter (fst (Cls.construct class_)) (fun ce -> add_dep ce.ce_origin);
793 Cls.construct class_
795 let get_return env = env.genv.return
797 let set_return env x =
798 let genv = env.genv in
799 let genv = { genv with return = x } in
800 { env with genv }
802 let get_params env = env.genv.params
804 let set_params env params = { env with genv = { env.genv with params } }
806 let set_param env x param =
807 let params = get_params env in
808 let params = LID.Map.add x param params in
809 set_params env params
811 let clear_params env = set_params env LID.Map.empty
813 let with_env env f =
814 let ret = get_return env in
815 let params = get_params env in
816 let (env, result) = f env in
817 let env = set_params env params in
818 let env = set_return env ret in
819 (env, result)
821 let is_static env = env.genv.static
823 let get_val_kind env = env.genv.val_kind
825 let get_self env = env.genv.self
827 let get_self_id env = env.genv.self_id
829 let is_outside_class env = env.genv.self_id = ""
831 let get_parent env = env.genv.parent
833 let get_parent_id env = env.genv.parent_id
835 let get_fn_kind env = env.genv.fun_kind
837 let get_file env = env.genv.file
839 let set_fn_kind env fn_type =
840 let genv = env.genv in
841 let genv = { genv with fun_kind = fn_type } in
842 { env with genv }
844 let set_inside_ppl_class env inside_ppl_class = { env with inside_ppl_class }
846 let add_anonymous env x =
847 let genv = env.genv in
848 let anon_id = Ident.tmp () in
849 let genv = { genv with anons = IMap.add anon_id x genv.anons } in
850 ({ env with genv }, anon_id)
852 let get_anonymous env x = IMap.get x env.genv.anons
854 let set_self_id env x =
855 let genv = env.genv in
856 let genv = { genv with self_id = x } in
857 { env with genv }
859 let set_self env x =
860 let genv = env.genv in
861 let genv = { genv with self = x } in
862 { env with genv }
864 let set_parent_id env x =
865 let genv = env.genv in
866 let genv = { genv with parent_id = x } in
867 { env with genv }
869 let set_parent env x =
870 let genv = env.genv in
871 let genv = { genv with parent = x } in
872 { env with genv }
874 let set_static env =
875 let genv = env.genv in
876 let genv = { genv with static = true } in
877 { env with genv }
879 let set_val_kind env x =
880 let genv = env.genv in
881 let genv = { genv with val_kind = x } in
882 { env with genv }
884 let set_mode env mode =
885 let decl_env = env.decl_env in
886 let decl_env = { decl_env with mode } in
887 { env with decl_env }
889 let get_mode env = env.decl_env.mode
891 let is_strict env = FileInfo.is_strict (get_mode env)
893 let is_decl env = get_mode env = FileInfo.Mdecl
895 let iter_anonymous env f =
896 IMap.iter
897 (fun _id { counter = ftys; pos; _ } ->
898 let (untyped, typed) = !ftys in
899 f pos (untyped @ typed))
900 env.genv.anons
902 (*****************************************************************************)
903 (* Locals *)
904 (*****************************************************************************)
906 let set_local_ env x ty =
907 let per_cont_env = LEnvC.add_to_cont C.Next x ty env.lenv.per_cont_env in
908 { env with lenv = { env.lenv with per_cont_env } }
910 (* We maintain 2 states for a local: the type
911 * that the local currently has, and an expression_id generated from
912 * the last assignment to this local.
914 let set_local env x new_type =
915 let new_type =
916 match new_type with
917 | (_, Tunion [ty]) -> ty
918 | _ -> new_type
920 match next_cont_opt env with
921 | None -> env
922 | Some next_cont ->
923 let expr_id =
924 match LID.Map.get x next_cont.LEnvC.local_types with
925 | None -> Ident.tmp ()
926 | Some (_, y) -> y
928 let local = (new_type, expr_id) in
929 set_local_ env x local
931 let is_using_var env x = LID.Set.mem x env.lenv.local_using_vars
933 let set_using_var env x =
935 env with
936 lenv =
938 env.lenv with
939 local_using_vars = LID.Set.add x env.lenv.local_using_vars;
943 let unset_local env local =
944 let { per_cont_env; local_using_vars; local_mutability; local_reactive } =
945 env.lenv
947 let per_cont_env =
948 LEnvC.remove_from_cont C.Next local
949 @@ LEnvC.remove_from_cont C.Catch local
950 @@ per_cont_env
952 let local_using_vars = LID.Set.remove local local_using_vars in
953 let local_mutability = LID.Map.remove local local_mutability in
954 let env =
956 env with
957 lenv =
958 { per_cont_env; local_using_vars; local_mutability; local_reactive };
963 let add_mutable_var env local mutability_type =
964 env_with_mut
966 (LID.Map.add local mutability_type env.lenv.local_mutability)
968 let local_is_mutable ~include_borrowed env id =
969 let module TME = Typing_mutability_env in
970 match LID.Map.get id (get_env_mutability env) with
971 | Some (_, TME.Mutable) -> true
972 | Some (_, TME.Borrowed) -> include_borrowed
973 | _ -> false
975 let tany env =
976 let dynamic_view_enabled = TypecheckerOptions.dynamic_view (get_tcopt env) in
977 if dynamic_view_enabled then
978 Tdynamic
979 else
980 Typing_defs.make_tany ()
982 let decl_tany = tany
984 let get_local_in_ctx env ?error_if_undef_at_pos:p x ctx_opt =
985 let not_found_is_ok x ctx =
986 let xstr = LID.to_string x in
987 ((xstr = SG.globals || SG.is_superglobal xstr) && not (is_strict env))
988 || Fake.is_valid ctx.LEnvC.fake_members x
990 let error_if_pos_provided posopt ctx =
991 match posopt with
992 | Some p ->
993 let in_rx_scope = env_local_reactive env in
994 let lid = LID.to_string x in
995 let suggest_most_similar lid =
996 let all_locals =
997 Sequence.of_list (LID.Map.elements ctx.LEnvC.local_types)
999 let var_name (k, _) = LID.to_string k in
1000 match most_similar lid all_locals var_name with
1001 | Some (k, _) -> Some (LID.to_string k)
1002 | None -> None
1004 Errors.undefined ~in_rx_scope p lid (suggest_most_similar lid)
1005 | None -> ()
1007 match ctx_opt with
1008 | None ->
1009 (* If the continuation is absent, we are in dead code so the variable should
1010 have type nothing. *)
1011 Some (Typing_make_type.nothing Reason.Rnone, 0)
1012 | Some ctx ->
1013 let lcl = LID.Map.get x ctx.LEnvC.local_types in
1014 begin
1015 match lcl with
1016 | None ->
1017 if not_found_is_ok x ctx then
1019 else
1020 error_if_pos_provided p ctx
1021 | Some _ -> ()
1022 end;
1025 let get_local_ty_in_ctx env ?error_if_undef_at_pos x ctx_opt =
1026 match get_local_in_ctx env ?error_if_undef_at_pos x ctx_opt with
1027 | None -> (false, (Reason.Rnone, tany env))
1028 | Some (x, _) -> (true, x)
1030 let get_local_in_next_continuation ?error_if_undef_at_pos:p env x =
1031 let next_cont = next_cont_opt env in
1032 get_local_ty_in_ctx env ?error_if_undef_at_pos:p x next_cont
1034 let get_local_ ?error_if_undef_at_pos:p env x =
1035 get_local_in_next_continuation ?error_if_undef_at_pos:p env x
1037 let get_local env x = snd (get_local_ env x)
1039 let get_locals env plids =
1040 let next_cont = next_cont_opt env in
1041 List.fold plids ~init:LID.Map.empty ~f:(fun locals (p, lid) ->
1042 match get_local_in_ctx env ~error_if_undef_at_pos:p lid next_cont with
1043 | None -> locals
1044 | Some ty_eid -> LID.Map.add lid ty_eid locals)
1046 let set_locals env locals =
1047 LID.Map.fold (fun lid ty env -> set_local_ env lid ty) locals env
1049 let is_local_defined env x =
1050 let next_cont = next_cont_opt env in
1051 Option.is_some next_cont && fst (get_local_ env x)
1053 let get_local_check_defined env (p, x) =
1054 snd (get_local_ ~error_if_undef_at_pos:p env x)
1056 let set_local_expr_id env x new_eid =
1057 let per_cont_env = env.lenv.per_cont_env in
1058 match LEnvC.get_cont_option C.Next per_cont_env with
1059 | None -> env
1060 | Some next_cont ->
1061 begin
1062 match LID.Map.get x next_cont.LEnvC.local_types with
1063 | Some (type_, eid) when eid <> new_eid ->
1064 let local = (type_, new_eid) in
1065 let per_cont_env = LEnvC.add_to_cont C.Next x local per_cont_env in
1066 let env = { env with lenv = { env.lenv with per_cont_env } } in
1068 | _ -> env
1071 let get_local_expr_id env x =
1072 match next_cont_opt env with
1073 | None -> (* dead code *) None
1074 | Some next_cont ->
1075 let lcl = LID.Map.get x next_cont.LEnvC.local_types in
1076 Option.map lcl ~f:(fun (_, x) -> x)
1078 let set_fake_members env fake_members =
1079 let per_cont_env =
1080 LEnvC.update_cont_entry C.Next env.lenv.per_cont_env (fun entry ->
1081 { entry with LEnvC.fake_members })
1083 { env with lenv = { env.lenv with per_cont_env } }
1085 let get_fake_members env =
1086 match LEnvC.get_cont_option C.Next env.lenv.per_cont_env with
1087 | None -> Fake.empty
1088 | Some next_cont -> next_cont.LEnvC.fake_members
1090 let update_lost_info name blame env ty =
1091 let (pos, under_lambda) =
1092 match blame with
1093 | Fake.Blame_call pos -> (pos, false)
1094 | Fake.Blame_lambda pos -> (pos, true)
1096 let info r = Reason.Rlost_info (name, r, pos, under_lambda) in
1097 let rec update_ty env ty =
1098 match ty with
1099 | (_, Tvar v) ->
1100 let (env, v') = get_var env v in
1101 (match IMap.get v' env.tenv with
1102 | None -> (env, ty)
1103 | Some ty ->
1104 let (env, ty) = update_ty env ty in
1105 let env = add env v ty in
1106 (env, ty))
1107 | (r, Tunion tyl) ->
1108 let (env, tyl) = List.map_env env tyl update_ty in
1109 (env, (info r, Tunion tyl))
1110 | (r, ty) -> (env, (info r, ty))
1112 update_ty env ty
1114 let forget_members env blame =
1115 let fake_members = get_fake_members env in
1116 let fake_members = Fake.forget fake_members blame in
1117 set_fake_members env fake_members
1119 module FakeMembers = struct
1120 let update_fake_members env fake_members =
1121 let per_cont_env =
1122 LEnvC.update_cont_entry C.Next env.lenv.per_cont_env (fun entry ->
1123 LEnvC.{ entry with fake_members })
1125 { env with lenv = { env.lenv with per_cont_env } }
1127 let is_valid env obj member_name =
1128 match obj with
1129 | (_, This)
1130 | (_, Lvar _) ->
1131 let fake_members = get_fake_members env in
1132 let id = Fake.make_id obj member_name in
1133 Fake.is_valid fake_members id
1134 | _ -> false
1136 let is_valid_static env cid member_name =
1137 let name = Fake.make_static_id cid member_name in
1138 let fake_members = get_fake_members env in
1139 Fake.is_valid fake_members name
1141 let check_static_invalid env cid member_name ty =
1142 let fake_members = get_fake_members env in
1143 let fake_id = Fake.make_static_id cid member_name in
1144 match Fake.is_invalid fake_members fake_id with
1145 | None -> (env, ty)
1146 | Some blame -> update_lost_info (Local_id.to_string fake_id) blame env ty
1148 let check_instance_invalid env obj member_name ty =
1149 match obj with
1150 | (_, This)
1151 | (_, Lvar _) ->
1152 let fake_members = get_fake_members env in
1153 let fake_id = Fake.make_id obj member_name in
1154 begin
1155 match Fake.is_invalid fake_members fake_id with
1156 | None -> (env, ty)
1157 | Some blame ->
1158 update_lost_info (Local_id.to_string fake_id) blame env ty
1160 | _ -> (env, ty)
1162 let add_member env fake_id =
1163 let fake_members = get_fake_members env in
1164 let fake_members = Fake.add fake_members fake_id in
1165 set_fake_members env fake_members
1167 let make env obj_name member_name =
1168 let my_fake_local_id = Fake.make_id obj_name member_name in
1169 let env = add_member env my_fake_local_id in
1170 (env, my_fake_local_id)
1172 let make_static env class_name member_name =
1173 let my_fake_local_id = Fake.make_static_id class_name member_name in
1174 let env = add_member env my_fake_local_id in
1175 (env, my_fake_local_id)
1178 (*****************************************************************************)
1179 (* Sets up/cleans up the environment when typing an anonymous function. *)
1180 (*****************************************************************************)
1182 let anon anon_lenv env f =
1183 (* Setting up the environment. *)
1184 let old_lenv = env.lenv in
1185 let old_return = get_return env in
1186 let old_params = get_params env in
1187 let outer_fun_kind = get_fn_kind env in
1188 let env = { env with lenv = anon_lenv } in
1189 (* Typing *)
1190 let (env, tfun, result) = f env in
1191 (* Cleaning up the environment. *)
1192 let env = { env with lenv = old_lenv } in
1193 let env = set_params env old_params in
1194 let env = set_return env old_return in
1195 let env = set_fn_kind env outer_fun_kind in
1196 (env, tfun, result)
1198 let in_loop env f =
1199 let old_in_loop = env.in_loop in
1200 let env = { env with in_loop = true } in
1201 let (env, result) = f env in
1202 ({ env with in_loop = old_in_loop }, result)
1204 let in_try env f =
1205 let old_in_try = env.in_try in
1206 let env = { env with in_try = true } in
1207 let (env, result) = f env in
1208 ({ env with in_try = old_in_try }, result)
1210 let in_case env f =
1211 let old_in_case = env.in_case in
1212 let env = { env with in_case = true } in
1213 let (env, result) = f env in
1214 ({ env with in_case = old_in_case }, result)
1216 (* Return the subset of env which is saved in the Typed AST's EnvAnnotation. *)
1217 let save local_tpenv env =
1219 Tast.tcopt = get_tcopt env;
1220 Tast.tenv = env.tenv;
1221 Tast.subst = env.subst;
1222 Tast.tpenv = TPEnv.union local_tpenv env.global_tpenv;
1223 Tast.reactivity = env_reactivity env;
1224 Tast.local_mutability = get_env_mutability env;
1225 Tast.fun_mutable = function_is_mutable env;
1226 Tast.condition_types = env.genv.condition_types;
1229 (* Compute the type variables appearing covariantly (positively)
1230 * resp. contravariantly (negatively) in a given type ty.
1231 * Return a pair of sets of positive and negative type variables
1232 * (as well as an updated environment).
1234 let rec get_tyvars env (ty : locl_ty) = get_tyvars_i env (LoclType ty)
1236 and get_tyvars_i env (ty : internal_type) =
1237 let get_tyvars_union (env, acc_positive, acc_negative) ty =
1238 let (env, positive, negative) = get_tyvars env ty in
1239 (env, ISet.union acc_positive positive, ISet.union acc_negative negative)
1241 let get_tyvars_param
1242 (env, acc_positive, acc_negative) { fp_type; fp_kind; _ } =
1243 let (env, positive, negative) = get_tyvars env fp_type.et_type in
1244 match fp_kind with
1245 (* Parameters are treated contravariantly *)
1246 | FPnormal ->
1247 (env, ISet.union negative acc_positive, ISet.union positive acc_negative)
1248 (* Inout/ref parameters are both co- and contra-variant *)
1249 | FPinout
1250 | FPref ->
1251 let tyvars = ISet.union negative positive in
1252 (env, ISet.union tyvars acc_positive, ISet.union tyvars acc_negative)
1254 let (env, ety) = expand_internal_type env ty in
1255 match ety with
1256 | LoclType ety ->
1257 (match snd ety with
1258 | Tvar v -> (env, ISet.singleton v, ISet.empty)
1259 | Tany _
1260 | Tnonnull
1261 | Terr
1262 | Tdynamic
1263 | Tobject
1264 | Tprim _
1265 | Tanon _ ->
1266 (env, ISet.empty, ISet.empty)
1267 | Toption ty -> get_tyvars env ty
1268 | Ttuple tyl
1269 | Tunion tyl
1270 | Tintersection tyl
1271 | Tdestructure tyl ->
1272 List.fold_left
1274 ~init:(env, ISet.empty, ISet.empty)
1275 ~f:get_tyvars_union
1276 | Tshape (_, m) ->
1277 Nast.ShapeMap.fold
1278 (fun _ { sft_ty; _ } res -> get_tyvars_union res sft_ty)
1280 (env, ISet.empty, ISet.empty)
1281 | Tfun ft ->
1282 let (env, params_positive, params_negative) =
1283 match ft.ft_arity with
1284 | Fstandard _
1285 | Fellipsis _ ->
1286 (env, ISet.empty, ISet.empty)
1287 | Fvariadic (_, fp) ->
1288 get_tyvars_param (env, ISet.empty, ISet.empty) fp
1290 let (env, params_positive, params_negative) =
1291 List.fold_left
1292 ft.ft_params
1293 ~init:(env, params_positive, params_negative)
1294 ~f:get_tyvars_param
1296 let (env, ret_positive, ret_negative) =
1297 get_tyvars env ft.ft_ret.et_type
1299 ( env,
1300 ISet.union ret_positive params_positive,
1301 ISet.union ret_negative params_negative )
1302 | Tabstract (AKnewtype (name, tyl), _) ->
1303 begin
1304 match get_typedef env name with
1305 | Some { td_tparams; _ } ->
1306 let variancel = List.map td_tparams (fun t -> t.tp_variance) in
1307 get_tyvars_variance_list (env, ISet.empty, ISet.empty) variancel tyl
1308 | None -> (env, ISet.empty, ISet.empty)
1310 | Tabstract (_, Some ty) -> get_tyvars env ty
1311 | Tabstract (_, None) -> (env, ISet.empty, ISet.empty)
1312 | Tclass ((_, cid), _, tyl) ->
1313 begin
1314 match get_class env cid with
1315 | Some cls ->
1316 let variancel =
1317 List.map (Cls.tparams cls) (fun t -> t.tp_variance)
1319 get_tyvars_variance_list (env, ISet.empty, ISet.empty) variancel tyl
1320 | None -> (env, ISet.empty, ISet.empty)
1322 | Tarraykind ak ->
1323 begin
1324 match ak with
1325 | AKany
1326 | AKempty ->
1327 (env, ISet.empty, ISet.empty)
1328 | AKvarray ty
1329 | AKvarray_or_darray ty ->
1330 get_tyvars env ty
1331 | AKdarray (ty1, ty2) ->
1332 let (env, positive1, negative1) = get_tyvars env ty1 in
1333 let (env, positive2, negative2) = get_tyvars env ty2 in
1334 (env, ISet.union positive1 positive2, ISet.union negative1 negative2)
1336 | Tpu (base, _, _) -> get_tyvars env base
1337 | Tpu_access (base, _) -> get_tyvars env base)
1338 | ConstraintType ty ->
1339 (match ty with
1340 | (_, Thas_member hm) ->
1341 let { hm_type; hm_name = _; hm_nullsafe = _; hm_class_id = _ } = hm in
1342 get_tyvars env hm_type)
1344 and get_tyvars_variance_list (env, acc_positive, acc_negative) variancel tyl =
1345 match (variancel, tyl) with
1346 | (variance :: variancel, ty :: tyl) ->
1347 let (env, positive, negative) = get_tyvars env ty in
1348 let (acc_positive, acc_negative) =
1349 match variance with
1350 | Ast_defs.Covariant ->
1351 (ISet.union acc_positive positive, ISet.union acc_negative negative)
1352 | Ast_defs.Contravariant ->
1353 (ISet.union acc_positive negative, ISet.union acc_negative positive)
1354 | Ast_defs.Invariant ->
1355 let positive_or_negative = ISet.union positive negative in
1356 ( ISet.union acc_positive positive_or_negative,
1357 ISet.union acc_negative positive_or_negative )
1359 get_tyvars_variance_list (env, acc_positive, acc_negative) variancel tyl
1360 | _ -> (env, acc_positive, acc_negative)
1362 let rec set_tyvar_appears_covariantly env var =
1363 let tvinfo = get_tyvar_info env var in
1364 if tvinfo.appears_covariantly then
1366 else
1367 let env =
1368 update_tyvar_info env var { tvinfo with appears_covariantly = true }
1370 update_variance_of_tyvars_occurring_in_lower_bounds env tvinfo.lower_bounds
1372 and set_tyvar_appears_contravariantly env var =
1373 let tvinfo = get_tyvar_info env var in
1374 if tvinfo.appears_contravariantly then
1376 else
1377 let env =
1378 update_tyvar_info env var { tvinfo with appears_contravariantly = true }
1380 update_variance_of_tyvars_occurring_in_upper_bounds env tvinfo.upper_bounds
1382 and update_variance_of_tyvars_occurring_in_lower_bounds env tys =
1383 ITySet.fold
1384 (fun ty env -> update_variance_of_tyvars_occurring_in_lower_bound env ty)
1388 and update_variance_of_tyvars_occurring_in_upper_bounds env tys =
1389 ITySet.fold
1390 (fun ty env -> update_variance_of_tyvars_occurring_in_upper_bound env ty)
1394 and update_variance_of_tyvars_occurring_in_lower_bound env ty =
1395 let (env, ety) = expand_internal_type env ty in
1396 match ety with
1397 | LoclType (_, Tvar _) -> env
1398 | _ ->
1399 let (env, positive, negative) = get_tyvars_i env ty in
1400 let env =
1401 ISet.fold
1402 (fun var env -> set_tyvar_appears_covariantly env var)
1403 positive
1406 let env =
1407 ISet.fold
1408 (fun var env -> set_tyvar_appears_contravariantly env var)
1409 negative
1414 and update_variance_of_tyvars_occurring_in_upper_bound env ty =
1415 let (env, ety) = expand_internal_type env ty in
1416 match ety with
1417 | LoclType (_, Tvar _) -> env
1418 | _ ->
1419 let (env, positive, negative) = get_tyvars_i env ty in
1420 let env =
1421 ISet.fold
1422 (fun var env -> set_tyvar_appears_contravariantly env var)
1423 positive
1426 let env =
1427 ISet.fold
1428 (fun var env -> set_tyvar_appears_covariantly env var)
1429 negative
1434 (* After a type variable var has been "solved", or bound to a type ty, we need
1435 * to update the variance of type variables occurring in ty. Suppose that
1436 * variable var is marked "appears covariantly", i.e. it appears (at least) in
1437 * positive positions in the type of an expression. Then when we substitute ty
1438 * for var, variables that appear positively in ty must now be marked as
1439 * appearing covariantly; variables that appear negatively in ty must now be
1440 * marked as appearing contravariantly. And the dual, if the variable var is marked
1441 * "appears contravariantly".
1443 and update_variance_after_bind env var ty =
1444 let appears_contravariantly = get_tyvar_appears_contravariantly env var in
1445 let appears_covariantly = get_tyvar_appears_covariantly env var in
1446 let (env, positive, negative) = get_tyvars env ty in
1447 let env =
1448 ISet.fold
1449 (fun var env ->
1450 let env =
1451 if appears_contravariantly then
1452 set_tyvar_appears_contravariantly env var
1453 else
1456 if appears_covariantly then
1457 set_tyvar_appears_covariantly env var
1458 else
1459 env)
1460 positive
1463 let env =
1464 ISet.fold
1465 (fun var env ->
1466 let env =
1467 if appears_contravariantly then
1468 set_tyvar_appears_covariantly env var
1469 else
1472 if appears_covariantly then
1473 set_tyvar_appears_contravariantly env var
1474 else
1475 env)
1476 negative
1481 let set_tyvar_variance env ?(flip = false) ty =
1482 log_env_change "set_tyvar_variance" env
1484 let tyvars = get_current_tyvars env in
1485 let (env, positive, negative) = get_tyvars env ty in
1486 let (positive, negative) =
1487 if flip then
1488 (negative, positive)
1489 else
1490 (positive, negative)
1492 List.fold_left tyvars ~init:env ~f:(fun env var ->
1493 let env =
1494 if ISet.mem var positive then
1495 set_tyvar_appears_covariantly env var
1496 else
1499 let env =
1500 if ISet.mem var negative then
1501 set_tyvar_appears_contravariantly env var
1502 else
1505 env)
1507 let fresh_invariant_type_var env p =
1508 let v = Ident.tmp () in
1509 let env =
1510 log_env_change "fresh_invariant_type_var" env
1512 let env = add_current_tyvar env p v in
1513 let env = set_tyvar_appears_covariantly env v in
1514 let env = set_tyvar_appears_contravariantly env v in
1517 (env, (Reason.Rtype_variable p, Tvar v))
1519 (* Add a single new upper bound [ty] to type variable [var] in [env.tvenv].
1520 * If the optional [intersect] operation is supplied, then use this to avoid
1521 * adding redundant bounds by merging the type with existing bounds. This makes
1522 * sense because a conjunction of upper bounds
1523 * (v <: t1) /\ ... /\ (v <: tn)
1524 * is equivalent to a single upper bound
1525 * v <: (t1 & ... & tn)
1527 let add_tyvar_upper_bound ?intersect env var (ty : internal_type) =
1528 log_env_change "add_tyvar_upper_bound" env
1530 (* Don't add superfluous v <: v or v <: ?v to environment *)
1531 if is_tvar ~elide_nullable:true ty var then
1533 else
1534 let tvinfo = get_tyvar_info env var in
1535 let upper_bounds =
1536 match intersect with
1537 | None -> ITySet.add ty tvinfo.upper_bounds
1538 | Some intersect ->
1539 ITySet.of_list (intersect ty (ITySet.elements tvinfo.upper_bounds))
1541 let env = update_tyvar_info env var { tvinfo with upper_bounds } in
1542 if get_tyvar_appears_contravariantly env var then
1543 update_variance_of_tyvars_occurring_in_upper_bound env ty
1544 else
1547 (* Remove type variable `upper_var` from the upper bounds on `var`, if it exists
1549 let remove_tyvar_upper_bound env var upper_var =
1550 log_env_change "remove_tyvar_upper_bound" env
1552 let tvinfo = get_tyvar_info env var in
1553 let upper_bounds =
1554 ITySet.filter
1555 (fun ty ->
1556 match expand_internal_type env ty with
1557 | (_, LoclType (_, Tvar v)) -> v <> upper_var
1558 | _ -> true)
1559 tvinfo.upper_bounds
1561 update_tyvar_info env var { tvinfo with upper_bounds }
1563 (* Remove type variable `lower_var` from the lower bounds on `var`, if it exists
1565 let remove_tyvar_lower_bound env var lower_var =
1566 log_env_change "remove_tyvar_lower_bound var" env
1568 let tvinfo = get_tyvar_info env var in
1569 let lower_bounds =
1570 ITySet.filter
1571 (fun ty ->
1572 match expand_internal_type env ty with
1573 | (_, LoclType (_, Tvar v)) -> v <> lower_var
1574 | _ -> true)
1575 tvinfo.lower_bounds
1577 update_tyvar_info env var { tvinfo with lower_bounds }
1579 (* Add a single new lower bound [ty] to type variable [var] in [env.tvenv].
1580 * If the optional [union] operation is supplied, then use this to avoid
1581 * adding redundant bounds by merging the type with existing bounds. This makes
1582 * sense because a conjunction of lower bounds
1583 * (t1 <: v) /\ ... /\ (tn <: v)
1584 * is equivalent to a single lower bound
1585 * (t1 | ... | tn) <: v
1587 let add_tyvar_lower_bound ?union env var ty =
1588 log_env_change "add_tyvar_lower_bound" env
1590 (* Don't add superfluous v <: v to environment *)
1591 if is_tvar ~elide_nullable:false ty var then
1593 else
1594 let tvinfo = get_tyvar_info env var in
1595 let lower_bounds =
1596 match union with
1597 | None -> ITySet.add ty tvinfo.lower_bounds
1598 | Some union ->
1599 ITySet.of_list (union ty (ITySet.elements tvinfo.lower_bounds))
1601 let env = update_tyvar_info env var { tvinfo with lower_bounds } in
1602 if get_tyvar_appears_covariantly env var then
1603 update_variance_of_tyvars_occurring_in_lower_bound env ty
1604 else