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 Core_kernel
  11 open Tast
  12 open Typing_defs
  13
  14 module Env = Tast_env
  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 ety1 with
  23         | _, Tany -> true
  24         | _, (Tarraykind _ | Ttuple _ | Tshape _) -> true
  25         | _, Tclass ((_, cn), _, _)
  26           when cn = SN.Collections.cDict
  27             || cn = SN.Collections.cKeyset
  28             || cn = SN.Collections.cVec -> true
  29         | _, Tunion tyl -> List.for_all ~f:iter tyl
  30         | _, Tabstract _ ->
  31           let _, tyl = Env.get_concrete_supertypes env ety1 in
  32           List.exists ~f:iter tyl
  33         | _ -> false in
  34       if iter ty1
  35       then check_types_helper te1
  36       else
  37         let ty_str = Env.print_error_ty env ty1 in
  38         let msgl = Reason.to_string ("This is " ^ ty_str) (fst ty1) in
  39         Errors.inout_argument_bad_type p msgl
  40     (* Other invalid expressions are caught in NastCheck. *)
  41     | _ -> () in
  42   check_types_helper te
  43
  44 let handler = object
  45   inherit Tast_visitor.handler_base
  46
  47   method! at_expr env = function
  48     | _, Callconv (_, te) -> check_types env te
  49     | _ -> ()
  50 end