hphp/hack/src/typing/typing_enforceability.ml

   1 (*
   2  * Copyright (c) 2017, 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 Typing_defs
  12 open Typing_env_types
  13
  14 module Cls = Decl_provider.Class
  15 module MakeType = Typing_make_type
  16 module Env = Typing_env
  17
  18 let wrap_like ty =
  19   let r = Typing_reason.Renforceable (Typing_reason.to_pos (fst ty)) in
  20   MakeType.like r ty
  21
  22 let rec pessimize_type env ?(trust_awaitable=false) (ty: decl ty) =
  23   if not (TypecheckerOptions.pessimize_types (Env.get_tcopt env)) then ty else
  24   match ty with
  25   | _, Terr
  26   | _, Tany _
  27   | _, Tnonnull
  28   | _, Tprim _
  29   | _, Tdynamic
  30   | _, Tmixed
  31   | _, Tnothing ->
  32     ty
  33   | _, Tthis ->
  34     wrap_like ty
  35   | r, Tarray (ty1, ty2) ->
  36     let ty1 = Option.map ~f:(pessimize_wrap env) ty1 in
  37     let ty2 = Option.map ~f:(pessimize_wrap env) ty2 in
  38     r, Tarray (ty1, ty2)
  39   | r, Tdarray (tk, tv) ->
  40     r, Tdarray (pessimize_wrap env tk, pessimize_wrap env tv)
  41   | r, Tvarray tv ->
  42     r, Tvarray (pessimize_wrap env tv)
  43   | r, Tvarray_or_darray tv ->
  44     r, Tvarray_or_darray (pessimize_wrap env tv)
  45   | _, Tgeneric x ->
  46     if Env.get_reified env x = Aast.Reified
  47     then
  48       if Env.get_enforceable env x
  49       then ty
  50       else wrap_like ty
  51     else
  52       ty
  53   | r, Toption ty ->
  54     r, Toption (pessimize_type env ty)
  55   | _, Tlike ty ->
  56     pessimize_wrap env ty
  57   | r, Tfun ft ->
  58     wrap_like (r, Tfun (pessimize_fun_type env ft))
  59   | r, Tapply ((p, x), argl) when Env.is_typedef x || Env.is_enum env x ->
  60     (* Enums don't have type arguments so the next line is a no-op for them *)
  61     let argl = List.map ~f:(pessimize_wrap env) argl in
  62     wrap_like (r, Tapply ((p, x), argl))
  63   | r, Tapply ((p, cid), targs) when cid = Naming_special_names.Classes.cAwaitable ->
  64     let f =
  65       if trust_awaitable
  66       then pessimize_type env ~trust_awaitable:false
  67       else pessimize_wrap env in
  68     r, Tapply ((p, cid), List.map ~f targs)
  69   | r, Tapply ((p, cid), targs) ->
  70     let targs = match Env.get_class env cid with
  71     | Some cls ->
  72       pessimize_targs env targs (Cls.tparams cls)
  73     | None ->
  74       targs in
  75     r, Tapply ((p, cid), targs)
  76   | r, Ttuple tyl ->
  77     let tyl = List.map ~f:(pessimize_wrap env) tyl in
  78     wrap_like (r, Ttuple tyl)
  79   | _, Taccess _ ->
  80     wrap_like ty
  81   | r, Tshape (shape_kind, fields_map) ->
  82     let fields_map = Nast.ShapeMap.map (fun shape_field_ty ->
  83       let { sft_ty; _ } = shape_field_ty in
  84       let sft_ty = pessimize_wrap env sft_ty in
  85       { shape_field_ty with sft_ty }
  86     ) fields_map in
  87     wrap_like (r, Tshape (shape_kind, fields_map))
  88
  89 and pessimize_targs env targs tparams =
  90   if not (TypecheckerOptions.pessimize_types (Env.get_tcopt env)) then targs else
  91   let open List in
  92   let new_targs = map2 targs tparams ~f:(fun targ tparam ->
  93     (* Trust reified type arguments *)
  94     if tparam.tp_reified = Aast.Reified
  95     then targ
  96     else pessimize_wrap env targ
  97   ) in
  98   match new_targs with
  99   | Or_unequal_lengths.Ok new_targs ->
 100     new_targs
 101   | Or_unequal_lengths.Unequal_lengths ->
 102     targs
 103
 104 and pessimize_wrap env ty =
 105   let ty = pessimize_type env ty in
 106   match ty with
 107   | _, Terr
 108   | _, Tany _ -> ty (* like Tany is useless *)
 109   | _, Tlike _ -> ty
 110   | _, Tgeneric x when Env.get_reified env x <> Aast.Reified -> ty
 111   | _, Tapply ((_, x), []) when x = Naming_special_names.Typehints.wildcard -> ty
 112   | _ -> wrap_like ty
 113
 114 (* For erased generics with constraints, add super dynamic and make the as constraints like types *)
 115 and pessimize_tparam_constraints env (t: decl tparam) =
 116   if not (TypecheckerOptions.pessimize_types (Env.get_tcopt env)) then t else
 117   match t.tp_reified with
 118   | Aast.Reified -> t
 119   | _ ->
 120     let tp_constraints = List.map t.tp_constraints ~f:(fun (ck, cstr_ty) ->
 121       match ck with
 122       | Ast_defs.Constraint_as | Ast_defs.Constraint_eq ->
 123         ck, pessimize_wrap env cstr_ty
 124       | _ ->
 125         ck, cstr_ty
 126     ) in
 127     let dyn = MakeType.dynamic (Reason.Renforceable (fst t.tp_name)) in
 128     let tp_constraints =
 129       (Ast_defs.Constraint_super, dyn) :: tp_constraints in
 130     { t with tp_constraints }
 131
 132 and pessimize_fun_type env (ft: decl fun_type) =
 133   (* TODO: It may be necessary to pessimize ft_arity and ft_where_constraints *)
 134   let {
 135     ft_params;
 136     ft_ret;
 137     ft_fun_kind;
 138     ft_tparams;
 139     _
 140   } = ft in
 141   (* The runtime will enforce the inner type of an Awaitable in the return of an
 142    * async function *)
 143   let trust_awaitable = match ft_fun_kind with
 144   | Ast_defs.FAsync | Ast_defs.FAsyncGenerator -> true
 145   | _ -> false in
 146   let ft_ret_type = pessimize_type env ~trust_awaitable ft_ret.et_type in
 147   let ft_params = List.map ft_params ~f:(fun param ->
 148     let ty = pessimize_type env param.fp_type.et_type in
 149     { param with fp_type = { param.fp_type with et_type = ty } }
 150   ) in
 151   let ft_tparams = Tuple.T2.map_fst ft_tparams
 152     ~f:(List.map ~f:(pessimize_tparam_constraints env)) in
 153   { ft with
 154     ft_params;
 155     ft_ret = { ft_ret with et_type = ft_ret_type };
 156     ft_tparams;
 157   }
 158
 159 let rec is_enforceable (env: env) (ty: decl ty) =
 160   match snd ty with
 161   | Tthis -> false
 162   | Tapply ((_, name), _) when Env.is_enum env name -> false
 163   | Tapply ((_, name), _) when Env.is_typedef name ->
 164     begin match Env.get_typedef env name with
 165     | Some { td_vis = Aast.Transparent; td_tparams; td_type; _ } ->
 166       (* So that the check does not collide with reified generics *)
 167       let env = Env.add_generic_parameters env td_tparams in
 168       is_enforceable env td_type
 169     | _ -> false end
 170   | Tapply ((_, name), tyl) ->
 171     begin match Env.get_class env name with
 172     | Some tc ->
 173       let tparams = Cls.tparams tc in
 174       begin match tyl with
 175       | [] -> true
 176       | targs ->
 177         let open List.Or_unequal_lengths in
 178         begin match List.fold2 ~init:true targs tparams ~f:(fun acc targ tparam ->
 179           match targ with
 180           | _, Tdynamic (* We accept the inner type being dynamic regardless of reification *)
 181           | _, Tlike _ ->
 182             acc
 183           | _ ->
 184             match tparam.tp_reified with
 185             | Aast.Erased -> false
 186             | Aast.SoftReified -> false
 187             | Aast.Reified -> is_enforceable env targ && acc
 188         ) with
 189         | Ok new_acc -> new_acc
 190         | Unequal_lengths -> true
 191         end
 192       end
 193     | None -> true
 194     end
 195   | Tgeneric name ->
 196     begin match Env.get_reified env name, Env.get_enforceable env name with
 197     | Aast.Erased, _ -> false
 198     | Aast.SoftReified, _ -> false
 199     | Aast.Reified, false -> false
 200     | Aast.Reified, true ->
 201       true
 202     end
 203   | Taccess _ -> false
 204   | Tlike _ -> false
 205   | Tarray (None, None) -> true
 206   | Tarray _ -> false
 207   | Tprim prim ->
 208     begin match prim with
 209       | Aast.Tvoid
 210       | Aast.Tnoreturn -> false
 211       | _ -> true
 212     end
 213   | Tany _ -> true
 214   | Terr -> true
 215   | Tnonnull -> true
 216   | Tdynamic -> true
 217   | Tfun _ -> false
 218   | Ttuple _ -> false
 219   | Tshape _ -> false
 220   | Tmixed -> true
 221   | Tnothing -> true
 222   | Tdarray _ -> false
 223   | Tvarray _ -> false
 224   (* With no parameters, we enforce varray_or_darray just like array *)
 225   | Tvarray_or_darray (_, Tany _) -> true
 226   | Tvarray_or_darray _ -> false
 227   | Toption ty ->
 228     is_enforceable env ty
 229
 230 let is_enforced env ty =
 231   let enforceable = is_enforceable env ty in
 232   let is_hhi =
 233     fst ty |>
 234     Reason.to_pos |>
 235     Pos.filename |>
 236     Relative_path.prefix |>
 237     (=) Relative_path.Hhi in
 238   enforceable && not is_hhi
 239
 240 let pessimize_type_simple env (ty: decl ty) =
 241   if not env.pessimize then ty else
 242   match ty with
 243   | _, Tprim (Aast.Tvoid | Aast.Tnoreturn) -> ty
 244   | _ -> wrap_like ty
 245
 246 let compute_enforced_and_pessimize_ty_simple env (ty: decl ty) =
 247   let et_enforced = is_enforced env ty in
 248   let et_type =
 249     if not et_enforced
 250     then pessimize_type_simple env ty
 251     else ty in
 252   { et_type; et_enforced }
 253
 254 let compute_enforced_and_pessimize_fun_type_simple env (ft: decl fun_type) =
 255   let { ft_params; ft_ret = { et_type; _ }; _ } = ft in
 256   let ft_ret = compute_enforced_and_pessimize_ty_simple env et_type in
 257   let ft_params = List.map ~f:(fun fp ->
 258     let { fp_type = { et_type; _ }; _ } = fp in
 259     let fp_type = compute_enforced_and_pessimize_ty_simple env et_type in
 260     { fp with fp_type }
 261   ) ft_params in
 262   { ft with ft_params; ft_ret }