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 conditionally_reactive_attribute_to_hint env { ua_params = l; _ } =
  15   match l with
  16   (* convert class const expression to non-generic type hint *)
  17   | [(p, Class_const ((_, CI cls), (_, name)))]
  18     when String.equal name SN.Members.mClass ->
  19     (* set Extends dependency for between class that contains
  20          method and condition type *)
  21     Decl_env.add_extends_dependency env (snd cls);
  22     Decl_hint.hint env (p, Happly (cls, []))
  23   | _ ->
  24     (* error for invalid argument list was already reported during the
  25        naming step, do nothing *)
  26     mk (Reason.none, Typing_defs.make_tany ())
  27
  28 let condition_type_from_attributes env user_attributes =
  29   Naming_attributes.find SN.UserAttributes.uaOnlyRxIfImpl user_attributes
  30   |> Option.map ~f:(conditionally_reactive_attribute_to_hint env)
  31
  32 let get_classname_or_literal_attribute_param = function
  33   | [(_, String s)] -> Some s
  34   | [(_, Class_const ((_, CI (_, s)), (_, name)))]
  35     when String.equal name SN.Members.mClass ->
  36     Some s
  37   | _ -> None
  38
  39 let fun_reactivity_opt env user_attributes =
  40   let module UA = SN.UserAttributes in
  41   let rx_condition = condition_type_from_attributes env user_attributes in
  42   let rec go = function
  43     | [] -> None
  44     | { Aast.ua_name = (_, n); ua_params } :: tl ->
  45       if String.equal n UA.uaPure then
  46         Some (Pure rx_condition)
  47       else if String.equal n UA.uaNonRx then
  48         Some Nonreactive
  49       else if String.equal n UA.uaCipp then
  50         Some (Cipp (get_classname_or_literal_attribute_param ua_params))
  51       else if String.equal n UA.uaCippLocal then
  52         Some (CippLocal (get_classname_or_literal_attribute_param ua_params))
  53       else if String.equal n UA.uaCippGlobal then
  54         Some CippGlobal
  55       else
  56         go tl
  57   in
  58   go user_attributes
  59
  60 let fun_reactivity env user_attributes =
  61   fun_reactivity_opt env user_attributes |> Option.value ~default:Nonreactive
  62
  63 let find_policied_attribute user_attributes : ifc_fun_decl =
  64   match Naming_attributes.find SN.UserAttributes.uaPolicied user_attributes with
  65   | Some { ua_params; _ } ->
  66     (match get_classname_or_literal_attribute_param ua_params with
  67     | Some s -> FDPolicied (Some s)
  68     | None -> FDPolicied None)
  69   | None
  70     when Naming_attributes.mem SN.UserAttributes.uaInferFlows user_attributes ->
  71     FDInferFlows
  72   | None -> default_ifc_fun_decl
  73
  74 let has_constfun_attribute user_attributes =
  75   Naming_attributes.mem SN.UserAttributes.uaConstFun user_attributes
  76
  77 let has_accept_disposable_attribute user_attributes =
  78   Naming_attributes.mem SN.UserAttributes.uaAcceptDisposable user_attributes
  79
  80 let has_external_attribute user_attributes =
  81   Naming_attributes.mem SN.UserAttributes.uaExternal user_attributes
  82
  83 let has_can_call_attribute user_attributes =
  84   Naming_attributes.mem SN.UserAttributes.uaCanCall user_attributes
  85
  86 let has_atom_attribute user_attributes =
  87   Naming_attributes.mem SN.UserAttributes.uaAtom user_attributes
  88
  89 let has_return_disposable_attribute user_attributes =
  90   Naming_attributes.mem SN.UserAttributes.uaReturnDisposable user_attributes
  91
  92 let fun_returns_mutable user_attributes =
  93   Naming_attributes.mem SN.UserAttributes.uaMutableReturn user_attributes
  94
  95 let fun_returns_void_to_rx user_attributes =
  96   Naming_attributes.mem SN.UserAttributes.uaReturnsVoidToRx user_attributes
  97
  98 let get_param_mutability user_attributes =
  99   if Naming_attributes.mem SN.UserAttributes.uaOwnedMutable user_attributes then
 100     Some Param_owned_mutable
 101   else if Naming_attributes.mem SN.UserAttributes.uaMutable user_attributes then
 102     Some Param_borrowed_mutable
 103   else if Naming_attributes.mem SN.UserAttributes.uaMaybeMutable user_attributes
 104   then
 105     Some Param_maybe_mutable
 106   else
 107     None
 108
 109 exception Gi_reinfer_type_not_supported
 110
 111 let cut_namespace id =
 112   let ids = String.split id ~on:'\\' in
 113   List.last_exn ids
 114
 115 let rec reinfer_type_to_string_exn ty =
 116   match ty with
 117   | Tmixed -> "mixed"
 118   | Tnonnull -> "nonnull"
 119   | Tdynamic -> "dynamic"
 120   | Tunion [] -> "nothing"
 121   | Tthis -> "this"
 122   | Tprim prim ->
 123     (match prim with
 124     | Tnull -> "null"
 125     | Tvoid -> "void"
 126     | Tint -> "int"
 127     | Tnum -> "num"
 128     | Tfloat -> "float"
 129     | Tstring -> "string"
 130     | Tarraykey -> "arraykey"
 131     | Tresource -> "resource"
 132     | Tnoreturn -> "noreturn"
 133     | Tbool -> "bool")
 134   | Tapply ((_p, id), _tyl) -> cut_namespace id
 135   | Taccess (ty, id) ->
 136     let s = reinfer_type_to_string_exn (get_node ty) in
 137     Printf.sprintf "%s::%s" s (snd id)
 138   | _ -> raise Gi_reinfer_type_not_supported
 139
 140 let reinfer_type_to_string_opt ty =
 141   try Some (reinfer_type_to_string_exn ty)
 142   with Gi_reinfer_type_not_supported -> None
 143
 144 let must_reinfer_type tcopt (ty : decl_phase ty_) =
 145   let reinfer_types = GlobalOptions.tco_gi_reinfer_types tcopt in
 146   match reinfer_type_to_string_opt ty with
 147   | None -> false
 148   | Some ty_str -> List.mem reinfer_types ty_str ~equal:String.equal
 149
 150 let hint_to_type_opt ~is_lambda env reason hint =
 151   let ty = Option.map hint ~f:(Decl_hint.hint env) in
 152   let tcopt = Provider_context.get_tcopt env.Decl_env.ctx in
 153   let tco_global_inference = GlobalOptions.tco_global_inference tcopt in
 154   let tvar = mk (reason, Tvar 0) in
 155   if tco_global_inference && not is_lambda then
 156     let ty =
 157       match ty with
 158       | None -> tvar
 159       | Some ty ->
 160         let rec create_vars_for_reinfer_types ty =
 161           match deref ty with
 162           | (r, Tapply (id, [ty']))
 163             when String.equal (snd id) SN.Classes.cAwaitable ->
 164             let ty' = create_vars_for_reinfer_types ty' in
 165             mk (r, Tapply (id, [ty']))
 166           | (r, Toption ty') ->
 167             let ty' = create_vars_for_reinfer_types ty' in
 168             mk (r, Toption ty')
 169           | (r, Tapply ((_p, id), []))
 170             when String.equal (cut_namespace id) "PHPism_FIXME_Array" ->
 171             if must_reinfer_type tcopt (get_node ty) then
 172               let tvar = mk (r, Tvar 0) in
 173               mk (r, Tvarray_or_darray (tvar, tvar))
 174             else
 175               ty
 176           | (r, Tvarray ty) ->
 177             let ty = create_vars_for_reinfer_types ty in
 178             mk (r, Tvarray ty)
 179           | (r, Tdarray (tyk, tyv)) ->
 180             let tyk = create_vars_for_reinfer_types tyk in
 181             let tyv = create_vars_for_reinfer_types tyv in
 182             mk (r, Tdarray (tyk, tyv))
 183           | (r, Tvarray_or_darray (tyk, tyv)) ->
 184             let tyk = create_vars_for_reinfer_types tyk in
 185             let tyv = create_vars_for_reinfer_types tyv in
 186             mk (r, Tvarray_or_darray (tyk, tyv))
 187           | (_r, ty_) ->
 188             if must_reinfer_type tcopt ty_ then
 189               tvar
 190             else
 191               ty
 192         in
 193         create_vars_for_reinfer_types ty
 194     in
 195     Some ty
 196   else
 197     ty
 198
 199 let hint_to_type ~is_lambda ~default env reason hint =
 200   Option.value (hint_to_type_opt ~is_lambda env reason hint) ~default
 201
 202 let make_param_ty env ~is_lambda param =
 203   let param_pos = Decl_env.make_decl_pos env param.param_pos in
 204   let ty =
 205     let r = Reason.Rwitness param_pos in
 206     hint_to_type
 207       ~is_lambda
 208       ~default:(mk (r, Typing_defs.make_tany ()))
 209       env
 210       (Reason.Rglobal_fun_param param_pos)
 211       (hint_of_type_hint param.param_type_hint)
 212   in
 213   let ty =
 214     match get_node ty with
 215     | t when param.param_is_variadic ->
 216       (* When checking a call f($a, $b) to a function f(C ...$args),
 217        * both $a and $b must be of type C *)
 218       mk (Reason.Rvar_param param_pos, t)
 219     | _ -> ty
 220   in
 221   let module UA = SN.UserAttributes in
 222   let has_at_most_rx_as_func =
 223     Naming_attributes.mem UA.uaAtMostRxAsFunc param.param_user_attributes
 224   in
 225   let ty =
 226     if has_at_most_rx_as_func then
 227       make_function_type_rxvar ty
 228     else
 229       ty
 230   in
 231   let mode = get_param_mode param.param_callconv in
 232   let rx_annotation =
 233     if has_at_most_rx_as_func then
 234       Some Param_rx_var
 235     else
 236       Naming_attributes.find UA.uaOnlyRxIfImpl param.param_user_attributes
 237       |> Option.map ~f:(fun v ->
 238              Param_rx_if_impl (conditionally_reactive_attribute_to_hint env v))
 239   in
 240   {
 241     fp_pos = param_pos;
 242     fp_name = Some param.param_name;
 243     fp_type = { et_type = ty; et_enforced = false };
 244     fp_flags =
 245       make_fp_flags
 246         ~mode
 247         ~mutability:(get_param_mutability param.param_user_attributes)
 248         ~accept_disposable:
 249           (has_accept_disposable_attribute param.param_user_attributes)
 250         ~has_default:(Option.is_some param.param_expr)
 251         ~ifc_external:(has_external_attribute param.param_user_attributes)
 252         ~ifc_can_call:(has_can_call_attribute param.param_user_attributes)
 253         ~is_atom:(has_atom_attribute param.param_user_attributes)
 254         ~readonly:(Option.is_some param.param_readonly)
 255         ~const_function:(has_constfun_attribute param.param_user_attributes);
 256     fp_rx_annotation = rx_annotation;
 257   }
 258
 259 (** Make FunParam for the partial-mode ellipsis parameter (unnamed, and untyped) *)
 260 let make_ellipsis_param_ty :
 261     Decl_env.env -> Pos.t -> 'phase ty Typing_defs_core.fun_param =
 262  fun env pos ->
 263   let pos = Decl_env.make_decl_pos env pos in
 264   let r = Reason.Rwitness pos in
 265   let ty = mk (r, Typing_defs.make_tany ()) in
 266   {
 267     fp_pos = pos;
 268     fp_name = None;
 269     fp_type = { et_type = ty; et_enforced = false };
 270     fp_flags =
 271       make_fp_flags
 272         ~mode:FPnormal
 273         ~mutability:None
 274         ~accept_disposable:false
 275         ~has_default:false
 276         ~ifc_external:false
 277         ~ifc_can_call:false
 278         ~is_atom:false
 279         ~readonly:false
 280         ~const_function:false;
 281     fp_rx_annotation = None;
 282   }
 283
 284 let ret_from_fun_kind ?(is_constructor = false) ~is_lambda env pos kind hint =
 285   let pos = Decl_env.make_decl_pos env pos in
 286   let default = mk (Reason.Rwitness pos, Typing_defs.make_tany ()) in
 287   let ret_ty () =
 288     if is_constructor then
 289       mk (Reason.Rwitness pos, Tprim Tvoid)
 290     else
 291       hint_to_type ~is_lambda ~default env (Reason.Rglobal_fun_ret pos) hint
 292   in
 293   match hint with
 294   | None ->
 295     (match kind with
 296     | Ast_defs.FGenerator ->
 297       let r = Reason.Rret_fun_kind (pos, kind) in
 298       mk
 299         ( r,
 300           Tapply
 301             ((pos, SN.Classes.cGenerator), [ret_ty (); ret_ty (); ret_ty ()]) )
 302     | Ast_defs.FAsyncGenerator ->
 303       let r = Reason.Rret_fun_kind (pos, kind) in
 304       mk
 305         ( r,
 306           Tapply
 307             ( (pos, SN.Classes.cAsyncGenerator),
 308               [ret_ty (); ret_ty (); ret_ty ()] ) )
 309     | Ast_defs.FAsync ->
 310       let r = Reason.Rret_fun_kind (pos, kind) in
 311       mk (r, Tapply ((pos, SN.Classes.cAwaitable), [ret_ty ()]))
 312     | Ast_defs.FSync -> ret_ty ())
 313   | Some _ -> ret_ty ()
 314
 315 let type_param = Decl_hint.aast_tparam_to_decl_tparam
 316
 317 let where_constraint env (ty1, ck, ty2) =
 318   (Decl_hint.hint env ty1, ck, Decl_hint.hint env ty2)
 319
 320 (* Functions building the types for the parameters of a function *)
 321 (* It's not completely trivial because of optional arguments  *)
 322
 323 let check_params paraml =
 324   (* We wish to give an error on the first non-default parameter
 325   after a default parameter. That is:
 326   function foo(int $x, ?int $y = null, int $z)
 327   is an error on $z. *)
 328   (* TODO: This check doesn't need to be done at type checking time; it is
 329   entirely syntactic. When we switch over to the FFP, remove this code. *)
 330   let rec loop seen_default paraml =
 331     match paraml with
 332     | [] -> ()
 333     | param :: rl ->
 334       if param.param_is_variadic then
 335         ()
 336       (* Assume that a variadic parameter is the last one we need
 337             to check. We've already given a parse error if the variadic
 338             parameter is not last. *)
 339       else if seen_default && Option.is_none param.param_expr then
 340         Errors.previous_default param.param_pos
 341       (* We've seen at least one required parameter, and there's an
 342           optional parameter after it.  Given an error, and then stop looking
 343           for more errors in this parameter list. *)
 344       else
 345         loop (Option.is_some param.param_expr) rl
 346   in
 347   loop false paraml
 348
 349 let make_params env ~is_lambda paraml =
 350   List.map paraml ~f:(make_param_ty env ~is_lambda)