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_core
  10  open Nast
  11  open Typing_defs
  12
  13  module Env = Typing_env
  14  module SN = Naming_special_names
  15  module SubType = Typing_subtype
  16
  17 let check_param : Env.env -> Nast.fun_param -> unit =
  18   fun env {param_hint; param_pos; _} ->
  19   let error ty =
  20     let ty_str = Typing_print.error (snd ty) in
  21     let msgl = Reason.to_string ("This is "^ty_str) (fst ty) in
  22     Errors.invalid_memoized_param param_pos msgl
  23   in
  24   let rec check_memoizable: Env.env -> locl ty -> unit =
  25     fun env ty ->
  26     let env, ty = Env.expand_type env ty in
  27     match ty with
  28     | _, (Tprim (Tarraykey | Tbool | Tint | Tfloat | Tstring | Tnum)
  29          | Tmixed | Tnonnull | Tany | Terr | Tabstract (AKenum _, _) | Tdynamic) ->
  30        ()
  31     | _, Tprim (Tvoid | Tresource | Tnoreturn) -> error ty
  32     | _, Toption ty -> check_memoizable env ty
  33     | _, Ttuple tyl -> List.iter tyl (check_memoizable env)
  34     | _, Tabstract (AKnewtype (_, _), _) ->
  35       let env, t', _ =
  36         let ety_env = Typing_phase.env_with_self env in
  37         Typing_tdef.force_expand_typedef ~ety_env env ty in
  38       check_memoizable env t'
  39     (* Just accept all generic types for now. Stricter check_memoizables to come later. *)
  40     | _, Tabstract (AKgeneric _, _) ->
  41       ()
  42     (* For parameter type 'this::TID' defined by 'type const TID as Bar' check_memoizables
  43      * Bar recursively.
  44      *)
  45     | _, Tabstract (AKdependent _, Some ty) -> check_memoizable env ty
  46     (* Allow unconstrined dependent type `abstract type const TID` just as we
  47      * allow unconstrained generics. *)
  48     | _, Tabstract (AKdependent _, None) -> ()
  49     (* Handling Tunresolved case here for completeness, even though it
  50      * shouldn't be possible to have an unresolved type when check_memoizableing
  51      * the method declaration. No corresponding test case for this.
  52      *)
  53     | _, Tunresolved tyl -> List.iter tyl (check_memoizable env)
  54     (* Allow untyped arrays. *)
  55     | _, Tarraykind AKany
  56     | _, Tarraykind AKempty ->
  57         ()
  58     | _,
  59       Tarraykind (
  60         AKvarray ty
  61         | AKvec ty
  62         | AKdarray(_, ty)
  63         | AKvarray_or_darray ty
  64         | AKmap(_, ty)
  65       ) ->
  66         check_memoizable env ty
  67     | _, Tshape (_, fdm) ->
  68       ShapeMap.iter begin fun _ {sft_ty; _} ->
  69         check_memoizable env sft_ty
  70       end fdm
  71     | _, Tarraykind (AKshape fdm) ->
  72       ShapeMap.iter begin fun _ (_, tv) ->
  73         check_memoizable env tv
  74       end fdm
  75     | _, Tarraykind (AKtuple fields) ->
  76       IMap.iter begin fun _ tv ->
  77         check_memoizable env tv
  78       end fields
  79     | _, Tclass (_, _) ->
  80       let type_param = Env.fresh_type() in
  81       let container_type =
  82         Reason.none,
  83         Tclass ((Pos.none, SN.Collections.cContainer), [type_param]) in
  84       let env, is_container =
  85         Errors.try_
  86           (fun () ->
  87             SubType.sub_type env ty container_type, true)
  88           (fun _ -> env, false) in
  89       if is_container then
  90         check_memoizable env type_param
  91       else
  92         let r, _ = ty in
  93         let memoizable_type =
  94           r, Tclass ((Pos.none, SN.Classes.cIMemoizeParam), []) in
  95         if SubType.is_sub_type env ty memoizable_type
  96         then ()
  97         else error ty;
  98     | _, Tfun _
  99     | _, Tvar _
 100     | _, Tanon (_, _)
 101     | _, Tobject -> error ty
 102   in
 103   match param_hint with
 104   | None -> ()
 105   | Some hint ->
 106     let env, ty = Typing_phase.hint_locl env hint in
 107     check_memoizable env ty
 108
 109 let check: Env.env -> Nast.user_attribute list ->
 110     Nast.fun_param list -> Nast.fun_variadicity -> unit =
 111   fun env user_attributes params variadic ->
 112   if Attributes.mem SN.UserAttributes.uaMemoize user_attributes then begin
 113     List.iter ~f:(check_param env) params;
 114     match variadic with
 115     | FVvariadicArg vparam -> check_param env vparam
 116     | FVellipsis
 117     | FVnonVariadic -> ()
 118   end
 119
 120 let check_function: Env.env -> Nast.fun_ -> unit =
 121   fun env {f_user_attributes; f_params; f_variadic; _ } ->
 122   check env f_user_attributes f_params f_variadic
 123
 124 let check_method: Env.env -> Nast.method_ -> unit =
 125   fun env {m_user_attributes; m_params; m_variadic; _ } ->
 126   check env m_user_attributes m_params m_variadic