2 * Copyright (c) 2015, Facebook, Inc.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
16 open Typing_env_return_info
17 module Dep
= Typing_deps.Dep
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
49 match old_env
.tyvars_stack
with
51 | _
-> old_env
.function_pos
53 !env_log_function pos name old_env new_env
);
56 let add_subst env x x'
=
58 { env
with subst
= IMap.add x x' env
.subst
}
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
69 let (env
, x'
) = get_var env
x'
in
70 let env = add_subst env x x'
in
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. *)
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
83 let (env, x) = get_var env x in
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 =
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 =
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
129 (IMap.add v
(LocalTyvar
{ tyvar_info with tyvar_pos
= p
}) env.tvenv
)
131 { env with tyvars_stack
= (expr_pos
, v
:: tyvars
) :: rest
}
134 let fresh_type_reason ?variance
env r
=
135 let v = Ident.tmp
() in
137 log_env_change "fresh_type" env
138 @@ add_current_tyvar ?variance
env (Reason.to_pos r
) 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
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
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
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
)
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
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))
201 let expand_type env x =
203 | (r
, Tvar
x) -> expand_var env r
x
206 let expand_internal_type env ty =
208 | ConstraintType _
-> (env, ty)
210 let (env, ty) = expand_type env ty in
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
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
255 | (_
, SoftReified
) ->
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
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
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 =
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 =
295 | (r
, Tabstract
(AKgeneric formal_super
, _
)) ->
296 TPEnv.add_lower_bound
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
=
377 | LoclType
(_
, Tvar var'
) -> var
= var'
378 | LoclType
(_
, Toption
ty) when elide_nullable
->
379 is_tvar ~elide_nullable
(LoclType
ty) var
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 }
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
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
=
431 let name = Printf.sprintf
"%s#%d" prefix i
in
432 if is_generic_parameter env name then
437 let name = iterate 1 in
438 let env = { env with fresh_typarams
= SSet.add name env.fresh_typarams
} in
446 lower_bounds
= empty_bounds;
447 upper_bounds
= empty_bounds;
456 let is_fresh_generic_parameter name =
457 String.contains
name '#'
&& not
(AbstractKind.is_generic_dep_ty
name)
459 let tparams_visitor env =
461 inherit [SSet.t
] Type_visitor.locl_type_visitor
463 method! on_tabstract acc _ ak _ty_opt
=
465 | AKgeneric s
-> SSet.add s acc
468 method! on_tvar acc r ix
=
469 let (_env
, ty) = get_type env r ix
in
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 =
494 | (_
, Tabstract
(AKgeneric _
, _
)) -> acc
495 | _
-> get_tparams_aux env acc
ty
497 TySet.fold
folder lower_bounds
@@ TySet.fold
folder upper_bounds acc
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 =
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
;
520 let empty ?
(mode
= FileInfo.Mstrict
) tcopt file ~droot
=
522 function_pos
= Pos.none
;
525 fresh_typarams
= SSet.empty;
526 lenv
= initial_local TPEnv.empty Nonreactive
;
530 inside_constructor
= false;
531 inside_ppl_class
= false;
532 decl_env
= { mode
; droot
; decl_tcopt
= tcopt
};
538 (* Actually should get set straight away anyway *)
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;
549 self
= (Reason.none
, Typing_defs.make_tany
());
553 parent
= (Reason.none
, Typing_defs.make_tany
());
554 fun_kind
= Ast_defs.FSync
;
559 global_tpenv
= TPEnv.empty;
560 subtype_prop
= TL.valid
;
561 log_levels
= TypecheckerOptions.log_levels tcopt
;
563 global_tvenv
= IMap.empty;
565 allow_wildcards
= 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)
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 =
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
)
610 let error_if_shallow_reactive_context env f
=
611 match env_reactivity
env with
614 when not
(TypecheckerOptions.unsafe_rx
env.genv
.tcopt
) ->
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 =
625 Decl_provider.get_typedef x
628 match Naming_table.Types.get_pos
x with
629 | Some
(_p
, Naming_table.TTypedef
) -> true
632 let get_class 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;
640 let get_enum_constraint env x =
641 match get_class env x with
644 (match Cls.enum_type tc
with
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
655 match Decl_provider.get_class x with
656 | Some tc
when Cls.enum_type tc
<> None
-> Some tc
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_
);
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
707 Cls.get_smethod class_ mid
709 Cls.get_sprop class_ mid
711 Option.iter
ce_opt (fun ce
-> add_dep ce
.ce_origin
);
714 (* Given a list of things whose name we can extract with `f`, return
715 the item whose name is closest to `name`. *)
717 (name : string) (possibilities
: 'a
Sequence.t
) (f
: 'a
-> string) :
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
726 Sequence.fold possibilities ~init
:None ~f
:(fun acc possibility
->
728 | None
-> Some possibility
729 | Some current_best
-> Some
(choose_closest current_best possibility
))
731 let suggest_member members mid
=
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
746 suggest_member members mid
748 let get_member is_method
env class_
mid =
749 add_wclass env (Cls.name class_
);
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
767 Cls.get_method class_
mid
769 Cls.get_prop class_
mid
771 Option.iter
ce_opt (fun ce
-> add_dep ce
.ce_origin
);
774 let suggest_member is_method class_
mid =
775 let mid = String.lowercase
mid in
782 suggest_member members mid
784 let get_construct env class_
=
785 add_wclass env (Cls.name class_
);
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
);
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
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
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
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
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
860 let genv = env.genv in
861 let genv = { genv with self
= x } in
864 let set_parent_id env x =
865 let genv = env.genv in
866 let genv = { genv with parent_id
= x } in
869 let set_parent env x =
870 let genv = env.genv in
871 let genv = { genv with parent
= x } in
875 let genv = env.genv in
876 let genv = { genv with static
= true } in
879 let set_val_kind env x =
880 let genv = env.genv in
881 let genv = { genv with val_kind
= x } in
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
=
897 (fun _id
{ counter
= ftys
; pos; _
} ->
898 let (untyped
, typed
) = !ftys
in
899 f
pos (untyped
@ typed
))
902 (*****************************************************************************)
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
=
917 | (_
, Tunion
[ty]) -> ty
920 match next_cont_opt env with
924 match LID.Map.get
x next_cont
.LEnvC.local_types
with
925 | None
-> Ident.tmp
()
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 =
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
} =
948 LEnvC.remove_from_cont
C.Next
local
949 @@ LEnvC.remove_from_cont
C.Catch
local
952 let local_using_vars = LID.Set.remove
local local_using_vars in
953 let local_mutability = LID.Map.remove
local local_mutability in
958 { per_cont_env; local_using_vars; local_mutability; local_reactive
};
963 let add_mutable_var env local mutability_type
=
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
976 let dynamic_view_enabled = TypecheckerOptions.dynamic_view
(get_tcopt env) in
977 if dynamic_view_enabled then
980 Typing_defs.make_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
=
993 let in_rx_scope = env_local_reactive env in
994 let lid = LID.to_string
x in
995 let suggest_most_similar lid =
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
)
1004 Errors.undefined ~
in_rx_scope p
lid (suggest_most_similar lid)
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)
1013 let lcl = LID.Map.get
x ctx
.LEnvC.local_types
in
1017 if not_found_is_ok x ctx
then
1020 error_if_pos_provided p ctx
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
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
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
1071 let get_local_expr_id env x =
1072 match next_cont_opt env with
1073 | None
-> (* dead code *) None
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
=
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
) =
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 =
1100 let (env, v'
) = get_var env v in
1101 (match IMap.get
v'
env.tenv
with
1104 let (env, ty) = update_ty env ty in
1105 let env = add env v ty in
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))
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 =
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
=
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
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
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 =
1152 let fake_members = get_fake_members env in
1153 let fake_id = Fake.make_id obj member_name
in
1155 match Fake.is_invalid
fake_members fake_id with
1158 update_lost_info (Local_id.to_string
fake_id) blame
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
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
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
)
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
)
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
1245 (* Parameters are treated contravariantly *)
1247 (env, ISet.union negative acc_positive
, ISet.union positive acc_negative
)
1248 (* Inout/ref parameters are both co- and contra-variant *)
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
1258 | Tvar
v -> (env, ISet.singleton
v, ISet.empty)
1266 (env, ISet.empty, ISet.empty)
1267 | Toption
ty -> get_tyvars env ty
1271 | Tdestructure tyl
->
1274 ~init
:(env, ISet.empty, ISet.empty)
1278 (fun _
{ sft_ty
; _
} res
-> get_tyvars_union res sft_ty
)
1280 (env, ISet.empty, ISet.empty)
1282 let (env, params_positive
, params_negative
) =
1283 match ft
.ft_arity
with
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
) =
1293 ~init
:(env, params_positive
, params_negative
)
1296 let (env, ret_positive
, ret_negative
) =
1297 get_tyvars env ft
.ft_ret
.et_type
1300 ISet.union ret_positive params_positive
,
1301 ISet.union ret_negative params_negative
)
1302 | Tabstract
(AKnewtype
(name, tyl
), _
) ->
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
) ->
1314 match get_class env cid
with
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)
1327 (env, ISet.empty, ISet.empty)
1329 | AKvarray_or_darray
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 ->
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
) =
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
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
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
=
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
=
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
1397 | LoclType
(_
, Tvar _
) -> env
1399 let (env, positive
, negative
) = get_tyvars_i
env ty in
1402 (fun var
env -> set_tyvar_appears_covariantly env var
)
1408 (fun var
env -> set_tyvar_appears_contravariantly
env var
)
1414 and update_variance_of_tyvars_occurring_in_upper_bound
env ty =
1415 let (env, ety
) = expand_internal_type env ty in
1417 | LoclType
(_
, Tvar _
) -> env
1419 let (env, positive
, negative
) = get_tyvars_i
env ty in
1422 (fun var
env -> set_tyvar_appears_contravariantly
env var
)
1428 (fun var
env -> set_tyvar_appears_covariantly env var
)
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
1451 if appears_contravariantly then
1452 set_tyvar_appears_contravariantly
env var
1456 if appears_covariantly then
1457 set_tyvar_appears_covariantly env var
1467 if appears_contravariantly then
1468 set_tyvar_appears_covariantly env var
1472 if appears_covariantly then
1473 set_tyvar_appears_contravariantly
env var
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
) =
1488 (negative
, positive
)
1490 (positive
, negative
)
1492 List.fold_left
tyvars ~init
:env ~f
:(fun env var
->
1494 if ISet.mem var positive
then
1495 set_tyvar_appears_covariantly env var
1500 if ISet.mem var negative
then
1501 set_tyvar_appears_contravariantly
env var
1507 let fresh_invariant_type_var env p
=
1508 let v = Ident.tmp
() in
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
1534 let tvinfo = get_tyvar_info env var
in
1536 match intersect
with
1537 | None
-> ITySet.add ty tvinfo.upper_bounds
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
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
1556 match expand_internal_type env ty with
1557 | (_
, LoclType
(_
, Tvar
v)) -> v <> upper_var
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
1572 match expand_internal_type env ty with
1573 | (_
, LoclType
(_
, Tvar
v)) -> v <> lower_var
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
1594 let tvinfo = get_tyvar_info env var
in
1597 | None
-> ITySet.add ty tvinfo.lower_bounds
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