hphp/hack/src/typing/typing_memoize.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 open Hh_prelude
  10 open Aast
  11 open Typing_defs
  12 open Typing_env_types
  13 module Env = Typing_env
  14 module SN = Naming_special_names
  15 module SubType = Typing_subtype
  16 module MakeType = Typing_make_type
  17
  18 let check_param : env -> Nast.fun_param -> unit =
  19  fun env { param_type_hint; param_pos; _ } ->
  20   let error ty =
  21     let ty_str = Typing_print.error env ty in
  22     let msgl = Reason.to_string ("This is " ^ ty_str) (get_reason ty) in
  23     Errors.invalid_memoized_param param_pos msgl
  24   in
  25   let rec check_memoizable : env -> locl_ty -> unit =
  26    fun env ty ->
  27     let (env, ty) = Env.expand_type env ty in
  28     let ety_env = Typing_phase.env_with_self env in
  29     let (env, ty, _) = Typing_tdef.force_expand_typedef ~ety_env env ty in
  30     match get_node ty with
  31     | Tprim
  32         (Tnull | Tarraykey | Tbool | Tint | Tfloat | Tstring | Tnum | Tatom _)
  33     | Tnonnull
  34     | Tany _
  35     | Terr
  36     | Tdynamic ->
  37       ()
  38     | Tprim (Tvoid | Tresource | Tnoreturn) -> error ty
  39     | Toption ty -> check_memoizable env ty
  40     | Ttuple tyl -> List.iter tyl (check_memoizable env)
  41     (* Just accept all generic types for now. Stricter check_memoizables to come later. *)
  42     | Tgeneric _ ->
  43       (* FIXME fun fact:
  44         the comment above about "stricter check_memoizables to come later" was added in revision
  45         in August 2015 *)
  46       ()
  47     (* For parameter type 'this::TID' defined by 'type const TID as Bar' check_memoizables
  48      * Bar recursively. Also enums represented using AKnewtype.
  49      *)
  50     | Tnewtype (_, _, ty)
  51     | Tdependent (_, ty) ->
  52       check_memoizable env ty
  53     (* Handling Tunion and Tintersection case here for completeness, even though it
  54      * shouldn't be possible to have an unresolved type when check_memoizableing
  55      * the method declaration. No corresponding test case for this.
  56      *)
  57     | Tunion tyl
  58     | Tintersection tyl ->
  59       List.iter tyl (check_memoizable env)
  60     | Tvarray ty
  61     | Tdarray (_, ty)
  62     | Tvarray_or_darray (_, ty) ->
  63       check_memoizable env ty
  64     | Tshape (_, fdm) ->
  65       ShapeMap.iter
  66         begin
  67           fun _ { sft_ty; _ } ->
  68           check_memoizable env sft_ty
  69         end
  70         fdm
  71     | Tclass _ ->
  72       let p = get_pos ty in
  73       let env = Env.open_tyvars env p in
  74       let (env, type_param) = Env.fresh_type env p in
  75       let container_type = MakeType.container Reason.none type_param in
  76       let (env, props) =
  77         SubType.simplify_subtype_i
  78           env
  79           (LoclType ty)
  80           (LoclType container_type)
  81           Errors.unify_error
  82       in
  83       let (env, prop) = SubType.prop_to_env env props Errors.unify_error in
  84       let is_container = Typing_logic.is_valid prop in
  85       let env = Env.set_tyvar_variance env container_type in
  86       let env = Typing_solver.close_tyvars_and_solve env Errors.unify_error in
  87       if is_container then
  88         check_memoizable env type_param
  89       else
  90         let r = get_reason ty in
  91         let memoizable_type =
  92           MakeType.class_type r SN.Classes.cIMemoizeParam []
  93         in
  94         if Typing_solver.is_sub_type env ty memoizable_type then
  95           ()
  96         else
  97           error ty
  98     | Tpu_type_access _
  99     | Tpu _ ->
 100       ()
 101     | Tfun _
 102     | Tvar _
 103     | Tobject ->
 104       error ty
 105   in
 106   match hint_of_type_hint param_type_hint with
 107   | None -> ()
 108   | Some hint ->
 109     let (env, ty) = Typing_phase.localize_hint_with_self env hint in
 110     check_memoizable env ty
 111
 112 let check :
 113     env ->
 114     Nast.user_attribute list ->
 115     Nast.fun_param list ->
 116     Nast.fun_variadicity ->
 117     unit =
 118  fun env user_attributes params variadic ->
 119   if
 120     Naming_attributes.mem SN.UserAttributes.uaMemoize user_attributes
 121     || Naming_attributes.mem SN.UserAttributes.uaMemoizeLSB user_attributes
 122   then (
 123     List.iter ~f:(check_param env) params;
 124     match variadic with
 125     | FVvariadicArg vparam -> check_param env vparam
 126     | FVellipsis _
 127     | FVnonVariadic ->
 128       ()
 129   )
 130
 131 let check_function : env -> Nast.fun_ -> unit =
 132  fun env { f_user_attributes; f_params; f_variadic; _ } ->
 133   check env f_user_attributes f_params f_variadic
 134
 135 let check_method : env -> Nast.method_ -> unit =
 136  fun env { m_user_attributes; m_params; m_variadic; _ } ->
 137   check env m_user_attributes m_params m_variadic