diff --git a/src/typing/annotation_inference.ml b/src/typing/annotation_inference.ml index 15b4c96f368..bcd13dadea0 100644 --- a/src/typing/annotation_inference.ml +++ b/src/typing/annotation_inference.ml @@ -211,7 +211,7 @@ module rec ConsGen : S = struct let reason_op = AConstraint.display_reason_of_op op in error_internal_reason cx msg reason_op - let dummy_trace = Trace.dummy_trace + let dummy_trace = DepthTrace.dummy_trace (* Repositioning does not seem to have any perceptible impact in annotation * inference. Instead of replicating the convoluted implementation of Flow_js diff --git a/src/typing/check_polarity.ml b/src/typing/check_polarity.ml index 776391f1dea..1c8cff29d24 100644 --- a/src/typing/check_polarity.ml +++ b/src/typing/check_polarity.ml @@ -188,7 +188,7 @@ module Kit (Flow : Flow_common.S) : Flow_common.CHECK_POLARITY = struct else let out = Tvar.mk_no_wrap_where cx r (fun tvar -> - let trace = Base.Option.value trace ~default:Trace.dummy_trace in + let trace = Base.Option.value trace ~default:DepthTrace.dummy_trace in Flow.eval_destructor cx ~trace use_op r t ReadOnlyType tvar ) in diff --git a/src/typing/custom_fun_kit.ml b/src/typing/custom_fun_kit.ml index b066f993210..6ef8cf44923 100644 --- a/src/typing/custom_fun_kit.ml +++ b/src/typing/custom_fun_kit.ml @@ -13,7 +13,7 @@ open TypeUtil module type CUSTOM_FUN = sig val run : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> return_hint:Type.lazy_hint_t -> Reason.t -> diff --git a/src/typing/custom_fun_kit.mli b/src/typing/custom_fun_kit.mli index a1847df7285..514349107c5 100644 --- a/src/typing/custom_fun_kit.mli +++ b/src/typing/custom_fun_kit.mli @@ -8,7 +8,7 @@ module type CUSTOM_FUN = sig val run : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> return_hint:Type.lazy_hint_t -> Reason.t -> diff --git a/src/typing/debug_js.ml b/src/typing/debug_js.ml index ba1b4f00494..ca268b034c4 100644 --- a/src/typing/debug_js.ml +++ b/src/typing/debug_js.ml @@ -1997,10 +1997,11 @@ let dump_error_message = module Verbose = struct let print_if_verbose_lazy - cx ?(trace = Trace.dummy_trace) ?(delim = "") ?(indent = 0) (lines : string list Lazy.t) = + cx ?(trace = DepthTrace.dummy_trace) ?(delim = "") ?(indent = 0) (lines : string list Lazy.t) + = match Context.verbose cx with | Some { Verbose.indent = num_spaces; _ } when Context.is_verbose cx -> - let indent = max (indent + Trace.trace_depth trace - 1) 0 in + let indent = max (indent + DepthTrace.depth trace - 1) 0 in let prefix = String.make (indent * num_spaces) ' ' in let pid = Context.pid_prefix cx in let add_prefix line = spf "\n%s%s%s" prefix pid line in @@ -2009,7 +2010,7 @@ module Verbose = struct | _ -> () let print_if_verbose - cx ?(trace = Trace.dummy_trace) ?(delim = "") ?(indent = 0) (lines : string list) = + cx ?(trace = DepthTrace.dummy_trace) ?(delim = "") ?(indent = 0) (lines : string list) = if Context.is_verbose cx then print_if_verbose_lazy cx ~trace ~delim ~indent (lazy lines) let print_types_if_verbose cx trace ?(note : string option) ((l : Type.t), (u : Type.use_t)) = diff --git a/src/typing/debug_js.mli b/src/typing/debug_js.mli index 8ee3746b9e3..8729ff28d42 100644 --- a/src/typing/debug_js.mli +++ b/src/typing/debug_js.mli @@ -35,14 +35,19 @@ val dump_flow : ?depth:int -> Context.t -> Type.t * Type.use_t -> string module Verbose : sig val print_if_verbose_lazy : - Context.t -> ?trace:Type.trace -> ?delim:string -> ?indent:int -> string list Lazy.t -> unit + Context.t -> + ?trace:Type.DepthTrace.t -> + ?delim:string -> + ?indent:int -> + string list Lazy.t -> + unit val print_if_verbose : - Context.t -> ?trace:Type.trace -> ?delim:string -> ?indent:int -> string list -> unit + Context.t -> ?trace:Type.DepthTrace.t -> ?delim:string -> ?indent:int -> string list -> unit val print_types_if_verbose : - Context.t -> Type.trace -> ?note:string -> Type.t * Type.use_t -> unit + Context.t -> Type.DepthTrace.t -> ?note:string -> Type.t * Type.use_t -> unit val print_unify_types_if_verbose : - Context.t -> Type.trace -> ?note:string -> Type.t * Type.t -> unit + Context.t -> Type.DepthTrace.t -> ?note:string -> Type.t * Type.t -> unit end diff --git a/src/typing/flow_common.ml b/src/typing/flow_common.ml index 427eb1bacc1..94185826acb 100644 --- a/src/typing/flow_common.ml +++ b/src/typing/flow_common.ml @@ -11,7 +11,7 @@ open Type module type BASE = sig val flow : Context.t -> Type.t * Type.use_t -> unit - val flow_opt : Context.t -> ?trace:Type.trace -> Type.t * Type.use_t -> unit + val flow_opt : Context.t -> ?trace:Type.DepthTrace.t -> Type.t * Type.use_t -> unit val flow_p : Context.t -> @@ -26,36 +26,42 @@ module type BASE = sig val reposition : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> ALoc.t -> ?desc:reason_desc -> ?annot_loc:ALoc.t -> Type.t -> Type.t - val rec_flow : Context.t -> Type.trace -> Type.t * Type.use_t -> unit + val rec_flow : Context.t -> Type.DepthTrace.t -> Type.t * Type.use_t -> unit - val rec_flow_t : Context.t -> Type.trace -> use_op:Type.use_op -> Type.t * Type.t -> unit + val rec_flow_t : Context.t -> Type.DepthTrace.t -> use_op:Type.use_op -> Type.t * Type.t -> unit val rec_unify : - Context.t -> Type.trace -> use_op:Type.use_op -> ?unify_any:bool -> Type.t -> Type.t -> unit + Context.t -> + Type.DepthTrace.t -> + use_op:Type.use_op -> + ?unify_any:bool -> + Type.t -> + Type.t -> + unit val unify : Context.t -> ?use_op:Type.use_op -> Type.t -> Type.t -> unit val unify_opt : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> use_op:Type.use_op -> ?unify_any:bool -> Type.t -> Type.t -> unit - val filter_optional : Context.t -> ?trace:Type.trace -> reason -> Type.t -> Type.ident + val filter_optional : Context.t -> ?trace:Type.DepthTrace.t -> reason -> Type.t -> Type.ident val mk_typeapp_instance_annot : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -67,7 +73,7 @@ module type BASE = sig val mk_typeapp_instance : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -78,7 +84,7 @@ module type BASE = sig val resolve_id : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> ?fully_resolved:bool -> Type.ident -> @@ -91,7 +97,7 @@ end module type CHECK_POLARITY = sig val check_polarity : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> Type.typeparam Subst_name.Map.t -> Polarity.t -> Type.t -> @@ -100,13 +106,13 @@ end module type BUILTINS = sig val get_builtin_type : - Context.t -> ?trace:Type.trace -> Reason.reason -> ?use_desc:bool -> string -> Type.t + Context.t -> ?trace:Type.DepthTrace.t -> Reason.reason -> ?use_desc:bool -> string -> Type.t val get_builtin_typeapp : Context.t -> reason -> ?use_desc:bool -> string -> Type.t list -> Type.t val perform_read_prop_action : Context.t -> - Type.trace -> + Type.DepthTrace.t -> ALoc.t Type.virtual_use_op -> Type.propref -> Type.property_type -> @@ -125,11 +131,11 @@ module type SUBTYPING = sig Context.t -> Reason.reason -> Type.t -> Type.t list val reposition_reason : - Context.t -> ?trace:Type.trace -> Reason.reason -> ?use_desc:bool -> Type.t -> Type.t + Context.t -> ?trace:Type.DepthTrace.t -> Reason.reason -> ?use_desc:bool -> Type.t -> Type.t val eval_destructor : Context.t -> - trace:Type.trace -> + trace:Type.DepthTrace.t -> Type.use_op -> Reason.reason -> Type.t -> @@ -139,7 +145,7 @@ module type SUBTYPING = sig val multiflow_subtype : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:ALoc.t Type.virtual_use_op -> Reason.reason -> Type.call_arg list -> @@ -148,7 +154,7 @@ module type SUBTYPING = sig val flow_type_args : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:use_op -> reason -> reason -> @@ -158,7 +164,7 @@ module type SUBTYPING = sig val instantiate_this_class : Context.t -> - Type.trace -> + Type.DepthTrace.t -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> Type.t -> @@ -169,7 +175,7 @@ module type SUBTYPING = sig val instantiate_poly_with_targs : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.t -> @@ -182,7 +188,7 @@ module type SUBTYPING = sig val instantiate_poly : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -193,7 +199,7 @@ module type SUBTYPING = sig val mk_typeapp_of_poly : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -208,7 +214,7 @@ module type SUBTYPING = sig val mk_instance : Context.t -> ?type_t_kind:Type.type_t_kind -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> reason -> ?use_desc:bool -> Type.t -> @@ -218,7 +224,7 @@ end module type EVAL = sig val eval_selector : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> annot:bool -> reason -> Type.t -> @@ -229,7 +235,7 @@ module type EVAL = sig val mk_type_destructor : Context.t -> - trace:Type.trace -> + trace:Type.DepthTrace.t -> use_op -> reason -> Type.t -> @@ -243,11 +249,17 @@ end module type REACT = sig val react_subtype_class_component_render : - Context.t -> Type.trace -> use_op:Type.use_op -> Type.t -> reason_op:reason -> Type.t -> unit + Context.t -> + Type.DepthTrace.t -> + use_op:Type.use_op -> + Type.t -> + reason_op:reason -> + Type.t -> + unit val react_get_config : Context.t -> - Type.trace -> + Type.DepthTrace.t -> Type.t -> use_op:ALoc.t Type.virtual_use_op -> reason_op:Reason.reason -> diff --git a/src/typing/flow_js.ml b/src/typing/flow_js.ml index 040a0e7a95c..9c1b0cd28ef 100644 --- a/src/typing/flow_js.ml +++ b/src/typing/flow_js.ml @@ -61,14 +61,14 @@ module Cache = Flow_cache module RecursionCheck : sig exception LimitExceeded - val check : Context.t -> Type.trace -> unit + val check : Context.t -> Type.DepthTrace.t -> unit end = struct exception LimitExceeded (* check trace depth as a proxy for recursion depth and throw when limit is exceeded *) let check cx trace = - if Trace.trace_depth trace >= Context.recursion_limit cx then raise LimitExceeded + if DepthTrace.depth trace >= Context.recursion_limit cx then raise LimitExceeded end (* The main problem with constant folding is infinite recursion. Consider a loop @@ -257,14 +257,14 @@ struct Flow_js_utils.Import_export_helper_sig with type r = Type.t -> unit = struct type r = Type.t -> unit - let reposition = FlowJs.reposition ~trace:Trace.dummy_trace ?desc:None ?annot_loc:None + let reposition = FlowJs.reposition ~trace:DepthTrace.dummy_trace ?desc:None ?annot_loc:None - let return cx t tout = FlowJs.rec_flow_t cx ~use_op:unknown_use Trace.dummy_trace (t, tout) + let return cx t tout = FlowJs.rec_flow_t cx ~use_op:unknown_use DepthTrace.dummy_trace (t, tout) let export_named cx (reason, value_exports_tmap, type_exports_tmap, export_kind) module_t tout = FlowJs.rec_flow cx - Trace.dummy_trace + DepthTrace.dummy_trace ( module_t, Type.ExportNamedT { reason; value_exports_tmap; type_exports_tmap; export_kind; tout } ) @@ -274,7 +274,7 @@ struct Tvar.mk_where cx reason (fun tout -> FlowJs.rec_flow cx - Trace.dummy_trace + DepthTrace.dummy_trace ( module_t, Type.ExportNamedT { reason; value_exports_tmap; type_exports_tmap; export_kind; tout } ) @@ -285,7 +285,7 @@ struct Tvar.mk_where cx reason (fun tout -> FlowJs.rec_flow cx - Trace.dummy_trace + DepthTrace.dummy_trace ( export_t, ExportTypeT { reason; name_loc; preferred_def_locs; export_name; target_module_t; tout } @@ -296,7 +296,7 @@ struct Tvar.mk_where cx reason (fun t -> FlowJs.rec_flow cx - Trace.dummy_trace + DepthTrace.dummy_trace (proto_t, CJSExtractNamedExportsT (reason, local_module, t)) ) end @@ -7921,7 +7921,7 @@ struct match Eval.Map.find_opt id evaluated with | Some _ -> () | None -> - let trace = Trace.dummy_trace in + let trace = DepthTrace.dummy_trace in if Tvar_resolver.has_unresolved_tvars cx t || Tvar_resolver.has_unresolved_tvars_in_destructors cx d @@ -9036,7 +9036,7 @@ struct if not opt then add_upper cx t2 trace bounds1; iter_with_filter cx bounds1.lowertvars id1 (fun (_, bounds) (trace_l, use_op) -> let t2 = flow_use_op cx use_op t2 in - add_upper cx t2 (Trace.concat_trace [trace_l; trace]) bounds + add_upper cx t2 (DepthTrace.concat_trace [trace_l; trace]) bounds ) (** Given [edges_from_t t1 (id2, bounds2)], for each [id] in [id2] + [bounds2.uppertvars], @@ -9048,7 +9048,7 @@ struct if not opt then add_lower t1 (trace, new_use_op) bounds2; iter_with_filter cx bounds2.uppertvars id2 (fun (_, bounds) (trace_u, use_op) -> let use_op = pick_use_op cx new_use_op use_op in - add_lower t1 (Trace.concat_trace [trace; trace_u], use_op) bounds + add_lower t1 (DepthTrace.concat_trace [trace; trace_u], use_op) bounds ) (** for each [id'] in [id] + [bounds.lowertvars], [id'.bounds.upper += us] *) @@ -9056,7 +9056,7 @@ struct us |> UseTypeMap.iter (fun (u, _) trace_u -> let u = flow_use_op cx new_use_op u in - edges_to_t cx (Trace.concat_trace [trace; trace_u]) ~opt (id, bounds) u + edges_to_t cx (DepthTrace.concat_trace [trace; trace_u]) ~opt (id, bounds) u ) (** for each [id'] in [id] + [bounds.uppertvars], [id'.bounds.lower += ls] *) @@ -9064,7 +9064,7 @@ struct ls |> TypeMap.iter (fun l (trace_l, use_op) -> let new_use_op = pick_use_op cx use_op new_use_op in - edges_from_t cx (Trace.concat_trace [trace_l; trace]) ~new_use_op ~opt l (id, bounds) + edges_from_t cx (DepthTrace.concat_trace [trace_l; trace]) ~new_use_op ~opt l (id, bounds) ) (** for each [id] in [id1] + [bounds1.lowertvars]: @@ -9119,7 +9119,7 @@ struct if not opt then add_uppertvar id2 trace new_use_op bounds1; iter_with_filter cx bounds1.lowertvars id1 (fun (_, bounds) (trace_l, use_op) -> let use_op = pick_use_op cx use_op new_use_op in - add_uppertvar id2 (Trace.concat_trace [trace_l; trace]) use_op bounds + add_uppertvar id2 (DepthTrace.concat_trace [trace_l; trace]) use_op bounds ) (** for each id in id2 + bounds2.uppertvars: @@ -9133,7 +9133,7 @@ struct if not opt then add_lowertvar id1 trace new_use_op bounds2; iter_with_filter cx bounds2.uppertvars id2 (fun (_, bounds) (trace_u, use_op) -> let use_op = pick_use_op cx new_use_op use_op in - add_lowertvar id1 (Trace.concat_trace [trace; trace_u]) use_op bounds + add_lowertvar id1 (DepthTrace.concat_trace [trace; trace_u]) use_op bounds ) (** for each id in id1 + bounds1.lowertvars: @@ -9145,7 +9145,7 @@ struct edges_to_tvar cx trace ~new_use_op ~opt (id1, bounds1) id2; iter_with_filter cx bounds2.uppertvars id2 (fun (tvar, _) (trace_u, use_op) -> let new_use_op = pick_use_op cx new_use_op use_op in - let trace = Trace.concat_trace [trace; trace_u] in + let trace = DepthTrace.concat_trace [trace; trace_u] in edges_to_tvar cx trace ~new_use_op ~opt (id1, bounds1) tvar ) @@ -9158,7 +9158,7 @@ struct edges_from_tvar cx trace ~new_use_op ~opt id1 (id2, bounds2); iter_with_filter cx bounds1.lowertvars id1 (fun (tvar, _) (trace_l, use_op) -> let use_op = pick_use_op cx use_op new_use_op in - let trace = Trace.concat_trace [trace_l; trace] in + let trace = DepthTrace.concat_trace [trace_l; trace] in edges_from_tvar cx trace ~new_use_op:use_op ~opt tvar (id2, bounds2) ) @@ -10026,7 +10026,7 @@ struct ~printer: (print_if_verbose_lazy cx - ~trace:(Base.Option.value trace ~default:Trace.dummy_trace) + ~trace:(Base.Option.value trace ~default:DepthTrace.dummy_trace) ) generic_state generic @@ -10554,8 +10554,8 @@ struct let use_op = unknown_use in let trace = match trace with - | None -> Trace.unit_trace - | Some trace -> Trace.rec_trace trace + | None -> DepthTrace.unit_trace + | Some trace -> DepthTrace.rec_trace trace in let (_, id) = open_tvar tvar in resolve_id cx trace ~use_op ~fully_resolved id t' @@ -10664,14 +10664,14 @@ struct propagates bounds across type variables, where nothing interesting is going on other than concatenating subtraces to make longer traces to describe transitive data flows *) - and join_flow cx ts (t1, t2) = __flow cx (t1, t2) (Trace.concat_trace ts) + and join_flow cx ts (t1, t2) = __flow cx (t1, t2) (DepthTrace.concat_trace ts) (* Call __flow while embedding traces. Typically this is used in code that simplifies a constraint to generate subconstraints: the current trace is "pushed" when recursing into the subconstraints, so that when we finally hit an error and walk back, we can know why the particular constraints that caused the immediate error were generated. *) - and rec_flow cx trace (t1, t2) = __flow cx (t1, t2) (Trace.rec_trace trace) + and rec_flow cx trace (t1, t2) = __flow cx (t1, t2) (DepthTrace.rec_trace trace) and rec_flow_t cx trace ~use_op (t1, t2) = rec_flow cx trace (t1, UseT (use_op, t2)) @@ -10683,8 +10683,8 @@ struct and flow_opt cx ?trace (t1, t2) = let trace = match trace with - | None -> Trace.unit_trace - | Some trace -> Trace.rec_trace trace + | None -> DepthTrace.unit_trace + | Some trace -> DepthTrace.rec_trace trace in __flow cx (t1, t2) trace @@ -10717,13 +10717,13 @@ struct (* Wrapper functions around __unify that manage traces. Use these functions for all recursive calls in the implementation of __unify. *) and rec_unify cx trace ~use_op ?(unify_any = false) t1 t2 = - __unify cx ~use_op ~unify_any t1 t2 (Trace.rec_trace trace) + __unify cx ~use_op ~unify_any t1 t2 (DepthTrace.rec_trace trace) and unify_opt cx ?trace ~use_op ?(unify_any = false) t1 t2 = let trace = match trace with - | None -> Trace.unit_trace - | Some trace -> Trace.rec_trace trace + | None -> DepthTrace.unit_trace + | Some trace -> DepthTrace.rec_trace trace in __unify cx ~use_op ~unify_any t1 t2 trace @@ -10794,7 +10794,7 @@ struct match SpeculationKit.try_singleton_throw_on_failure cx - Trace.dummy_trace + DepthTrace.dummy_trace (TypeUtil.reason_of_t l) ~upper_unresolved:false l @@ -10941,7 +10941,7 @@ let mk_default cx reason = (* Export some functions without the trace parameter *) let resolve_id cx id t = - resolve_id cx Trace.dummy_trace ~use_op:unknown_use ~fully_resolved:true id t + resolve_id cx DepthTrace.dummy_trace ~use_op:unknown_use ~fully_resolved:true id t let mk_instance cx ?type_t_kind instance_reason ?use_desc c = mk_instance ?type_t_kind cx instance_reason ?use_desc c @@ -10958,7 +10958,7 @@ let mk_typeapp_instance_annot cx ~use_op ~reason_op ~reason_tapp ~from_value ?ca mk_typeapp_instance_annot cx ~use_op ~reason_op ~reason_tapp ~from_value ?cache c ts let mk_type_destructor cx use_op reason t d id = - mk_type_destructor cx ~trace:Trace.dummy_trace use_op reason t d id + mk_type_destructor cx ~trace:DepthTrace.dummy_trace use_op reason t d id let check_polarity cx tparams polarity t = check_polarity cx tparams polarity t diff --git a/src/typing/flow_js_utils.ml b/src/typing/flow_js_utils.ml index 0dd50ac12c4..7311accf23e 100644 --- a/src/typing/flow_js_utils.ml +++ b/src/typing/flow_js_utils.ml @@ -586,11 +586,11 @@ let remove_predicate_from_union reason cx predicate = let iter_union : 't. - f:(Context.t -> Type.trace -> Type.t * Type.use_t -> 't) -> + f:(Context.t -> Type.DepthTrace.t -> Type.t * Type.use_t -> 't) -> init:'t -> join:('t -> 't -> 't) -> Context.t -> - Type.trace -> + Type.DepthTrace.t -> Type.UnionRep.t -> Type.use_t -> 't = @@ -999,7 +999,7 @@ let fix_this_instance cx reason (reason_i, i, is_this, this_name) = module type Instantiation_helper_sig = sig val cache_instantiate : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> ?cache:bool -> Type.typeparam -> @@ -1008,11 +1008,11 @@ module type Instantiation_helper_sig = sig Type.t -> Type.t - val reposition : Context.t -> ?trace:Type.trace -> ALoc.t -> Type.t -> Type.t + val reposition : Context.t -> ?trace:Type.DepthTrace.t -> ALoc.t -> Type.t -> Type.t - val is_subtype : Context.t -> Type.trace -> use_op:use_op -> Type.t * Type.t -> unit + val is_subtype : Context.t -> Type.DepthTrace.t -> use_op:use_op -> Type.t * Type.t -> unit - val unify : Context.t -> Type.trace -> use_op:use_op -> Type.t * Type.t -> unit + val unify : Context.t -> Type.DepthTrace.t -> use_op:use_op -> Type.t * Type.t -> unit val mk_targ : Context.t -> Type.typeparam -> Reason.t -> Reason.t -> Type.t end @@ -2070,30 +2070,31 @@ let type_of_key_name cx name reason = module type Get_prop_helper_sig = sig type r - val dict_read_check : Context.t -> Type.trace -> use_op:Type.use_op -> Type.t * Type.t -> unit + val dict_read_check : + Context.t -> Type.DepthTrace.t -> use_op:Type.use_op -> Type.t * Type.t -> unit val cg_lookup : Context.t -> - Type.trace -> + Type.DepthTrace.t -> obj_t:Type.t -> method_accessible:bool -> Type.t -> Reason.reason * Type.lookup_kind * Type.propref * use_op * Type.Properties.Set.t -> r - val reposition : Context.t -> ?trace:Type.trace -> ALoc.t -> Type.t -> Type.t + val reposition : Context.t -> ?trace:Type.DepthTrace.t -> ALoc.t -> Type.t -> Type.t val mk_react_dro : Context.t -> use_op -> ALoc.t * Type.dro_type -> Type.t -> Type.t val mk_hooklike : Context.t -> use_op -> Type.t -> Type.t - val return : Context.t -> use_op:use_op -> Type.trace -> Type.t -> r + val return : Context.t -> use_op:use_op -> Type.DepthTrace.t -> Type.t -> r - val error_type : Context.t -> Type.trace -> Reason.t -> r + val error_type : Context.t -> Type.DepthTrace.t -> Reason.t -> r val cg_get_prop : Context.t -> - Type.trace -> + Type.DepthTrace.t -> Type.t -> use_op * reason * Type.ident option * (Reason.t * Reason.name) -> r diff --git a/src/typing/implicit_instantiation.ml b/src/typing/implicit_instantiation.ml index ac21579ec56..af802f0ca97 100644 --- a/src/typing/implicit_instantiation.ml +++ b/src/typing/implicit_instantiation.ml @@ -70,7 +70,7 @@ module type S = sig val solve_conditional_type_targs : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason:Reason.reason -> tparams:Type.typeparam list -> @@ -1399,7 +1399,7 @@ module type KIT = sig Implicit_instantiation_check.t -> return_hint:Type.lazy_hint_t -> ?cache:bool -> - trace -> + Type.DepthTrace.t -> use_op:use_op -> reason_op:reason -> reason_tapp:reason -> @@ -1407,7 +1407,7 @@ module type KIT = sig val run_monomorphize : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -1417,7 +1417,7 @@ module type KIT = sig val run_conditional : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason:Reason.reason -> tparams:Type.typeparam list -> diff --git a/src/typing/implicit_instantiation.mli b/src/typing/implicit_instantiation.mli index 05d0fbab060..3a7410bdd03 100644 --- a/src/typing/implicit_instantiation.mli +++ b/src/typing/implicit_instantiation.mli @@ -58,7 +58,7 @@ module type S = sig val solve_conditional_type_targs : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason:Reason.reason -> tparams:Type.typeparam list -> @@ -95,7 +95,7 @@ module type KIT = sig Implicit_instantiation_check.t -> return_hint:Type.lazy_hint_t -> ?cache:bool -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -103,7 +103,7 @@ module type KIT = sig val run_monomorphize : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason_op:Reason.reason -> reason_tapp:Reason.reason -> @@ -113,7 +113,7 @@ module type KIT = sig val run_conditional : Context.t -> - Type.trace -> + Type.DepthTrace.t -> use_op:Type.use_op -> reason:Reason.reason -> tparams:Type.typeparam list -> diff --git a/src/typing/object_kit.ml b/src/typing/object_kit.ml index 83b9ea90677..24f0028bd31 100644 --- a/src/typing/object_kit.ml +++ b/src/typing/object_kit.ml @@ -11,7 +11,7 @@ open TypeUtil module type OBJECT = sig val run : - Type.trace -> + Type.DepthTrace.t -> Context.t -> Type.use_op -> Reason.t -> @@ -23,7 +23,7 @@ module type OBJECT = sig val mapped_type_of_keys : Context.t -> - Type.trace -> + Type.DepthTrace.t -> Type.use_op -> Reason.t -> keys:Type.t -> diff --git a/src/typing/react_kit.ml b/src/typing/react_kit.ml index 91db9a0d8fe..c8aca24f742 100644 --- a/src/typing/react_kit.ml +++ b/src/typing/react_kit.ml @@ -11,16 +11,23 @@ open TypeUtil open React module type REACT = sig - val run : Context.t -> Type.trace -> use_op:use_op -> reason -> Type.t -> Type.React.tool -> unit + val run : + Context.t -> Type.DepthTrace.t -> use_op:use_op -> reason -> Type.t -> Type.React.tool -> unit val component_class : Context.t -> Reason.reason -> Type.t -> Type.t val subtype_class_component_render : - Context.t -> Type.trace -> use_op:Type.use_op -> Type.t -> reason_op:reason -> Type.t -> unit + Context.t -> + Type.DepthTrace.t -> + use_op:Type.use_op -> + Type.t -> + reason_op:reason -> + Type.t -> + unit val get_config : Context.t -> - Type.trace -> + Type.DepthTrace.t -> Type.t -> use_op:use_op -> reason_op:reason -> diff --git a/src/typing/speculation_flow.ml b/src/typing/speculation_flow.ml index 3fcbe14e56c..63fb6cbec7c 100644 --- a/src/typing/speculation_flow.ml +++ b/src/typing/speculation_flow.ml @@ -11,7 +11,7 @@ module SpeculationKit = Speculation_kit.Make (Flow_js.FlowJs) let flow_t_unsafe cx reason ~upper_unresolved (l, u) = SpeculationKit.try_singleton_throw_on_failure cx - Trace.dummy_trace + DepthTrace.dummy_trace ~upper_unresolved reason l @@ -19,7 +19,13 @@ let flow_t_unsafe cx reason ~upper_unresolved (l, u) = let is_flow_successful cx reason ~upper_unresolved t u = match - SpeculationKit.try_singleton_throw_on_failure cx Trace.dummy_trace reason ~upper_unresolved t u + SpeculationKit.try_singleton_throw_on_failure + cx + DepthTrace.dummy_trace + reason + ~upper_unresolved + t + u with | exception Flow_js_utils.SpeculationSingletonError -> false | () -> true diff --git a/src/typing/speculation_kit.ml b/src/typing/speculation_kit.ml index 2a9a19932f6..f2ef555ba41 100644 --- a/src/typing/speculation_kit.ml +++ b/src/typing/speculation_kit.ml @@ -18,14 +18,20 @@ end module type OUTPUT = sig val try_union : - Context.t -> Type.trace -> Type.use_op -> Type.t -> Reason.reason -> Type.UnionRep.t -> unit + Context.t -> + Type.DepthTrace.t -> + Type.use_op -> + Type.t -> + Reason.reason -> + Type.UnionRep.t -> + unit val try_intersection : - Context.t -> Type.trace -> Type.use_t -> Reason.reason -> Type.InterRep.t -> unit + Context.t -> Type.DepthTrace.t -> Type.use_t -> Reason.reason -> Type.InterRep.t -> unit val try_singleton_throw_on_failure : Context.t -> - Type.trace -> + Type.DepthTrace.t -> Reason.reason -> upper_unresolved:bool -> Type.t -> @@ -34,7 +40,7 @@ module type OUTPUT = sig val prep_try_intersection : Context.t -> - Type.trace -> + Type.DepthTrace.t -> reason -> Type.t list -> Type.t list -> @@ -44,10 +50,10 @@ module type OUTPUT = sig unit val fully_resolve_type : - Context.t -> Type.trace -> reason -> Graph_explorer.Tbl.key -> Type.t -> unit + Context.t -> Type.DepthTrace.t -> reason -> Graph_explorer.Tbl.key -> Type.t -> unit val speculative_matches : - Context.t -> Type.trace -> ALoc.t Reason.virtual_reason -> int -> Type.spec -> unit + Context.t -> Type.DepthTrace.t -> ALoc.t Reason.virtual_reason -> int -> Type.spec -> unit val intersection_preprocess_kit : reason -> Type.intersection_preprocess_tool -> Type.use_t end diff --git a/src/typing/subtyping_kit.ml b/src/typing/subtyping_kit.ml index cdd88daa6b5..c84fee62d31 100644 --- a/src/typing/subtyping_kit.ml +++ b/src/typing/subtyping_kit.ml @@ -26,11 +26,11 @@ module type INPUT = sig end module type OUTPUT = sig - val rec_sub_t : Context.t -> Type.use_op -> Type.t -> Type.t -> Type.trace -> unit + val rec_sub_t : Context.t -> Type.use_op -> Type.t -> Type.t -> Type.DepthTrace.t -> unit val rec_flow_p : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> use_op:use_op -> ?report_polarity:bool -> reason -> diff --git a/src/typing/subtyping_kit.mli b/src/typing/subtyping_kit.mli index 57900da8039..3ad8227c6a9 100644 --- a/src/typing/subtyping_kit.mli +++ b/src/typing/subtyping_kit.mli @@ -18,11 +18,11 @@ module type INPUT = sig end module type OUTPUT = sig - val rec_sub_t : Context.t -> Type.use_op -> Type.t -> Type.t -> Type.trace -> unit + val rec_sub_t : Context.t -> Type.use_op -> Type.t -> Type.t -> Type.DepthTrace.t -> unit val rec_flow_p : Context.t -> - ?trace:Type.trace -> + ?trace:Type.DepthTrace.t -> use_op:Type.use_op -> ?report_polarity:bool -> Reason.reason -> diff --git a/src/typing/trace.ml b/src/typing/trace.ml deleted file mode 100644 index 80c49414be3..00000000000 --- a/src/typing/trace.ml +++ /dev/null @@ -1,20 +0,0 @@ -(* - * Copyright (c) Meta Platforms, Inc. and affiliates. - * - * This source code is licensed under the MIT license found in the - * LICENSE file in the root directory of this source tree. - *) - -let trace_depth n = n - -let dummy_trace = 0 - -let unit_trace = 1 - -let rec_trace parent = - let parent_depth = trace_depth parent in - parent_depth + 1 - -let concat_trace ts = - let d = List.fold_left (fun acc d -> Base.Int.max acc d) 0 ts in - d diff --git a/src/typing/trace.mli b/src/typing/trace.mli deleted file mode 100644 index 6c052850231..00000000000 --- a/src/typing/trace.mli +++ /dev/null @@ -1,16 +0,0 @@ -(* - * Copyright (c) Meta Platforms, Inc. and affiliates. - * - * This source code is licensed under the MIT license found in the - * LICENSE file in the root directory of this source tree. - *) - -val trace_depth : Type.trace -> int - -val unit_trace : Type.trace - -val rec_trace : Type.trace -> Type.trace - -val concat_trace : Type.trace list -> Type.trace - -val dummy_trace : Type.trace diff --git a/src/typing/type.ml b/src/typing/type.ml index fa2b3a5df87..dac2df4493a 100644 --- a/src/typing/type.ml +++ b/src/typing/type.ml @@ -1856,11 +1856,35 @@ module rec TypeTerm : sig | MappedTypeKind | RenderTypeKind (* T/U in renders T/renders (T | U). Render types do not require type arguments for polymorphic components *) - - type trace = int end = TypeTerm +and DepthTrace : sig + type t + + val depth : t -> int + + val dummy_trace : t + + val unit_trace : t + + val rec_trace : t -> t + + val concat_trace : t list -> t +end = struct + type t = int + + let depth d = d + + let dummy_trace = 0 + + let unit_trace = 1 + + let rec_trace parent_depth = parent_depth + 1 + + let concat_trace ts = List.fold_left (fun acc d -> Base.Int.max acc d) 0 ts +end + and UnionEnum : sig type t = (* TODO this should not allow internal names *) @@ -3283,10 +3307,10 @@ module Constraint = struct The use_op in the lower TypeMap represents the use_op when a lower bound was added. *) and bounds = { - mutable lower: (TypeTerm.trace * TypeTerm.use_op) TypeMap.t; - mutable upper: TypeTerm.trace UseTypeMap.t; - mutable lowertvars: (TypeTerm.trace * TypeTerm.use_op) IMap.t; - mutable uppertvars: (TypeTerm.trace * TypeTerm.use_op) IMap.t; + mutable lower: (DepthTrace.t * TypeTerm.use_op) TypeMap.t; + mutable upper: DepthTrace.t UseTypeMap.t; + mutable lowertvars: (DepthTrace.t * TypeTerm.use_op) IMap.t; + mutable uppertvars: (DepthTrace.t * TypeTerm.use_op) IMap.t; } include Union_find.Make (struct diff --git a/src/typing/type_operation_utils.ml b/src/typing/type_operation_utils.ml index e6b176f340e..47bfc1407b6 100644 --- a/src/typing/type_operation_utils.ml +++ b/src/typing/type_operation_utils.ml @@ -80,7 +80,7 @@ module Import_export = struct let assert_import_is_value cx reason name export_t = Flow.FlowJs.flow_opt cx - ~trace:Trace.dummy_trace + ~trace:DepthTrace.dummy_trace (export_t, AssertImportIsValueT (reason, name)) in let with_concretized_type cx r f t =