hphp/hack/src/typing/typing_utils.ml

   1 (*
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Hh_prelude
  11 open Common
  12 open Typing_defs
  13 open Typing_env_types
  14 module SN = Naming_special_names
  15 module Reason = Typing_reason
  16 module Env = Typing_env
  17 module ShapeMap = Aast.ShapeMap
  18 module TySet = Typing_set
  19 module Cls = Decl_provider.Class
  20 module MakeType = Typing_make_type
  21
  22 (*****************************************************************************)
  23 (* Importing what is necessary *)
  24 (*****************************************************************************)
  25 let not_implemented s _ =
  26   failwith (Printf.sprintf "Function %s not implemented" s)
  27
  28 type expand_typedef =
  29   expand_env -> env -> Reason.t -> string -> locl_ty list -> env * locl_ty
  30
  31 let (expand_typedef_ref : expand_typedef ref) =
  32   ref (not_implemented "expand_typedef")
  33
  34 let expand_typedef x = !expand_typedef_ref x
  35
  36 type sub_type =
  37   env ->
  38   ?coerce:Typing_logic.coercion_direction option ->
  39   locl_ty ->
  40   locl_ty ->
  41   Errors.typing_error_callback ->
  42   env
  43
  44 let (sub_type_ref : sub_type ref) = ref (not_implemented "sub_type")
  45
  46 let sub_type x = !sub_type_ref x
  47
  48 type sub_type_i =
  49   env -> internal_type -> internal_type -> Errors.typing_error_callback -> env
  50
  51 let (sub_type_i_ref : sub_type_i ref) = ref (not_implemented "sub_type_i")
  52
  53 let sub_type_i x = !sub_type_i_ref x
  54
  55 type sub_type_with_dynamic_as_bottom =
  56   env -> locl_ty -> locl_ty -> Errors.typing_error_callback -> env
  57
  58 let (sub_type_with_dynamic_as_bottom_ref : sub_type_with_dynamic_as_bottom ref)
  59     =
  60   ref (not_implemented "sub_type_with_dynamic_as_bottom")
  61
  62 let sub_type_with_dynamic_as_bottom x = !sub_type_with_dynamic_as_bottom_ref x
  63
  64 type is_sub_type_type = env -> locl_ty -> locl_ty -> bool
  65
  66 type is_sub_type_i_type = env -> internal_type -> internal_type -> bool
  67
  68 let (is_sub_type_ref : is_sub_type_type ref) =
  69   ref (not_implemented "is_sub_type")
  70
  71 let is_sub_type x = !is_sub_type_ref x
  72
  73 let (is_sub_type_for_coercion_ref : is_sub_type_type ref) =
  74   ref (not_implemented "is_sub_type_for_coercion")
  75
  76 let is_sub_type_for_coercion x = !is_sub_type_for_coercion_ref x
  77
  78 let (is_sub_type_for_union_ref :
  79       (env ->
  80       ?coerce:Typing_logic.coercion_direction option ->
  81       locl_ty ->
  82       locl_ty ->
  83       bool)
  84       ref) =
  85   ref (not_implemented "is_sub_type_for_union")
  86
  87 let is_sub_type_for_union x = !is_sub_type_for_union_ref x
  88
  89 let (is_sub_type_for_union_i_ref :
  90       (env ->
  91       ?coerce:Typing_logic.coercion_direction option ->
  92       internal_type ->
  93       internal_type ->
  94       bool)
  95       ref) =
  96   ref (not_implemented "is_sub_type_for_union_i")
  97
  98 let is_sub_type_for_union_i x = !is_sub_type_for_union_i_ref x
  99
 100 let (is_sub_type_ignore_generic_params_ref : is_sub_type_type ref) =
 101   ref (not_implemented "is_sub_type_ignore_generic_params")
 102
 103 let is_sub_type_ignore_generic_params x =
 104   !is_sub_type_ignore_generic_params_ref x
 105
 106 type add_constraint =
 107   Pos.Map.key -> env -> Ast_defs.constraint_kind -> locl_ty -> locl_ty -> env
 108
 109 let (add_constraint_ref : add_constraint ref) =
 110   ref (not_implemented "add_constraint")
 111
 112 let add_constraint x = !add_constraint_ref x
 113
 114 type expand_typeconst =
 115   expand_env ->
 116   env ->
 117   ?ignore_errors:bool ->
 118   ?as_tyvar_with_cnstr:bool ->
 119   locl_ty ->
 120   Aast.sid ->
 121   root_pos:Pos.t ->
 122   on_error:Errors.typing_error_callback ->
 123   allow_abstract_tconst:bool ->
 124   env * locl_ty
 125
 126 let (expand_typeconst_ref : expand_typeconst ref) =
 127   ref (not_implemented "expand_typeconst")
 128
 129 let expand_typeconst x = !expand_typeconst_ref x
 130
 131 type union = env -> locl_ty -> locl_ty -> env * locl_ty
 132
 133 let (union_ref : union ref) = ref (not_implemented "union")
 134
 135 let union x = !union_ref x
 136
 137 type make_union =
 138   env ->
 139   Reason.t ->
 140   locl_ty list ->
 141   Reason.t option ->
 142   Reason.t option ->
 143   env * locl_ty
 144
 145 let (make_union_ref : make_union ref) = ref (not_implemented "make_union")
 146
 147 let make_union env = !make_union_ref env
 148
 149 type union_i =
 150   env -> Reason.t -> internal_type -> locl_ty -> env * internal_type
 151
 152 let (union_i_ref : union_i ref) = ref (not_implemented "union")
 153
 154 let union_i x = !union_i_ref x
 155
 156 type union_list = env -> Reason.t -> locl_ty list -> env * locl_ty
 157
 158 let (union_list_ref : union_list ref) = ref (not_implemented "union_list")
 159
 160 let union_list x = !union_list_ref x
 161
 162 type fold_union = env -> Reason.t -> locl_ty list -> env * locl_ty
 163
 164 let (fold_union_ref : fold_union ref) = ref (not_implemented "fold_union")
 165
 166 let fold_union x = !fold_union_ref x
 167
 168 type simplify_unions =
 169   env ->
 170   ?on_tyvar:(env -> Reason.t -> Ident.t -> env * locl_ty) ->
 171   locl_ty ->
 172   env * locl_ty
 173
 174 let (simplify_unions_ref : simplify_unions ref) =
 175   ref (not_implemented "simplify_unions")
 176
 177 let simplify_unions x = !simplify_unions_ref x
 178
 179 type approx =
 180   | ApproxUp
 181   | ApproxDown
 182 [@@deriving eq]
 183
 184 type non = env -> Reason.t -> locl_ty -> approx:approx -> env * locl_ty
 185
 186 let (non_ref : non ref) = ref (not_implemented "non")
 187
 188 let non x = !non_ref x
 189
 190 type simplify_intersections =
 191   env ->
 192   ?on_tyvar:(env -> Reason.t -> int -> env * locl_ty) ->
 193   locl_ty ->
 194   env * locl_ty
 195
 196 let (simplify_intersections_ref : simplify_intersections ref) =
 197   ref (not_implemented "simplify_intersections")
 198
 199 let simplify_intersections x = !simplify_intersections_ref x
 200
 201 type localize_with_self =
 202   env ->
 203   ?pos:Pos.t ->
 204   ?quiet:bool ->
 205   ?report_cycle:Pos.t * string ->
 206   decl_ty ->
 207   env * locl_ty
 208
 209 let (localize_with_self_ref : localize_with_self ref) =
 210   ref (not_implemented "localize_with_self")
 211
 212 let localize_with_self x = !localize_with_self_ref x
 213
 214 type localize = ety_env:expand_env -> env -> decl_ty -> env * locl_ty
 215
 216 let (localize_ref : localize ref) =
 217   ref (fun ~ety_env:_ -> not_implemented "localize")
 218
 219 let localize x = !localize_ref x
 220
 221 type env_with_self =
 222   ?pos:Pos.t -> ?quiet:bool -> ?report_cycle:Pos.t * string -> env -> expand_env
 223
 224 let env_with_self_ref : env_with_self ref =
 225   ref (fun ?pos:_ ?quiet:_ ?report_cycle:_ -> not_implemented "env_with_self")
 226
 227 let env_with_self ?pos ?quiet ?report_cycle x =
 228   !env_with_self_ref ?pos ?quiet ?report_cycle x
 229
 230 let rec strip_this ty =
 231   match get_node ty with
 232   | Tdependent (DTthis, ty) -> ty
 233   | Tunion tyl -> mk (get_reason ty, Tunion (List.map tyl strip_this))
 234   | Tintersection tyl ->
 235     mk (get_reason ty, Tintersection (List.map tyl strip_this))
 236   | _ -> ty
 237
 238 (* Convenience function for creating `this` types *)
 239 let this_of ty = Tdependent (DTthis, strip_this ty)
 240
 241 (*****************************************************************************)
 242 (* Returns true if a type is optional *)
 243 (*****************************************************************************)
 244
 245 let is_option env ty =
 246   let null = MakeType.null Reason.Rnone in
 247   is_sub_type_for_union env null ty
 248
 249 let is_mixed_i env ty =
 250   let mixed = LoclType (MakeType.mixed Reason.Rnone) in
 251   is_sub_type_for_union_i env mixed ty
 252
 253 let is_mixed env ty = is_mixed_i env (LoclType ty)
 254
 255 let is_nothing_i env ty =
 256   let nothing = LoclType (MakeType.nothing Reason.Rnone) in
 257   is_sub_type_for_union_i env ty nothing
 258
 259 let is_nothing env ty = is_nothing_i env (LoclType ty)
 260
 261 (** Simplify unions and intersections of constraint
 262 types which involve mixed or nothing. *)
 263 let simplify_constraint_type env ty =
 264   match deref_constraint_type ty with
 265   | (_, TCunion (lty, cty)) ->
 266     if is_nothing env lty then
 267       (env, ConstraintType cty)
 268     else if is_mixed env lty then
 269       (env, LoclType lty)
 270     else
 271       (env, ConstraintType ty)
 272   | (_, TCintersection (lty, cty)) ->
 273     if is_nothing env lty then
 274       (env, LoclType lty)
 275     else if is_mixed env lty then
 276       (env, ConstraintType cty)
 277     else
 278       (env, ConstraintType ty)
 279   | (_, Thas_member _)
 280   | (_, Tdestructure _) ->
 281     (env, ConstraintType ty)
 282
 283 let contains_unresolved_tyvars env ty =
 284   let finder =
 285     object (this)
 286       inherit [env * bool] Type_visitor.locl_type_visitor as super
 287
 288       method! on_tvar (env, occurs) r v =
 289         let (env, ty) = Env.expand_var env r v in
 290         if is_tyvar ty then
 291           (env, true)
 292         else
 293           this#on_type (env, occurs) ty
 294
 295       method! on_type (env, occurs) ty =
 296         if occurs then
 297           (env, occurs)
 298         else
 299           super#on_type (env, occurs) ty
 300     end
 301   in
 302   finder#on_type (env, false) ty
 303
 304 let contains_tvar_decl (t : decl_ty) =
 305   let finder =
 306     object
 307       inherit [bool] Type_visitor.decl_type_visitor as parent
 308
 309       method! on_tvar _found _r _v = true
 310
 311       method! on_type found ty =
 312         if found then
 313           true
 314         else
 315           parent#on_type found ty
 316     end
 317   in
 318   finder#on_type false t
 319
 320 let wrap_union_inter_ty_in_var env r ty =
 321   if is_union_or_inter_type ty then
 322     let (env, contains_unresolved_tyvars) = contains_unresolved_tyvars env ty in
 323     if contains_unresolved_tyvars then
 324       Env.wrap_ty_in_var env r ty
 325     else
 326       (env, ty)
 327   else
 328     (env, ty)
 329
 330 (*****************************************************************************
 331  * Get the "as" constraints from an abstract type or generic parameter, or
 332  * return the type itself if there is no "as" constraint.
 333  * In the case of a generic parameter whose "as" constraint is another
 334  * generic parameter, repeat the process until a type is reached that is not
 335  * a generic parameter. Don't loop on cycles.
 336  * (For example, function foo<Tu as Tv, Tv as Tu>(...))
 337  *****************************************************************************)
 338 let get_concrete_supertypes env ty =
 339   let rec iter seen env acc tyl =
 340     match tyl with
 341     | [] -> (env, acc)
 342     | ty :: tyl ->
 343       let (env, ty) = Env.expand_type env ty in
 344       (match get_node ty with
 345       (* Enums with arraykey upper bound are treated as "abstract" *)
 346       | Tnewtype (cid, _, bound_ty)
 347         when is_prim Aast.Tarraykey bound_ty && Env.is_enum env cid ->
 348         iter seen env acc tyl
 349       (* Don't expand enums or newtype; just return the type itself *)
 350       | Tnewtype (_, _, ty)
 351       | Tdependent (_, ty) ->
 352         iter seen env (TySet.add ty acc) tyl
 353       | Tgeneric (n, targs) ->
 354         if SSet.mem n seen then
 355           iter seen env acc tyl
 356         else
 357           iter
 358             (SSet.add n seen)
 359             env
 360             acc
 361             (TySet.elements (Env.get_upper_bounds env n targs) @ tyl)
 362       | Tintersection tyl' -> iter seen env acc (tyl' @ tyl)
 363       | _ -> iter seen env (TySet.add ty acc) tyl)
 364   in
 365   let (env, resl) = iter SSet.empty env TySet.empty [ty] in
 366   (env, TySet.elements resl)
 367
 368 (** Run a function on an intersection represented by a list of types.
 369     We stay liberal with errors:
 370     discard the result of any run which has produced an error.
 371     If all runs have produced an error, gather all errors and results and add errors. *)
 372 let run_on_intersection :
 373     'env -> f:('env -> locl_ty -> 'env * 'a) -> locl_ty list -> 'env * 'a list =
 374  fun env ~f tyl ->
 375   let (env, resl_errors) =
 376     List.map_env env tyl ~f:(fun env ty ->
 377         let (errors, (env, result)) = Errors.do_ @@ fun () -> f env ty in
 378         (env, (result, errors)))
 379   in
 380   let valid_resl =
 381     List.filter resl_errors ~f:(fun (_, err) -> Errors.is_empty err)
 382     |> List.map ~f:fst
 383   in
 384   let resl =
 385     if not (List.is_empty valid_resl) then
 386       valid_resl
 387     else (
 388       List.iter resl_errors ~f:(fun (_, err) -> Errors.merge_into_current err);
 389       List.map ~f:fst resl_errors
 390     )
 391   in
 392   (env, resl)
 393
 394 (*****************************************************************************)
 395 (* Dynamicism  *)
 396 (*****************************************************************************)
 397 let is_dynamic env ty =
 398   let dynamic = MakeType.dynamic Reason.Rnone in
 399   (is_sub_type_for_union ~coerce:None env dynamic ty && not (is_mixed env ty))
 400   || is_sub_type_for_union ~coerce:None env ty dynamic
 401      && not (is_nothing env ty)
 402
 403 (*****************************************************************************)
 404 (* Check if type is any or a variant thereof  *)
 405 (*****************************************************************************)
 406
 407 let rec is_any env ty =
 408   let (env, ty) = Env.expand_type env ty in
 409   match get_node ty with
 410   | Tany _
 411   | Terr ->
 412     true
 413   | Tunion tyl -> List.for_all tyl (is_any env)
 414   | Tintersection tyl -> List.exists tyl (is_any env)
 415   | _ -> false
 416
 417 let is_tunion env ty =
 418   let (_env, ty) = Env.expand_type env ty in
 419   match get_node ty with
 420   | Tunion _ -> true
 421   | _ -> false
 422
 423 let is_tintersection env ty =
 424   let (_env, ty) = Env.expand_type env ty in
 425   match get_node ty with
 426   | Tintersection _ -> true
 427   | _ -> false
 428
 429 (*****************************************************************************)
 430 (* Gets the base type of an abstract type *)
 431 (*****************************************************************************)
 432
 433 let rec get_base_type env ty =
 434   let (env, ty) = Env.expand_type env ty in
 435   match get_node ty with
 436   | Tnewtype (classname, _, _) when String.equal classname SN.Classes.cClassname
 437     ->
 438     ty
 439   (* If we have an expression dependent type and it only has one super
 440     type, we can treat it similarly to AKdependent _, Some ty  *)
 441   | Tgeneric (n, targs) when DependentKind.is_generic_dep_ty n ->
 442     begin
 443       match TySet.elements (Env.get_upper_bounds env n targs) with
 444       | ty2 :: _ when ty_equal ty ty2 -> ty
 445       (* If it's exactly equal, then the base ty is just this one *)
 446       | ty :: _ ->
 447         if TySet.mem ty (Env.get_lower_bounds env n targs) then
 448           ty
 449         else
 450           get_base_type env ty
 451       | [] -> ty
 452     end
 453   | Tnewtype (cid, _, bound_ty)
 454     when is_prim Aast.Tarraykey bound_ty && Env.is_enum env cid ->
 455     ty
 456   | Tgeneric _
 457   | Tnewtype _
 458   | Tdependent _ ->
 459     begin
 460       match get_concrete_supertypes env ty with
 461       (* If the type is exactly equal, we don't want to recurse *)
 462       | (_, ty2 :: _) when ty_equal ty ty2 -> ty
 463       | (_, ty :: _) -> get_base_type env ty
 464       | (_, []) -> ty
 465     end
 466   | _ -> ty
 467
 468 (*****************************************************************************)
 469 (* Reactivity *)
 470 (*****************************************************************************)
 471
 472 let reactivity_to_string env r =
 473   let cond_reactive prefix t =
 474     let str = Typing_print.full_decl (Env.get_ctx env) t in
 475     prefix ^ " (condition type: " ^ str ^ ")"
 476   in
 477   let rec aux r =
 478     match r with
 479     | Pure None -> "pure"
 480     | Pure (Some ty) -> cond_reactive "conditionally pure" ty
 481     | Reactive None -> "reactive"
 482     | Reactive (Some ty) -> cond_reactive "conditionally reactive" ty
 483     | Shallow None -> "shallow reactive"
 484     | Shallow (Some ty) -> cond_reactive "conditionally shallow reactive" ty
 485     | Local None -> "local reactive"
 486     | Local (Some ty) -> cond_reactive "conditionally local reactive" ty
 487     | MaybeReactive n -> "maybe (" ^ aux n ^ ")"
 488     | Nonreactive -> "normal"
 489     | RxVar _ -> "maybe reactive"
 490     | Cipp None -> "cipp"
 491     | Cipp (Some s) -> "cipp(" ^ s ^ ")"
 492     | CippLocal None -> "cipp_local"
 493     | CippLocal (Some s) -> "cipp_local(" ^ s ^ ")"
 494     | CippGlobal -> "cipp_global"
 495     | CippRx -> "cipp_rx"
 496   in
 497   aux r
 498
 499 let get_printable_shape_field_name = Env.get_shape_field_name
 500
 501 let shape_field_name_ this field =
 502   Aast.(
 503     match field with
 504     | (p, Int name) -> Ok (Ast_defs.SFlit_int (p, name))
 505     | (p, String name) -> Ok (Ast_defs.SFlit_str (p, name))
 506     | (p, EnumAtom name) -> Ok (Ast_defs.SFlit_str (p, name))
 507     | (_, Class_const ((_, CI x), y)) -> Ok (Ast_defs.SFclass_const (x, y))
 508     | (_, Class_const ((_, CIself), y)) ->
 509       (match force this with
 510       | Some sid -> Ok (Ast_defs.SFclass_const (sid, y))
 511       | None -> Error `Expected_class)
 512     | _ -> Error `Invalid_shape_field_name)
 513
 514 let shape_field_name env (p, field) =
 515   let this =
 516     lazy
 517       (let c_ty = get_node (Env.get_self env) in
 518        match c_ty with
 519        | Tclass (sid, _, _) -> Some sid
 520        | _ -> None)
 521   in
 522   match shape_field_name_ this (p, field) with
 523   | Ok x -> Some x
 524   | Error `Expected_class ->
 525     Errors.expected_class p;
 526     None
 527   | Error `Invalid_shape_field_name ->
 528     Errors.invalid_shape_field_name p;
 529     None
 530
 531 (*****************************************************************************)
 532 (* *)
 533 (*****************************************************************************)
 534
 535 let string_of_visibility = function
 536   | Vpublic -> "public"
 537   | Vprivate _ -> "private"
 538   | Vprotected _ -> "protected"
 539
 540 let unwrap_class_type ty =
 541   match deref ty with
 542   | (r, Tapply (name, tparaml)) -> (r, name, tparaml)
 543   | ( _,
 544       ( Terr | Tdynamic | Tany _ | Tmixed | Tnonnull
 545       | Tdarray (_, _)
 546       | Tvarray _ | Tvarray_or_darray _ | Tvec_or_dict _ | Tgeneric _
 547       | Toption _ | Tlike _ | Tprim _ | Tfun _ | Ttuple _ | Tshape _ | Tunion _
 548       | Tintersection _
 549       | Taccess (_, _)
 550       | Tthis | Tvar _ ) ) ->
 551     raise @@ Invalid_argument "unwrap_class_type got non-class"
 552
 553 let try_unwrap_class_type x = Option.try_with (fun () -> unwrap_class_type x)
 554
 555 let class_is_final_and_not_contravariant class_ty =
 556   Cls.final class_ty
 557   && List.for_all (Cls.tparams class_ty) ~f:(function
 558          | { tp_variance = Ast_defs.Invariant | Ast_defs.Covariant; _ } -> true
 559          | _ -> false)
 560
 561 (*****************************************************************************)
 562 (* Check if a type is not fully constrained *)
 563 (*****************************************************************************)
 564
 565 module HasTany : sig
 566   val check : locl_ty -> bool
 567
 568   val check_why : locl_ty -> Reason.t option
 569 end = struct
 570   let visitor =
 571     object (_this)
 572       inherit [Reason.t option] Type_visitor.locl_type_visitor
 573
 574       method! on_tany _ r = Some r
 575     end
 576
 577   let check_why ty = visitor#on_type None ty
 578
 579   let check ty = Option.is_some (check_why ty)
 580 end
 581
 582 (*****************************************************************************)
 583 (* Function parameters *)
 584 (*****************************************************************************)
 585
 586 let default_fun_param ?(pos = Pos.none) ty : 'a fun_param =
 587   {
 588     fp_pos = pos;
 589     fp_name = None;
 590     fp_type = { et_type = ty; et_enforced = false };
 591     fp_flags =
 592       make_fp_flags
 593         ~mode:FPnormal
 594         ~accept_disposable:false
 595         ~mutability:None
 596         ~has_default:false
 597         ~ifc_external:false
 598         ~ifc_can_call:false
 599         ~is_atom:false
 600         ~readonly:false;
 601     fp_rx_annotation = None;
 602   }
 603
 604 let fun_mutable user_attributes =
 605   let rec go = function
 606     | [] -> None
 607     | { Aast.ua_name = (_, n); _ } :: _
 608       when String.equal n SN.UserAttributes.uaMutable ->
 609       Some Param_borrowed_mutable
 610     | { Aast.ua_name = (_, n); _ } :: _
 611       when String.equal n SN.UserAttributes.uaMaybeMutable ->
 612       Some Param_maybe_mutable
 613     | _ :: tl -> go tl
 614   in
 615   go user_attributes
 616
 617 let tany = Env.tany
 618
 619 let mk_tany env p = mk (Reason.Rwitness p, tany env)
 620
 621 let decl_tany = Env.decl_tany
 622
 623 let terr env r =
 624   let dynamic_view_enabled =
 625     TypecheckerOptions.dynamic_view (Typing_env.get_tcopt env)
 626   in
 627   if dynamic_view_enabled then
 628     MakeType.dynamic r
 629   else
 630     MakeType.err r
 631
 632 let collect_enum_class_upper_bounds env name =
 633   let rec collect seen result name =
 634     let upper_bounds = Env.get_upper_bounds env name [] in
 635     Typing_set.fold
 636       (fun lty (seen, result) ->
 637         match get_node lty with
 638         | Tclass ((_, name), _, _) when Env.is_enum_class env name ->
 639           (seen, SSet.add name result)
 640         | Tgeneric (name, _) when not (SSet.mem name seen) ->
 641           collect (SSet.add name seen) result name
 642         | _ -> (seen, result))
 643       upper_bounds
 644       (seen, result)
 645   in
 646   let (_, upper_bounds) = collect SSet.empty SSet.empty name in
 647   upper_bounds
 648
 649 let make_locl_subst_for_class_tparams classdef tyl =
 650   if List.is_empty tyl then
 651     SMap.empty
 652   else
 653     Decl_subst.make_locl (Cls.tparams classdef) tyl