hphp/hack/src/typing/typing_generic.ml

   1 (**
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9  *)
  10
  11 open Core
  12 open Typing_defs
  13
  14 module Env = Typing_env
  15 module ShapeMap = Nast.ShapeMap
  16
  17
  18 (* Module checking if a type is generic, I like to use an exception for this sort
  19  * of things, the code is more readable (subjective :-), and the exception never
  20  * escapes anyway.
  21 *)
  22 module IsGeneric: sig
  23
  24   (* Give back the name and position of a generic if found *)
  25   val ty: locl ty -> string option
  26 end = struct
  27
  28   exception Found of string
  29
  30   let rec ty (_, x) = ty_ x
  31   and ty_ = function
  32     | Tabstract ((AKdependent (_, _) | AKenum _), cstr) -> ty_opt cstr
  33     | Tabstract (AKgeneric x, _) -> raise (Found x)
  34     | Tanon _ | Tany | Tmixed | Tprim _ -> ()
  35     | Tarraykind akind ->
  36       begin match akind with
  37         | AKany -> ()
  38         | AKempty -> ()
  39         | AKvec tv -> ty tv
  40         | AKmap (tk, tv) -> ty tk; ty tv
  41         | AKshape fdm ->
  42             ShapeMap.iter (fun _ (tk, tv) -> ty tk; ty tv) fdm
  43         | AKtuple fields ->
  44             IMap.iter (fun _ tv -> ty tv) fields
  45       end
  46     | Tvar _ -> assert false (* Expansion got rid of Tvars ... *)
  47     | Toption x -> ty x
  48     | Tfun fty ->
  49         List.iter (List.map fty.ft_params snd) ty;
  50         ty fty.ft_ret;
  51         (match fty.ft_arity with
  52           | Fvariadic (_min, (_name, var_ty)) -> ty var_ty
  53           | _ -> ())
  54     | Tabstract (AKnewtype (_, tyl), x) ->
  55         List.iter tyl ty; ty_opt x
  56     | Ttuple tyl -> List.iter tyl ty
  57     | Tclass (_, tyl)
  58     | Tunresolved tyl -> List.iter tyl ty
  59     | Tobject -> ()
  60     | Tshape (_, fdm) ->
  61         ShapeMap.iter (fun _ v -> ty v) fdm
  62
  63   and ty_opt = function None -> () | Some x -> ty x
  64
  65   let ty x = try ty x; None with Found x -> Some x
  66
  67 end
  68
  69 (* Function making sure that a type can be generalized, in our case it just
  70  * means the type should be monomorphic
  71 *)
  72 let no_generic p local_var_id env =
  73   let env, ty = Env.get_local env local_var_id in
  74   let ty = Typing_expand.fully_expand env ty in
  75   match IsGeneric.ty ty with
  76   | None -> env
  77   | Some x ->
  78       Errors.generic_static p x;
  79       env