hphp/hack/src/typing/typing_arrays.ml

   1 (**
   2  * Copyright (c) 2015, 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 Common
  12 open Typing_defs
  13 open Type_mapper
  14
  15 module Env = Typing_env
  16 module TUtils = Typing_utils
  17 module Reason = Typing_reason
  18
  19 (* Mapper used by update_array* functions. It traverses Tunion and
  20  * modifies the type "inside" the Tvars - so it has side effects on the input
  21  * type (the type variables inside env change)! *)
  22 class update_array_type_mapper: type_mapper_type = object
  23   inherit shallow_type_mapper
  24   inherit! tunion_type_mapper
  25   inherit! tvar_substituting_type_mapper
  26 end
  27
  28 (* Abstract types declared "as array<...>" permit array operations, but if
  29  * those operations modify the array it has to be downgraded from generic
  30  * to just an array.*)
  31 class virtual downcast_tabstract_to_array_type_mapper = object(this)
  32   method on_tabstract env r ak cstr =
  33     let ty = (r, Tabstract(ak, cstr)) in
  34     match TUtils.get_all_supertypes env ty with
  35     | _, [] -> env, ty
  36     | env, tyl ->
  37       let is_array = function
  38       | _, Tarraykind _ -> true
  39       | _ -> false in
  40       match List.filter tyl is_array with
  41       | [] ->
  42         env, ty
  43       | x::_ ->
  44         (* If the abstract type has multiple concrete supertypes
  45         which are arrays, just take the first one.
  46         TODO(jjwu): Try all of them and find one that works
  47         *)
  48         this#on_type env x
  49
  50   method virtual on_type : env -> locl ty -> result
  51 end
  52
  53 let union env tyl = match tyl with
  54   | [] -> Env.fresh_unresolved_type env Pos.none (* TODO: position *)
  55   | ty::tyl' -> List.fold_left_env env tyl' ~init:ty ~f:TUtils.union
  56
  57 let union_keys = union
  58
  59 let union_values env values =
  60   let unknown = List.find values (fun ty ->
  61     snd (snd (TUtils.fold_unresolved env ty)) = Tany) in
  62   match unknown with
  63   | Some (r, _) -> env, (r, TUtils.tany env)
  64   | None -> union env values
  65
  66 (* Apply this function to a type after lvalue array access that should update
  67  * array type (e.g from AKempty to AKmap after using it as a map). *)
  68 let update_array_type p ~is_map env ty =
  69   let mapper = object
  70     inherit update_array_type_mapper
  71     inherit! downcast_tabstract_to_array_type_mapper
  72
  73     method! on_tarraykind_akempty env _ =
  74       if is_map
  75       then
  76         let env, tk = Env.fresh_unresolved_type env p in
  77         let env, tv = Env.fresh_unresolved_type env p in
  78         env, (Reason.Rused_as_map p, Tarraykind (AKmap (tk, tv)))
  79       else
  80         let env, tv = Env.fresh_unresolved_type env p in
  81         env, (Reason.Rappend p, Tarraykind (AKvec tv))
  82
  83   end in
  84   let env, ty = mapper#on_type (fresh_env env) ty in
  85   env, ty