hphp/hack/src/typing/typing_enforceable_hint.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 open Type_validator
  14 module Env = Tast_env
  15 module Reason = Typing_reason
  16 module TySet = Typing_set
  17 module Cls = Decl_provider.Class
  18 module Nast = Aast
  19
  20 let validator =
  21   object (this)
  22     inherit type_validator as super
  23
  24     (* Only comes about because naming has reported an error and left Hany *)
  25     method! on_tany acc _ = acc
  26
  27     (* Already reported an error *)
  28     method! on_terr acc _ = acc
  29
  30     method! on_tprim acc r prim =
  31       match prim with
  32       | Aast.Tvoid -> this#invalid acc r "the `void` type"
  33       | Aast.Tnoreturn -> this#invalid acc r "the `noreturn` type"
  34       | _ -> acc
  35
  36     method! on_tfun acc r _fun_type = this#invalid acc r "a function type"
  37
  38     method! on_tvar acc r _id = this#invalid acc r "an unknown type"
  39
  40     method! on_typeconst acc is_concrete typeconst =
  41       match typeconst.ttc_abstract with
  42       | _ when snd typeconst.ttc_enforceable || is_concrete ->
  43         super#on_typeconst acc is_concrete typeconst
  44       | _ ->
  45         let (pos, tconst) = typeconst.ttc_name in
  46         let r = Reason.Rwitness pos in
  47         this#invalid acc r
  48         @@ "the abstract type constant "
  49         ^ tconst
  50         ^ " because it is not marked `<<__Enforceable>>`"
  51
  52     method! on_tgeneric acc r name _tyargs =
  53       (* If we allow higher-kinded generics to be enforceable at some point,
  54          handle type arguments here *)
  55       if acc.like_context then
  56         acc
  57       else
  58         this#check_generic acc r name
  59
  60     method! on_newtype acc r _ _ _ _ =
  61       if acc.like_context then
  62         acc
  63       else
  64         this#invalid acc r "a `newtype`"
  65
  66     method! on_tlike acc r ty =
  67       if TypecheckerOptions.like_casts (Tast_env.get_tcopt acc.env) then
  68         super#on_tlike { acc with like_context = true } r ty
  69       else
  70         this#invalid acc r "a like type"
  71
  72     method! on_class acc r cls tyl =
  73       match Env.get_class acc.env (snd cls) with
  74       | Some tc ->
  75         let tparams = Cls.tparams tc in
  76         begin
  77           match tyl with
  78           | [] -> acc
  79           (* this case should really be handled by the fold2,
  80         but we still allow class hints without args in certain places *)
  81           | targs ->
  82             List.Or_unequal_lengths.(
  83               begin
  84                 match
  85                   List.fold2 ~init:acc targs tparams ~f:(fun acc targ tparam ->
  86                       let covariant =
  87                         Ast_defs.(equal_variance tparam.tp_variance Covariant)
  88                       in
  89                       if this#is_wildcard targ then
  90                         acc
  91                       else if
  92                         Aast.(equal_reify_kind tparam.tp_reified Reified)
  93                         || (acc.like_context && covariant)
  94                       then
  95                         this#on_type acc targ
  96                       else
  97                         let error_message =
  98                           "a type with an erased generic type argument"
  99                         in
 100                         let error_message =
 101                           if
 102                             TypecheckerOptions.like_casts
 103                               (Tast_env.get_tcopt acc.env)
 104                           then
 105                             error_message
 106                             ^ ", except in a like cast when the corresponding type parameter is covariant"
 107                           else
 108                             error_message
 109                         in
 110                         this#invalid acc r error_message)
 111                 with
 112                 | Ok new_acc -> new_acc
 113                 | Unequal_lengths -> acc (* arity error elsewhere *)
 114               end)
 115         end
 116       | None -> acc
 117
 118     method! on_alias acc r id tyl ty =
 119       if List.is_empty tyl then
 120         this#on_type acc ty
 121       else if
 122         String.equal (snd id) Naming_special_names.FB.cIncorrectType
 123         && Int.equal (List.length tyl) 1
 124       then
 125         let ty = List.hd_exn tyl in
 126         this#on_type { acc with like_context = true } ty
 127       else if acc.like_context then
 128         super#on_alias acc r id tyl ty
 129       else
 130         this#invalid
 131           acc
 132           r
 133           "a type with generics, because generics are erased at runtime"
 134
 135     method! on_tvarray acc r tk =
 136       if acc.like_context then
 137         this#on_type acc tk
 138       else
 139         this#invalid acc r "an array type"
 140
 141     method! on_tdarray acc r tk tv =
 142       if acc.like_context then
 143         let acc = this#on_type acc tk in
 144         this#on_type acc tv
 145       else
 146         this#invalid acc r "an array type"
 147
 148     method! on_tvarray_or_darray acc r tk tv =
 149       if acc.like_context then
 150         let acc = this#on_type acc tk in
 151         this#on_type acc tv
 152       else
 153         this#invalid acc r "an array type"
 154
 155     method is_wildcard ty =
 156       match get_node ty with
 157       | Tapply ((_, name), _) -> String.equal name SN.Typehints.wildcard
 158       | _ -> false
 159
 160     method check_for_wildcards acc tyl s =
 161       match List.filter tyl ~f:this#is_wildcard with
 162       | [] -> acc
 163       | tyl ->
 164         this#invalid_list
 165           acc
 166           (List.map tyl ~f:(fun ty ->
 167                ( Typing_defs_core.get_reason ty,
 168                  "_ in a " ^ s ^ " (use `mixed` instead)" )))
 169
 170     method! on_ttuple acc _ tyl =
 171       let acc = List.fold_left tyl ~f:this#on_type ~init:acc in
 172       this#check_for_wildcards acc tyl "tuple"
 173
 174     method! on_tshape acc _ _ fdm =
 175       let tyl = ShapeMap.values fdm |> List.map ~f:(fun s -> s.sft_ty) in
 176       let acc = List.fold_left tyl ~init:acc ~f:this#on_type in
 177       this#check_for_wildcards acc tyl "shape"
 178
 179     method check_generic acc r name =
 180       (* No need to look at type arguments of generic var, as higher-kinded type params
 181         cannot be enforcable *)
 182       (* TODO(T70069116) implement enforcability check *)
 183       match
 184         (Env.get_reified acc.env name, Env.get_enforceable acc.env name)
 185       with
 186       | (Nast.Erased, _) ->
 187         this#invalid acc r "an erased generic type parameter"
 188       | (Nast.SoftReified, _) ->
 189         this#invalid acc r "a soft reified generic type parameter"
 190       | (Nast.Reified, false) ->
 191         this#invalid
 192           acc
 193           r
 194           "a reified type parameter that is not marked `<<__Enforceable>>`"
 195       | (Nast.Reified, true) -> acc
 196   end