hphp/hack/src/typing/tast_check/callconv_check.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 module Env = Tast_env
  14 module SN = Naming_special_names
  15
  16 let check_types env (_, p, te) =
  17   let rec check_types_helper = function
  18     | Lvar _ -> ()
  19     | Array_get ((ty1, _, te1), Some _) ->
  20       let rec iter ty1 =
  21         let (_, ety1) = Env.expand_type env ty1 in
  22         match get_node ety1 with
  23         | Tany _ -> true
  24         | Tvec_or_dict _
  25         | Ttuple _
  26         | Tshape _
  27         | Tdynamic ->
  28           true
  29         | Tclass ((_, cn), _, _)
  30           when String.equal cn SN.Collections.cDict
  31                || String.equal cn SN.Collections.cKeyset
  32                || String.equal cn SN.Collections.cVec ->
  33           true
  34         | Tunion tyl -> List.for_all ~f:iter tyl
  35         | Tintersection tyl -> List.exists ~f:iter tyl
  36         | Tgeneric _
  37         | Tnewtype _
  38         | Tdependent _ ->
  39           let (_, tyl) =
  40             Env.get_concrete_supertypes ~abstract_enum:true env ety1
  41           in
  42           List.exists ~f:iter tyl
  43         | _ -> false
  44       in
  45       if iter ty1 then
  46         check_types_helper te1
  47       else
  48         let ty_str = lazy (Env.print_error_ty env ty1) in
  49         let reasons =
  50           Lazy.map ty_str ~f:(fun ty_str ->
  51               Reason.to_string ("This is " ^ ty_str) (get_reason ty1))
  52         in
  53         Typing_error_utils.add_typing_error
  54           ~env:(Env.tast_env_as_typing_env env)
  55           Typing_error.(
  56             primary @@ Primary.Inout_argument_bad_type { pos = p; reasons })
  57     (* Other invalid expressions are caught in Nast_check. *)
  58     | _ -> ()
  59   in
  60   check_types_helper te
  61
  62 let handler =
  63   object
  64     inherit Tast_visitor.handler_base
  65
  66     method! at_expr env =
  67       function
  68       | (_, _, Call { args; _ }) ->
  69         List.iter
  70           ~f:(function
  71             | (Ast_defs.Pnormal, _) -> ()
  72             | (Ast_defs.Pinout _, e) -> check_types env e)
  73           args
  74       | _ -> ()
  75   end