hphp/hack/src/typing/typing_phase.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 Core_kernel
  11 open Common
  12 open Typing_defs
  13 open Typing_dependent_type
  14 open Utils
  15
  16 module Env = Typing_env
  17 module TUtils = Typing_utils
  18 module TGenConstraint = Typing_generic_constraint
  19 module Subst = Decl_subst
  20 module MakeType = Typing_make_type
  21
  22 (* Here is the general problem the delayed application of the phase solves.
  23  * Let's say you have a function that you want to operate generically across
  24  * phases. In most cases when you do this you can use the 'ty' GADT and locally
  25  * abstract types to write code in a phase agonistic way.
  26  *
  27  *  let yell_any: type a. a ty -> string = fun ty ->
  28  *    match ty with
  29  *    | _, Tany -> "Any"
  30  *    | _ -> ""
  31  *
  32  * Now let's add a function that works for all phases, but whose logic is phase
  33  * dependent. For this we can use 'phase_ty' ADT:
  34  *
  35  *  let yell_locl phase_ty =
  36  *     match phase_ty with
  37  *     | DeclTy ty -> ""
  38  *     | LoclTy ty -> "Locl"
  39  *
  40  * Let's say you want to write a function that has behavior that works across
  41  * phases, but needs to invoke a function that is phase dependent. Our options
  42  * are as follows.
  43  *
  44  *  let yell_any_or_locl phase_ty =
  45  *    let ans = yell_locl phase_ty in
  46  *    match phase_ty with
  47  *    | DeclTy ty -> ans ^ (yell_any ty)
  48  *    | LoclTy ty -> ans ^ (yell_any ty)
  49  *
  50  * This would lead to code duplication since we can't generically operate on the
  51  * underlying 'ty' GADT. If we want to eliminate this code duplication there are
  52  * two options.
  53  *
  54  *  let generic_ty: type a. phase_ty -> a ty = function
  55  *    | DeclTy ty -> ty
  56  *    | LoclTy ty -> ty
  57  *
  58  *  let yell_any_or_locl phase_ty =
  59  *    let ans = yell_locl phase_ty in
  60  *    ans ^ (yell_any (generic_ty phase_ty))
  61  *
  62  * generic_ty allows us to extract a generic value which we can use. This
  63  * approach is limiting because we lose all information about what phase 'a ty
  64  * is.
  65  *
  66  * The other approach is to pass in a function that goes from 'a ty -> phase_ty'
  67  *
  68  *  let yell_any_or_locl phase ty =
  69  *    let ans = yell_locl (phase ty) in
  70  *    ans ^ (yell_any ty)
  71  *
  72  * Here we can use 'ty' generically (without losing information about what phase
  73  * 'a ty' is), and we rely on the caller passing in an appropriate function that
  74  * converts into the 'phase_ty' when we need to hop into phase specific code.
  75  *)
  76 let decl ty = DeclTy ty
  77 let locl ty = LoclTy ty
  78
  79 type env = expand_env
  80
  81 let env_with_self env =
  82   let this_ty = Reason.none, TUtils.this_of (Env.get_self env) in
  83   {
  84     type_expansions = [];
  85     substs = SMap.empty;
  86     this_ty = this_ty;
  87     from_class = None;
  88     validate_dty = None;
  89   }
  90 (*****************************************************************************)
  91 (* Transforms a declaration phase type into a localized type. This performs
  92  * common operations that are necessary for this operation, specifically:
  93  *   > Expand newtype/types
  94  *   > Resolves the "this" type
  95  *   > Instantiate generics
  96  *   > ...
  97  *
  98  * When keep track of additional information while localizing a type such as
  99  * what type defs were expanded to detect potentially recursive definitions..
 100  *)
 101 (*****************************************************************************)
 102
 103 let rec localize_with_env ~ety_env env (dty: decl ty) =
 104
 105   Option.iter ety_env.validate_dty (fun validate_dty -> validate_dty dty);
 106   match dty with
 107   | r, Terr ->
 108       env, (ety_env, (r, TUtils.terr env))
 109   | r, Tany ->
 110       env, (ety_env, (r, TUtils.tany env))
 111   | _, (Tnonnull | Tprim _ | Tdynamic) as x ->
 112       env, (ety_env, x)
 113   | r, Tmixed ->
 114       env, (ety_env, MakeType.mixed r)
 115   | r, Tnothing ->
 116       env, (ety_env, MakeType.nothing r)
 117   | r, Tthis ->
 118       let ty = match ety_env.this_ty with
 119         | Reason.Rnone, ty -> r, ty
 120         | Reason.Rexpr_dep_type (_, pos, s), ty ->
 121             Reason.Rexpr_dep_type (r, pos, s), ty
 122         | reason, ty when ety_env.from_class <> None -> reason, ty
 123         | reason, ty ->
 124             Reason.Rinstantiate (reason, SN.Typehints.this, r), ty in
 125       let env, ty =
 126         match ety_env.from_class with
 127         | Some cid ->
 128           ExprDepTy.make env cid ty
 129         | _ -> env, ty in
 130       env, (ety_env, ty)
 131   | r, Tarray (ty1, ty2) ->
 132       let env, ty = match ty1, ty2 with
 133         | None, None -> env, Tarraykind AKany
 134         | Some tv, None ->
 135             let env, tv = localize ~ety_env env tv in
 136             env, Tarraykind (AKvec tv)
 137         | Some tk, Some tv ->
 138             let env, tk = localize ~ety_env env tk in
 139             let env, tv = localize ~ety_env env tv in
 140             env, Tarraykind (AKmap (tk, tv))
 141         | None, Some _ ->
 142             failwith "Invalid array declaration type" in
 143       env, (ety_env, (r, ty))
 144   | r, Tdarray (tk, tv) ->
 145       let env, tk = localize ~ety_env env tk in
 146       let env, tv = localize ~ety_env env tv in
 147       let ty = Tarraykind (AKdarray (tk, tv)) in
 148       env, (ety_env, (r, ty))
 149   | r, Tvarray tv ->
 150       let env, tv = localize ~ety_env env tv in
 151       let ty = Tarraykind (AKvarray tv) in
 152       env, (ety_env, (r, ty))
 153   | r, Tvarray_or_darray tv ->
 154       let env, tv = localize ~ety_env env tv in
 155       let ty = Tarraykind (AKvarray_or_darray tv) in
 156       env, (ety_env, (r, ty))
 157   | r, Tgeneric x ->
 158       begin match SMap.get x ety_env.substs with
 159       | Some x_ty ->
 160         env, (ety_env, (Reason.Rinstantiate (fst x_ty, x, r), snd x_ty))
 161       | None ->
 162         env, (ety_env, (r, Tabstract (AKgeneric x, None)))
 163     end
 164   | r, Toption ty ->
 165        let env, ty = localize ~ety_env env ty in
 166        let ty_ =
 167          if TUtils.is_option env ty then
 168            snd ty
 169          else
 170            Toption ty in
 171        env, (ety_env, (r, ty_))
 172   | r, Tlike ty ->
 173       let env, ty = localize ~ety_env env ty in
 174       let env, lty = TUtils.union env (MakeType.dynamic r) ty in
 175       env, (ety_env, lty)
 176   | r, Tfun ft ->
 177       let env, ft = localize_ft ~use_pos:ft.ft_pos ~ety_env env ft in
 178       env, (ety_env, (r, Tfun ft))
 179   | r, Tapply ((_, x), argl) when Env.is_typedef x ->
 180       let env, argl = List.map_env env argl (localize ~ety_env) in
 181       TUtils.expand_typedef ety_env env r x argl
 182   | r, Tapply ((p, x), _argl) when Env.is_enum env x ->
 183       (* if argl <> [], nastInitCheck would have raised an error *)
 184       if Typing_defs.has_expanded ety_env x then begin
 185         Errors.cyclic_enum_constraint p;
 186         env, (ety_env, (r, Typing_utils.tany env))
 187       end else begin
 188         let type_expansions = (p, x) :: ety_env.type_expansions in
 189         let ety_env = {ety_env with type_expansions} in
 190         let env, cstr =
 191           opt (localize ~ety_env) env (Env.get_enum_constraint env x) in
 192         env, (ety_env, (r, Tabstract (AKenum x, cstr)))
 193       end
 194   | r, Tapply ((_, cid) as cls, tyl) ->
 195       let env, tyl =
 196         if not (tyl_contains_wildcard tyl)
 197         then List.map_env env tyl (localize ~ety_env)
 198         else match Env.get_class env cid with
 199           | None ->
 200             List.map_env env tyl (localize ~ety_env)
 201           | Some class_info ->
 202             let tparams = Decl_provider.Class.tparams class_info in
 203             localize_tparams ~ety_env env (Reason.to_pos r) tyl tparams
 204       in
 205       env, (ety_env, (r, Tclass (cls, Nonexact, tyl)))
 206   | r, Ttuple tyl ->
 207       let env, tyl = List.map_env env tyl (localize ~ety_env) in
 208       env, (ety_env, (r, Ttuple tyl))
 209   | r, Taccess (root_ty, ids) ->
 210       let env, root_ty = localize ~ety_env env root_ty in
 211       TUtils.expand_typeconst ety_env env r root_ty ids
 212   | r, Tshape (fields_known, tym) ->
 213       let env, tym = ShapeFieldMap.map_env (localize ~ety_env) env tym in
 214       env, (ety_env, (r, Tshape (fields_known, tym)))
 215
 216 and localize_tparams ~ety_env env pos tyl tparams =
 217   let length = min (List.length tyl) (List.length tparams) in
 218   let tyl, tparams = List.take tyl length, List.take tparams length in
 219   let ety_env = { ety_env with validate_dty = None; } in
 220   let (env, _), tyl = List.map2_env (env, ety_env) tyl tparams (localize_tparam pos) in
 221   env, tyl
 222
 223 and localize_tparam pos (env, ety_env) ty { tp_name = (_, name); tp_constraints = cstrl; tp_reified = reified; tp_user_attributes; _ } =
 224   match ty with
 225     | r, Tapply ((_, x), _argl) when x = SN.Typehints.wildcard ->
 226       let enforceable = Attributes.mem SN.UserAttributes.uaEnforceable tp_user_attributes in
 227       let newable = Attributes.mem SN.UserAttributes.uaNewable tp_user_attributes in
 228       let env, new_name = Env.add_fresh_generic_parameter env name ~reified ~enforceable ~newable in
 229       let ty_fresh = (r, Tabstract (AKgeneric new_name, None)) in
 230       let env = List.fold_left cstrl ~init:env ~f:(fun env (ck, ty) ->
 231         let env, ty = localize ~ety_env env ty in
 232         TUtils.add_constraint pos env ck ty_fresh ty) in
 233       (* Substitute fresh type parameters for original formals in constraint *)
 234       let substs = SMap.add name ty_fresh ety_env.substs in
 235       let ety_env = { ety_env with substs; } in
 236       (env, ety_env), ty_fresh
 237     | _ ->
 238       let env, ty = localize ~ety_env env ty in
 239       (env, ety_env), ty
 240
 241 and tyl_contains_wildcard tyl =
 242   List.exists tyl begin function
 243     | _, Tapply ((_, x), _) -> x = SN.Typehints.wildcard
 244     | _ -> false
 245   end
 246
 247 and localize ~ety_env env ty =
 248   let env, (_, ty) = localize_with_env ~ety_env env ty in
 249   env, ty
 250
 251 and localize_cstr_ty ~ety_env env ty tp_name =
 252   let env, (r, ty_ as ty) = localize ~ety_env env ty in
 253   let new_inference = TypecheckerOptions.new_inference (Env.get_tcopt env) in
 254   let ty = if new_inference
 255     then (Reason.Rcstr_on_generics (Reason.to_pos r, tp_name), ty_)
 256     else ty in
 257   env, ty
 258
 259 (* For the majority of cases when we localize a function type we instantiate
 260  * the function's type parameters to be a Tunresolved wrapped in a Tvar so the
 261  * type can grow. There are two cases where we do not do this.
 262
 263  * 1) In Typing_subtype.subtype_method. See the comment for that function for why
 264  * this is necessary.
 265  * 2) When the type arguments are explicitly specified, in which case we instantiate
 266  * the type parameters to the provided types.
 267  *)
 268 and localize_ft ~use_pos ?(instantiate_tparams=true) ?(explicit_tparams=[]) ~ety_env env ft =
 269   (* set reactivity to Nonreactive to prevent occasional setting
 270      of condition types when expanding type constants *)
 271   let saved_r = Env.env_reactivity env in
 272   let env = Env.set_env_reactive env Nonreactive in
 273   (* If no explicit type parameters are provided, set the instantiated type parameter to
 274    * initially point to unresolved, so that it can grow and eventually be a subtype of
 275    * something like "mixed".
 276    * If explicit type parameters are provided, just instantiate tvarl to them.
 277    *)
 278   let env, substs =
 279     let (tparams, _) = ft.ft_tparams in
 280     if instantiate_tparams
 281     then
 282       let default () =
 283         List.map_env env tparams (fun env tparam ->
 284           let reason = Reason.Rtype_variable use_pos in
 285           let env, tvar = TUtils.unresolved_tparam ~reason env in
 286           Typing_log.log_tparam_instantiation env use_pos tparam tvar;
 287           env, tvar) in
 288       let env, tvarl =
 289         if List.length explicit_tparams = 0
 290         then default ()
 291         else if List.length explicit_tparams <> List.length tparams
 292         then begin
 293           Errors.expected_tparam ~definition_pos:ft.ft_pos ~use_pos (List.length tparams);
 294           default ()
 295         end
 296         else
 297           let type_argument env hint =
 298             match hint with
 299             | (pos, Nast.Happly ((_, id), [])) when id = SN.Typehints.wildcard ->
 300               TUtils.unresolved_tparam ~reason:(Reason.Rwitness pos) env
 301             | _ -> localize_hint_with_self env hint in
 302           List.map_env env explicit_tparams type_argument
 303       in
 304       let ft_subst = Subst.make tparams tvarl in
 305       env, SMap.union ft_subst ety_env.substs
 306     else
 307       env, List.fold_left tparams ~f:begin fun subst t ->
 308         SMap.remove (snd t.tp_name) subst
 309       end ~init:ety_env.substs
 310   in
 311   let ety_env = {ety_env with substs = substs} in
 312   let env, params = List.map_env env ft.ft_params begin fun env param ->
 313     let env, ty = localize ~ety_env env param.fp_type in
 314     env, { param with fp_type = ty }
 315   end in
 316   (* restore reactivity *)
 317   let env =
 318     if saved_r <> Env.env_reactivity env
 319     then Env.set_env_reactive env saved_r
 320     else env
 321   in
 322
 323   (* Localize the constraints for a type parameter declaration *)
 324   let localize_tparam env t =
 325     let env, cstrl = List.map_env env t.tp_constraints begin fun env (ck, ty) ->
 326       let env, ty = localize_cstr_ty ~ety_env env ty t.tp_name in
 327       let name_str = snd t.tp_name in
 328       (* In order to access type constants on generics on where clauses,
 329         we need to add the constraints from the type parameters into the
 330         environment before localizing the where clauses with them. Temporarily
 331         add them to the environment here, and reset the environment later.
 332       *)
 333       let env = match ck with
 334       | Ast.Constraint_as ->
 335         Env.add_upper_bound env name_str ty
 336       | Ast.Constraint_super ->
 337         Env.add_lower_bound env name_str ty
 338       | Ast.Constraint_eq ->
 339         Env.add_upper_bound (Env.add_lower_bound env name_str ty) name_str ty
 340       | Ast.Constraint_pu_from -> failwith "TODO(T36532263): Pocket Universes" in
 341       env, (ck, ty)
 342     end in
 343     env, { t with tp_constraints = cstrl }
 344   in
 345
 346   let localize_where_constraint env (ty1, ck, ty2) =
 347     let env, ty1 = localize ~ety_env env ty1 in
 348     let env, ty2 = localize ~ety_env env ty2 in
 349     env, (ty1, ck, ty2)
 350   in
 351
 352   (* Grab and store the old tpenvs *)
 353   let old_tpenv = env.Env.lenv.Env.tpenv in
 354   let old_global_tpenv = env.Env.global_tpenv in
 355
 356   (* Always localize tparams so they are available for later Tast check *)
 357   let env, tparams = List.map_env env (fst ft.ft_tparams) localize_tparam in
 358   let ft_tparams = (
 359     tparams,
 360     if instantiate_tparams then FTKinstantiated_targs else FTKtparams
 361   ) in
 362
 363   (* Localize the 'where' constraints *)
 364   let env, where_constraints =
 365     List.map_env env ft.ft_where_constraints localize_where_constraint in
 366
 367   (* Remove the constraints we added for localizing where constraints  *)
 368   let env = Env.env_with_tpenv env old_tpenv in
 369   let env = Env.env_with_global_tpenv env old_global_tpenv in
 370
 371   (* If we're instantiating the generic parameters then add a deferred
 372    * check that constraints are satisfied under the
 373    * substitution [ety_env.substs].
 374    *)
 375   let env =
 376     if instantiate_tparams then
 377       let env = check_tparams_constraints ~use_pos ~ety_env env (fst ft.ft_tparams) in
 378       let env = check_where_constraints ~use_pos ~definition_pos:ft.ft_pos ~ety_env env
 379                   ft.ft_where_constraints in
 380       env
 381     else env in
 382
 383   let env, arity = match ft.ft_arity with
 384     | Fvariadic (min, ({ fp_type = var_ty; _ } as param)) ->
 385        let env, var_ty = localize ~ety_env env var_ty in
 386        env, Fvariadic (min, { param with fp_type = var_ty })
 387     | Fellipsis _ | Fstandard (_, _) as x -> env, x in
 388   let env, ret = localize ~ety_env env ft.ft_ret in
 389   env, { ft with ft_arity = arity; ft_params = params;
 390                  ft_ret = ret; ft_tparams = ft_tparams;
 391                  ft_where_constraints = where_constraints }
 392
 393 (* Given a list of generic parameters [tparams] and a substitution
 394  * in [ety_env.substs] whose domain is at least these generic parameters,
 395  * check that the types satisfy
 396  * the constraints on the corresponding generic parameter.
 397  *
 398  * Note that the constraints may contain occurrences of the generic
 399  * parameters, but the subsitution will be applied to them. e.g. if tparams is
 400  *   <Tu as MyCovariant<Tu>, Tv super Tu>
 401  * and ety_env.substs is
 402  *   Tu :-> C
 403  *   Tv :-> I
 404  * with
 405  *   class C extends MyContravariant<I> implements I { ... }
 406  * Then the constraints are satisfied, because
 407  *   C is a subtype of MyContravariant<C>
 408  *   I is a supertype of C
 409  *
 410  * In fact, the constraint checking isn't done immediately, but rather pushed
 411  * onto the env.todo list. Typically we haven't resolved types sufficiently
 412  * (e.g. we have completely unresolved type variables) and so the actual
 413  * constraint checking is deferred until we have finished checking a
 414  * function's body.
 415  *)
 416 and check_tparams_constraints ~use_pos ~ety_env env tparams =
 417   let check_tparam_constraints env t =
 418     List.fold_left t.tp_constraints ~init:env ~f:begin fun env (ck, ty) ->
 419       let env, ty = localize_cstr_ty ~ety_env env ty t.tp_name in
 420       match SMap.get (snd t.tp_name) ety_env.substs with
 421       | Some x_ty ->
 422         begin
 423           Typing_log.(log_with_level env "generics" 1 (fun () ->
 424             log_types use_pos env
 425               [Log_head ("check_tparams_constraints: add_check_constraint_todo",
 426                 [Log_type ("ty", ty);
 427                  Log_type ("x_ty", x_ty)])]));
 428           TGenConstraint.add_check_constraint_todo env ~use_pos t.tp_name ck ty x_ty
 429         end
 430       | None ->
 431         env
 432     end in
 433   List.fold_left tparams ~init:env ~f:check_tparam_constraints
 434
 435 and check_where_constraints ~use_pos ~ety_env ~definition_pos env cstrl =
 436   List.fold_left cstrl ~init:env ~f:begin fun env (ty1, ck, ty2) ->
 437       let contains_type_access =
 438         match ty1, ty2 with
 439         | (_, Taccess ((_, Tgeneric _), _)), _
 440         | _, (_, Taccess ((_, Tgeneric _), _)) -> true
 441         | _ -> false in
 442       if contains_type_access then
 443       let ty_from_env = localize ~ety_env in
 444       TGenConstraint.add_check_tconst_where_constraint_todo
 445         env
 446         ~use_pos
 447         ~definition_pos
 448         ck
 449         ty_from_env
 450         ty2
 451         ty1
 452       else
 453       let env, ty1 = localize ~ety_env env ty1 in
 454       let env, ty2 = localize ~ety_env env ty2 in
 455       TGenConstraint.add_check_where_constraint_todo
 456         env
 457         ~use_pos
 458         ~definition_pos
 459         ck
 460         ty2
 461         ty1
 462     end
 463
 464
 465
 466 (* Performs no substitutions of generics and initializes Tthis to
 467  * Env.get_self env
 468  *)
 469 and localize_with_self env ty =
 470   localize env ty ~ety_env:(env_with_self env)
 471
 472 and localize_with_dty_validator env ty validate_dty =
 473   let ety_env = {(env_with_self env) with validate_dty = Some validate_dty;} in
 474   localize ~ety_env env ty
 475
 476 and localize_hint_with_self env h =
 477   let h = Decl_hint.hint env.Env.decl_env h in
 478   localize_with_self env h
 479
 480 and localize_hint ~ety_env env hint =
 481   let hint_ty = Decl_hint.hint env.Env.decl_env hint in
 482   localize ~ety_env env hint_ty
 483
 484 (* Add generic parameters to the environment, localize their bounds, and
 485  * transform these into a flat list of constraints of the form (ty1,ck,ty2)
 486  * where ck is as, super or =
 487  *)
 488 let localize_generic_parameters_with_bounds
 489     ~ety_env (env:Env.env) (tparams:Nast.tparam list) =
 490   let env = Env.add_generic_parameters env tparams in
 491   let localize_bound env ({ Nast.tp_name = (pos,name); tp_constraints = cstrl; _ }: Nast.tparam) =
 492     let tparam_ty = (Reason.Rwitness pos, Tabstract(AKgeneric name, None)) in
 493     List.map_env env cstrl (fun env (ck, h) ->
 494       let env, ty = localize env (Decl_hint.hint env.Env.decl_env h) ~ety_env in
 495       env, (tparam_ty, ck, ty)) in
 496   let env, cstrss = List.map_env env tparams localize_bound in
 497   env, List.concat cstrss
 498
 499 let localize_where_constraints
 500     ~ety_env (env:Env.env) (where_constraints:Nast.where_constraint list) =
 501   let add_constraint env (h1, ck, h2) =
 502     let env, ty1 =
 503       localize env (Decl_hint.hint env.Env.decl_env h1) ~ety_env in
 504     let env, ty2 =
 505       localize env (Decl_hint.hint env.Env.decl_env h2) ~ety_env in
 506     TUtils.add_constraint (fst h1) env ck ty1 ty2
 507   in
 508   List.fold_left where_constraints ~f:add_constraint ~init:env
 509
 510 (* Helper functions *)
 511
 512 (* Ensure that types are equivalent i.e. subtypes of each other *)
 513 let unify_decl env ty1 ty2 =
 514   let env, ty1 = localize_with_self env ty1 in
 515   let env, ty2 = localize_with_self env ty2 in
 516   ignore (TUtils.sub_type env ty2 ty1);
 517   ignore (TUtils.sub_type env ty1 ty2)
 518
 519 let sub_type_decl env ty1 ty2 =
 520   let env, ty1 = localize_with_self env ty1 in
 521   let env, ty2 = localize_with_self env ty2 in
 522   ignore (TUtils.sub_type env ty1 ty2)