hphp/hack/src/typing/typing_taccess.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 module Inter = Typing_intersection
  14 module Reason = Typing_reason
  15 module Env = Typing_env
  16 module Log = Typing_log
  17 module Phase = Typing_phase
  18 module TySet = Typing_set
  19 module TR = Typing_reactivity
  20 module CT = Typing_subtype.ConditionTypes
  21 module Cls = Decl_provider.Class
  22 module MakeType = Typing_make_type
  23
  24 (* A guiding principle when expanding a type access C::T is that if C <: D and
  25    we know that D::T = X (represented by an Exact result below), then C::T is
  26    also X. So Exact is propagated down the <: relation, see `update_class_name`
  27    below where this behavior is encoded. *)
  28
  29 type context = {
  30   (* The T in the type access C::T *)
  31   id: Nast.sid;
  32   (* The expand environment as passed in by Typing_phase.localize *)
  33   ety_env: expand_env;
  34   (* A set of visited types used to avoid infinite loops during expansion. *)
  35   generics_seen: TySet.t;
  36   (* Whether or not an abstract type constant is allowed as the result. In the
  37      future, this boolean should disappear and abstract type constants should
  38      appear only in the class where they are defined. *)
  39   allow_abstract: bool;
  40   (* If set, abstract type constants will be expanded as type variables. This
  41      is a hack which should naturally go away when the semantics of abstract
  42      type constants is cleaned up. *)
  43   abstract_as_tyvar: bool;
  44   (* The origin of the extension. For example if TC is a generic parameter
  45      subject to the constraint TC as C and we would like to expand TC::T we
  46      will expand C::T with base set to `Some (Tgeneric "TC")` (and root set
  47      to C). If it is None the base is exactly the current root. *)
  48   base: locl_ty option;
  49   (* A callback for errors *)
  50   on_error: Errors.typing_error_callback;
  51 }
  52
  53 (* The result of an expansion
  54    - Exact ty means that the expansion results precisely in 'ty'
  55    - Abstract (n0, [n1, n2, n3], bound) means that the result is a
  56      generic with name n0::T such that:
  57      n0::T as n1::T as n2::T as n3::T as bound *)
  58 type result =
  59   | Exact of locl_ty
  60   | Abstract of string * string list * locl_ty option
  61
  62 exception NoTypeConst of (unit -> unit)
  63
  64 let raise_error error = raise_notrace @@ NoTypeConst error
  65
  66 let make_reason env r id root =
  67   Reason.Rtypeconst (r, id, Typing_print.error env root, get_reason root)
  68
  69 (* FIXME: It is bogus to use strings here and put them in Tgeneric; one
  70    possible problem is when a type parameter has a name which conflicts
  71    with a class name *)
  72 let tp_name class_name id = class_name ^ "::" ^ snd id
  73
  74 (* A smart constructor for Abstract that also checks if the type we are
  75    creating is known to be equal to some other type *)
  76 let make_abstract env id name namel bnd =
  77   let tp_name = tp_name name id in
  78   if not (Typing_set.is_empty (Env.get_equal_bounds env tp_name)) then
  79     (* If the resulting abstract type is exactly equal to something,
  80        mark the result as exact.
  81        For example, if we have the following
  82        abstract class Box {
  83          abstract const type T;
  84        }
  85        function addFiveToValue<T1 as Box>(T1 $x) : int where T1::T = int {
  86            return $x->get() + 5;
  87        }
  88        Here, $x->get() has type expr#1::T as T1::T (as Box::T).
  89        But T1::T is exactly equal to int, so $x->get() no longer needs
  90        to be expression dependent. Thus, $x->get() typechecks. *)
  91     Exact (MakeType.generic Reason.Rnone tp_name)
  92   else
  93     Abstract (name, namel, bnd)
  94
  95 (* Lookup a type constant in a class and return a result. A type constant has
  96    both a constraint type and assigned type. Which one we choose depends if
  97    the current root is the base (origin) of the expansion, or if it is an
  98    upper bound of the base. *)
  99 let create_root_from_type_constant
 100     ctx env root (class_pos, class_name) opt_class_def =
 101   let { id = (id_pos, id_name) as id; _ } = ctx in
 102   let class_ =
 103     match opt_class_def with
 104     | None ->
 105       raise_error (fun () -> Errors.unbound_name_typing class_pos class_name)
 106     | Some c -> c
 107   in
 108   let typeconst =
 109     match Env.get_typeconst env class_ id_name with
 110     | Some tc -> tc
 111     | None ->
 112       raise_error (fun () ->
 113           Errors.smember_not_found
 114             `class_typeconst
 115             (get_pos root)
 116             (Cls.pos class_, class_name)
 117             id_name
 118             `no_hint
 119             ctx.on_error)
 120   in
 121   let name = tp_name class_name id in
 122   let type_expansions = (id_pos, name) :: ctx.ety_env.type_expansions in
 123   (match ctx.ety_env.report_cycle with
 124   (* This is a cycle through a type constant that we are defining *)
 125   | Some (_, name') when String.equal name name' ->
 126     let seen = name :: List.rev_map type_expansions snd in
 127     Errors.cyclic_typeconst (fst typeconst.ttc_name) seen
 128   | _ ->
 129     (* This is a cycle through a type constant that we are using *)
 130     if
 131       List.mem
 132         ~equal:String.equal
 133         (List.map ctx.ety_env.type_expansions snd)
 134         name
 135     then
 136       raise_error (fun () -> ())
 137     else
 138       ());
 139   let drop_exact ty =
 140     (* Legacy behavior is to preserve exactness only on `this` and not
 141        through `this::T` *)
 142     match deref ty with
 143     | (r, Tclass (cid, _, tyl)) -> mk (r, Tclass (cid, Nonexact, tyl))
 144     | _ -> ty
 145   in
 146   let ety_env =
 147     let from_class = None in
 148     let this_ty = drop_exact (Option.value ctx.base ~default:root) in
 149     { ctx.ety_env with from_class; type_expansions; this_ty }
 150   in
 151   let make_abstract env bnd =
 152     ( if (not ctx.allow_abstract) && not ety_env.quiet then
 153       let tc_pos = fst typeconst.ttc_name in
 154       Errors.abstract_tconst_not_allowed id_pos (tc_pos, id_name) );
 155     (* TODO(T59448452): this treatment of abstract type constants is unsound *)
 156     make_abstract env id class_name [] bnd
 157   in
 158   match typeconst with
 159   (* Concrete type constants *)
 160   | { ttc_type = Some ty; ttc_constraint = None; _ } ->
 161     let (env, ty) = Phase.localize ~ety_env env ty in
 162     let (r, ty) = deref ty in
 163     (env, Exact (mk (make_reason env r id root, ty)))
 164   (* A type constant with default can be seen as abstract or exact, depending
 165      on the root and base of the access. *)
 166   | { ttc_type = Some ty; ttc_constraint = Some _; _ } ->
 167     let (env, ty) = Phase.localize ~ety_env env ty in
 168     let (r, ty) = deref ty in
 169     let ty = mk (make_reason env r id root, ty) in
 170     if Cls.final class_ || Option.is_none ctx.base then
 171       (env, Exact ty)
 172     else
 173       (env, make_abstract env (Some ty))
 174   (* Abstract type constants with constraint *)
 175   | { ttc_constraint = Some cstr; _ } ->
 176     let (env, cstr) = Phase.localize ~ety_env env cstr in
 177     (env, make_abstract env (Some cstr))
 178   (* Abstract type constant without constraint. *)
 179   | _ -> (env, make_abstract env None)
 180
 181 let rec type_of_result ctx env root res =
 182   let { id = (id_pos, id_name) as id; _ } = ctx in
 183   let type_with_bound env as_tyvar name bnd =
 184     if as_tyvar then (
 185       let (env, tvar) = Env.fresh_invariant_type_var env id_pos in
 186       Log.log_new_tvar_for_tconst_access env id_pos tvar name id_name;
 187       (env, tvar)
 188     ) else
 189       let generic_name = tp_name name id in
 190       let reason = make_reason env Reason.Rnone id root in
 191       let ty = MakeType.generic reason generic_name in
 192       let env =
 193         Option.fold bnd ~init:env ~f:(fun env bnd ->
 194             (* TODO(T59317869): play well with flow sensitivity *)
 195             Env.add_upper_bound_global env generic_name bnd)
 196       in
 197       (env, ty)
 198   in
 199   match res with
 200   | Exact ty -> (env, ty)
 201   | Abstract (name, name' :: namel, bnd) ->
 202     let res' = Abstract (name', namel, bnd) in
 203     let (env, ty) = type_of_result ctx env root res' in
 204     type_with_bound env false name (Some ty)
 205   | Abstract (name, [], bnd) ->
 206     type_with_bound env ctx.abstract_as_tyvar name bnd
 207
 208 let update_class_name env id new_name = function
 209   | Exact _ as res -> res
 210   | Abstract (name, namel, bnd) ->
 211     make_abstract env id new_name (name :: namel) bnd
 212
 213 let rec expand ctx env root =
 214   let (env, root) = Env.expand_type env root in
 215   let make_reason env = make_reason env Reason.Rnone ctx.id root in
 216   match get_node root with
 217   | Tany _
 218   | Terr ->
 219     (env, Exact root)
 220   | Tdependent (DTcls name, ty)
 221   | Tnewtype (name, _, ty) ->
 222     let ctx =
 223       let base = Some (Option.value ctx.base ~default:root) in
 224       let allow_abstract = true in
 225       { ctx with base; allow_abstract }
 226     in
 227     let (env, res) = expand ctx env ty in
 228     let name = Printf.sprintf "<cls#%s>" name in
 229     (env, update_class_name env ctx.id name res)
 230   | Tclass (cls, _, _) ->
 231     let opt_class_def = Env.get_class env (snd cls) in
 232     let allow_abstract =
 233       match opt_class_def with
 234       | Some ci
 235         when Ast_defs.(equal_class_kind (Decl_provider.Class.kind ci) Ctrait) ->
 236         (* Hack: `self` in a trait is mistakenly replaced by the trait instead
 237            of the class using the trait, so if a trait is the root, it is
 238            likely because originally there was `self::T` written.
 239            TODO(T54081153): fix `self` in traits and clean this up *)
 240         true
 241       | _ -> ctx.allow_abstract
 242     in
 243     let ctx = { ctx with allow_abstract } in
 244     create_root_from_type_constant ctx env root cls opt_class_def
 245   | Tgeneric s ->
 246     let ctx =
 247       let generics_seen = TySet.add root ctx.generics_seen in
 248       let base = Some (Option.value ctx.base ~default:root) in
 249       let allow_abstract = true in
 250       let abstract_as_tyvar = false in
 251       { ctx with generics_seen; base; allow_abstract; abstract_as_tyvar }
 252     in
 253     let rec last_res res err = function
 254       | [] -> (res, err)
 255       | ty :: tys ->
 256         let (res', err) =
 257           try (Some (expand ctx env ty), err)
 258           with NoTypeConst err -> (res, err)
 259         in
 260         (* The strategy here is to take the last result. It is necessary for
 261            poor reasons, unfortunately. Because `type_of_result` bogusly uses
 262            `Env.add_upper_bound_global`, local type refinement information can
 263            leak outside its scope. To remain consistent with the previous
 264            version of the type access algorithm wrt this bug, we pick the last
 265            result. See T59317869.
 266            The test test/typecheck/tconst/type_refinement_stress.php monitors
 267            the situation here. *)
 268         last_res (Option.first_some res' res) err tys
 269     in
 270     let err () =
 271       let (pos, tconst) = ctx.id in
 272       let ty = Typing_print.error env root in
 273       Errors.non_object_member_read
 274         ~is_method:false
 275         tconst
 276         (get_pos root)
 277         ty
 278         pos
 279         ctx.on_error
 280     in
 281     (* Ignore seen bounds to avoid infinite loops *)
 282     let upper_bounds =
 283       TySet.diff (Env.get_upper_bounds env s) ctx.generics_seen
 284     in
 285     (match last_res None err (TySet.elements upper_bounds) with
 286     | (Some (env, res), _) -> (env, update_class_name env ctx.id s res)
 287     | (None, err) -> raise_error err)
 288   | Tdependent (dep_ty, ty) ->
 289     let ctx =
 290       let base = Some (Option.value ctx.base ~default:root) in
 291       let allow_abstract = true in
 292       let abstract_as_tyvar = false in
 293       { ctx with base; allow_abstract; abstract_as_tyvar }
 294     in
 295     let (env, res) = expand ctx env ty in
 296     (env, update_class_name env ctx.id (DependentKind.to_string dep_ty) res)
 297   | Tunion tyl ->
 298     (* TODO(T58839232): accesses on unions are unsound *)
 299     let (env, tyl) =
 300       List.map_env env tyl ~f:(fun env ty ->
 301           let (env, res) = expand ctx env ty in
 302           type_of_result ctx env root res)
 303     in
 304     let ty = MakeType.union (make_reason env) tyl in
 305     (env, Exact ty)
 306   | Tintersection tyl ->
 307     let (env, tyl) =
 308       Typing_utils.run_on_intersection env tyl ~f:(fun env ty ->
 309           let (env, res) = expand ctx env ty in
 310           type_of_result ctx env root res)
 311     in
 312     let (env, ty) = Inter.intersect_list env (make_reason env) tyl in
 313     (env, Exact ty)
 314   | Tvar n ->
 315     let (env, ty) = Typing_subtype_tconst.get_tyvar_type_const env n ctx.id in
 316     (env, Exact ty)
 317   | Tpu _
 318   | Tpu_type_access _
 319   | Tobject
 320   | Tnonnull
 321   | Tprim _
 322   | Tshape _
 323   | Ttuple _
 324   | Tvarray _
 325   | Tdarray _
 326   | Tvarray_or_darray _
 327   | Tfun _
 328   | Tdynamic
 329   | Toption _ ->
 330     let (pos, tconst) = ctx.id in
 331     let ty = Typing_print.error env root in
 332     raise_error (fun () ->
 333         Errors.non_object_member_read
 334           ~is_method:false
 335           tconst
 336           pos
 337           ty
 338           (get_pos root)
 339           ctx.on_error)
 340
 341 let expand_with_env
 342     ety_env
 343     env
 344     ?(ignore_errors = false)
 345     ?(as_tyvar_with_cnstr = false)
 346     root
 347     id
 348     ~on_error
 349     ~allow_abstract_tconst =
 350   let (env, ty) =
 351     try
 352       let ctx =
 353         {
 354           id;
 355           ety_env;
 356           base = None;
 357           generics_seen = TySet.empty;
 358           allow_abstract = allow_abstract_tconst;
 359           abstract_as_tyvar = as_tyvar_with_cnstr;
 360           on_error;
 361         }
 362       in
 363       let (env, res) = expand ctx env root in
 364       type_of_result ctx env root res
 365     with NoTypeConst error ->
 366       if not ignore_errors then error ();
 367       let reason = make_reason env Reason.Rnone id root in
 368       (env, Typing_utils.terr env reason)
 369   in
 370   (* If type constant has type this::ID and method has associated condition
 371      type ROOTCOND_TY for the receiver - check if condition type has type
 372      constant at the same path.  If yes - attach a condition type
 373      ROOTCOND_TY::ID to a result type *)
 374   match
 375     ( deref root,
 376       id,
 377       TR.condition_type_from_reactivity (Typing_env_types.env_reactivity env) )
 378   with
 379   | ((_, Tdependent (DTthis, _)), (_, tconst), Some cond_ty) ->
 380     begin
 381       match CT.try_get_class_for_condition_type env cond_ty with
 382       | Some (_, cls) when Cls.has_typeconst cls tconst ->
 383         let cond_ty = mk (Reason.Rwitness (fst id), Taccess (cond_ty, [id])) in
 384         Option.value
 385           (TR.try_substitute_type_with_condition env cond_ty ty)
 386           ~default:(env, ty)
 387       | _ -> (env, ty)
 388     end
 389   | _ -> (env, ty)
 390
 391 let referenced_typeconsts env ety_env (root, ids) ~on_error =
 392   let (env, root) = Phase.localize ~ety_env env root in
 393   List.fold
 394     ids
 395     ~init:((env, root), [])
 396     ~f:
 397       begin
 398         fun ((env, root), acc) (pos, tconst) ->
 399         let (env, tyl) = Typing_utils.get_concrete_supertypes env root in
 400         let acc =
 401           List.fold tyl ~init:acc ~f:(fun acc ty ->
 402               let (env, ty) = Env.expand_type env ty in
 403               match get_node ty with
 404               | Tclass ((_, class_name), _, _) ->
 405                 let ( >>= ) = Option.( >>= ) in
 406                 Option.value
 407                   ~default:acc
 408                   ( Typing_env.get_class env class_name >>= fun class_ ->
 409                     Typing_env.get_typeconst env class_ tconst
 410                     >>= fun typeconst ->
 411                     Some ((typeconst.Typing_defs.ttc_origin, tconst, pos) :: acc)
 412                   )
 413               | _ -> acc)
 414         in
 415         ( expand_with_env
 416             ety_env
 417             env
 418             ~as_tyvar_with_cnstr:false
 419             root
 420             (pos, tconst)
 421             ~on_error
 422             ~allow_abstract_tconst:true,
 423           acc )
 424       end
 425   |> snd
 426
 427 (*****************************************************************************)
 428 (* Exporting *)
 429 (*****************************************************************************)
 430
 431 let () = Typing_utils.expand_typeconst_ref := expand_with_env