hphp/hack/src/decl/decl_fun_utils.ml

   1 (*
   2  * Copyright (c) 2018, 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 Aast
  12 open Typing_defs
  13
  14 let get_classname_or_literal_attribute_param = function
  15   | [(_, String s)] -> Some s
  16   | [(_, Class_const ((_, CI (_, s)), (_, name)))]
  17     when String.equal name SN.Members.mClass ->
  18     Some s
  19   | _ -> None
  20
  21 let find_policied_attribute user_attributes : ifc_fun_decl =
  22   match Naming_attributes.find SN.UserAttributes.uaPolicied user_attributes with
  23   | Some { ua_params; _ } ->
  24     (match get_classname_or_literal_attribute_param ua_params with
  25     | Some s -> FDPolicied (Some s)
  26     | None -> FDPolicied None)
  27   | None
  28     when Naming_attributes.mem SN.UserAttributes.uaInferFlows user_attributes ->
  29     FDInferFlows
  30   | None -> default_ifc_fun_decl
  31
  32 let has_constfun_attribute user_attributes =
  33   Naming_attributes.mem SN.UserAttributes.uaConstFun user_attributes
  34
  35 let has_accept_disposable_attribute user_attributes =
  36   Naming_attributes.mem SN.UserAttributes.uaAcceptDisposable user_attributes
  37
  38 let has_external_attribute user_attributes =
  39   Naming_attributes.mem SN.UserAttributes.uaExternal user_attributes
  40
  41 let has_can_call_attribute user_attributes =
  42   Naming_attributes.mem SN.UserAttributes.uaCanCall user_attributes
  43
  44 let has_atom_attribute user_attributes =
  45   Naming_attributes.mem SN.UserAttributes.uaAtom user_attributes
  46
  47 let has_return_disposable_attribute user_attributes =
  48   Naming_attributes.mem SN.UserAttributes.uaReturnDisposable user_attributes
  49
  50 exception Gi_reinfer_type_not_supported
  51
  52 let cut_namespace id =
  53   let ids = String.split id ~on:'\\' in
  54   List.last_exn ids
  55
  56 let rec reinfer_type_to_string_exn ty =
  57   match ty with
  58   | Tmixed -> "mixed"
  59   | Tnonnull -> "nonnull"
  60   | Tdynamic -> "dynamic"
  61   | Tunion [] -> "nothing"
  62   | Tthis -> "this"
  63   | Tprim prim ->
  64     (match prim with
  65     | Tnull -> "null"
  66     | Tvoid -> "void"
  67     | Tint -> "int"
  68     | Tnum -> "num"
  69     | Tfloat -> "float"
  70     | Tstring -> "string"
  71     | Tarraykey -> "arraykey"
  72     | Tresource -> "resource"
  73     | Tnoreturn -> "noreturn"
  74     | Tbool -> "bool")
  75   | Tapply ((_p, id), _tyl) -> cut_namespace id
  76   | Taccess (ty, id) ->
  77     let s = reinfer_type_to_string_exn (get_node ty) in
  78     Printf.sprintf "%s::%s" s (snd id)
  79   | _ -> raise Gi_reinfer_type_not_supported
  80
  81 let reinfer_type_to_string_opt ty =
  82   try Some (reinfer_type_to_string_exn ty)
  83   with Gi_reinfer_type_not_supported -> None
  84
  85 let must_reinfer_type tcopt (ty : decl_phase ty_) =
  86   let reinfer_types = GlobalOptions.tco_gi_reinfer_types tcopt in
  87   match reinfer_type_to_string_opt ty with
  88   | None -> false
  89   | Some ty_str -> List.mem reinfer_types ty_str ~equal:String.equal
  90
  91 let hint_to_type_opt ~is_lambda env reason hint =
  92   let ty = Option.map hint ~f:(Decl_hint.hint env) in
  93   let tcopt = Provider_context.get_tcopt env.Decl_env.ctx in
  94   let tco_global_inference = GlobalOptions.tco_global_inference tcopt in
  95   let tvar = mk (reason, Tvar 0) in
  96   if tco_global_inference && not is_lambda then
  97     let ty =
  98       match ty with
  99       | None -> tvar
 100       | Some ty ->
 101         let rec create_vars_for_reinfer_types ty =
 102           match deref ty with
 103           | (r, Tapply (id, [ty']))
 104             when String.equal (snd id) SN.Classes.cAwaitable ->
 105             let ty' = create_vars_for_reinfer_types ty' in
 106             mk (r, Tapply (id, [ty']))
 107           | (r, Toption ty') ->
 108             let ty' = create_vars_for_reinfer_types ty' in
 109             mk (r, Toption ty')
 110           | (r, Tapply ((_p, id), []))
 111             when String.equal (cut_namespace id) "PHPism_FIXME_Array" ->
 112             if must_reinfer_type tcopt (get_node ty) then
 113               let tvar = mk (r, Tvar 0) in
 114               mk (r, Tvarray_or_darray (tvar, tvar))
 115             else
 116               ty
 117           | (r, Tvarray ty) ->
 118             let ty = create_vars_for_reinfer_types ty in
 119             mk (r, Tvarray ty)
 120           | (r, Tdarray (tyk, tyv)) ->
 121             let tyk = create_vars_for_reinfer_types tyk in
 122             let tyv = create_vars_for_reinfer_types tyv in
 123             mk (r, Tdarray (tyk, tyv))
 124           | (r, Tvarray_or_darray (tyk, tyv)) ->
 125             let tyk = create_vars_for_reinfer_types tyk in
 126             let tyv = create_vars_for_reinfer_types tyv in
 127             mk (r, Tvarray_or_darray (tyk, tyv))
 128           | (_r, ty_) ->
 129             if must_reinfer_type tcopt ty_ then
 130               tvar
 131             else
 132               ty
 133         in
 134         create_vars_for_reinfer_types ty
 135     in
 136     Some ty
 137   else
 138     ty
 139
 140 let hint_to_type ~is_lambda ~default env reason hint =
 141   Option.value (hint_to_type_opt ~is_lambda env reason hint) ~default
 142
 143 let make_param_ty env ~is_lambda param =
 144   let param_pos = Decl_env.make_decl_pos env param.param_pos in
 145   let ty =
 146     let r = Reason.Rwitness param_pos in
 147     hint_to_type
 148       ~is_lambda
 149       ~default:(mk (r, Typing_defs.make_tany ()))
 150       env
 151       (Reason.Rglobal_fun_param param_pos)
 152       (hint_of_type_hint param.param_type_hint)
 153   in
 154   let ty =
 155     match get_node ty with
 156     | t when param.param_is_variadic ->
 157       (* When checking a call f($a, $b) to a function f(C ...$args),
 158        * both $a and $b must be of type C *)
 159       mk (Reason.Rvar_param param_pos, t)
 160     | _ -> ty
 161   in
 162   let module UA = SN.UserAttributes in
 163   let mode = get_param_mode param.param_callconv in
 164   {
 165     fp_pos = param_pos;
 166     fp_name = Some param.param_name;
 167     fp_type = { et_type = ty; et_enforced = false };
 168     fp_flags =
 169       make_fp_flags
 170         ~mode
 171         ~accept_disposable:
 172           (has_accept_disposable_attribute param.param_user_attributes)
 173         ~has_default:(Option.is_some param.param_expr)
 174         ~ifc_external:(has_external_attribute param.param_user_attributes)
 175         ~ifc_can_call:(has_can_call_attribute param.param_user_attributes)
 176         ~is_atom:(has_atom_attribute param.param_user_attributes)
 177         ~readonly:(Option.is_some param.param_readonly)
 178         ~const_function:(has_constfun_attribute param.param_user_attributes);
 179   }
 180
 181 (** Make FunParam for the partial-mode ellipsis parameter (unnamed, and untyped) *)
 182 let make_ellipsis_param_ty :
 183     Decl_env.env -> Pos.t -> 'phase ty Typing_defs_core.fun_param =
 184  fun env pos ->
 185   let pos = Decl_env.make_decl_pos env pos in
 186   let r = Reason.Rwitness pos in
 187   let ty = mk (r, Typing_defs.make_tany ()) in
 188   {
 189     fp_pos = pos;
 190     fp_name = None;
 191     fp_type = { et_type = ty; et_enforced = false };
 192     fp_flags =
 193       make_fp_flags
 194         ~mode:FPnormal
 195         ~accept_disposable:false
 196         ~has_default:false
 197         ~ifc_external:false
 198         ~ifc_can_call:false
 199         ~is_atom:false
 200         ~readonly:false
 201         ~const_function:false;
 202   }
 203
 204 let ret_from_fun_kind ?(is_constructor = false) ~is_lambda env pos kind hint =
 205   let pos = Decl_env.make_decl_pos env pos in
 206   let default = mk (Reason.Rwitness pos, Typing_defs.make_tany ()) in
 207   let ret_ty () =
 208     if is_constructor then
 209       mk (Reason.Rwitness pos, Tprim Tvoid)
 210     else
 211       hint_to_type ~is_lambda ~default env (Reason.Rglobal_fun_ret pos) hint
 212   in
 213   match hint with
 214   | None ->
 215     (match kind with
 216     | Ast_defs.FGenerator ->
 217       let r = Reason.Rret_fun_kind (pos, kind) in
 218       mk
 219         ( r,
 220           Tapply
 221             ((pos, SN.Classes.cGenerator), [ret_ty (); ret_ty (); ret_ty ()]) )
 222     | Ast_defs.FAsyncGenerator ->
 223       let r = Reason.Rret_fun_kind (pos, kind) in
 224       mk
 225         ( r,
 226           Tapply
 227             ( (pos, SN.Classes.cAsyncGenerator),
 228               [ret_ty (); ret_ty (); ret_ty ()] ) )
 229     | Ast_defs.FAsync ->
 230       let r = Reason.Rret_fun_kind (pos, kind) in
 231       mk (r, Tapply ((pos, SN.Classes.cAwaitable), [ret_ty ()]))
 232     | Ast_defs.FSync -> ret_ty ())
 233   | Some _ -> ret_ty ()
 234
 235 let type_param = Decl_hint.aast_tparam_to_decl_tparam
 236
 237 let where_constraint env (ty1, ck, ty2) =
 238   (Decl_hint.hint env ty1, ck, Decl_hint.hint env ty2)
 239
 240 (* Functions building the types for the parameters of a function *)
 241 (* It's not completely trivial because of optional arguments  *)
 242
 243 let check_params paraml =
 244   (* We wish to give an error on the first non-default parameter
 245   after a default parameter. That is:
 246   function foo(int $x, ?int $y = null, int $z)
 247   is an error on $z. *)
 248   (* TODO: This check doesn't need to be done at type checking time; it is
 249   entirely syntactic. When we switch over to the FFP, remove this code. *)
 250   let rec loop seen_default paraml =
 251     match paraml with
 252     | [] -> ()
 253     | param :: rl ->
 254       if param.param_is_variadic then
 255         ()
 256       (* Assume that a variadic parameter is the last one we need
 257             to check. We've already given a parse error if the variadic
 258             parameter is not last. *)
 259       else if seen_default && Option.is_none param.param_expr then
 260         Errors.previous_default param.param_pos
 261       (* We've seen at least one required parameter, and there's an
 262           optional parameter after it.  Given an error, and then stop looking
 263           for more errors in this parameter list. *)
 264       else
 265         loop (Option.is_some param.param_expr) rl
 266   in
 267   loop false paraml
 268
 269 let make_params env ~is_lambda paraml =
 270   List.map paraml ~f:(make_param_ty env ~is_lambda)