hphp/hack/src/typing/typing_enum.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 (*****************************************************************************)
  12 (* Module used to enforce that Enum subclasses are used reasonably.
  13  * Exports the Enum type as the type of all constants, checks that constants
  14  * have the proper type, and restricts what types can be used for enums.
  15  *)
  16 (*****************************************************************************)
  17 open Core
  18 open Nast
  19 open Typing_defs
  20 open Utils
  21
  22 module SN = Naming_special_names
  23 module Phase = Typing_phase
  24
  25 let member_type env member_ce =
  26   let default_result = member_ce.ce_type in
  27   if not member_ce.ce_is_xhp_attr then default_result
  28   else match default_result with
  29     | _, Tapply (enum_id, _)->
  30       (* XHP attribute type transform is necessary to account for
  31        * non-first class Enums:
  32
  33        * attribute MyEnum x; // declaration: MyEnum
  34        * $this->:x;          // usage: MyEnumType
  35        *)
  36       let maybe_enum = Typing_env.get_class env (snd enum_id) in
  37       (match maybe_enum with
  38         | None -> default_result
  39         | Some tc ->
  40           (match Decl_enum.is_enum (tc.tc_pos, tc.tc_name)
  41               tc.tc_enum_type tc.tc_ancestors with
  42                 | None -> default_result
  43                 | Some (_base, (_, enum_ty), _constraint) ->
  44                   let ty = (fst default_result), enum_ty in
  45                   ty
  46           ))
  47     | _ -> default_result
  48
  49 (* Check that a type is something that can be used as an array index
  50  * (int or string), blowing through typedefs to do it. Takes a function
  51  * to call to report the error if it isn't. *)
  52 let check_valid_array_key_type f_fail ~allow_any:allow_any env p t =
  53   let ety_env = Phase.env_with_self env in
  54   let env, (r, t'), trail =
  55     Typing_tdef.force_expand_typedef ~ety_env env t in
  56   (match t' with
  57     | Tprim (Tint | Tstring) -> ()
  58     (* Enums have to be valid array keys *)
  59     | Tabstract (AKenum _, _) -> ()
  60     | Tany when allow_any -> ()
  61     | Tany | Tmixed | Tarraykind _ | Tprim _ | Toption _
  62       | Tvar _ | Tabstract (_, _) | Tclass (_, _) | Ttuple _ | Tanon (_, _)
  63       | Tfun _ | Tunresolved _ | Tobject | Tshape _ ->
  64         f_fail p (Reason.to_pos r) (Typing_print.error t') trail);
  65   env
  66
  67 let enum_check_const ty_exp env (_, (p, _), _) t =
  68   (* Constants need to be subtypes of the enum type *)
  69   let env = Typing_ops.sub_type p Reason.URenum env ty_exp t in
  70   (* Make sure the underlying type of the constant is an int
  71    * or a string. This matters because we need to only allow
  72    * int and string constants (since only they can be array
  73    * indexes). *)
  74   (* Need to allow Tany, since we might not have the types *)
  75   check_valid_array_key_type
  76     Errors.enum_constant_type_bad
  77     ~allow_any:true env p t
  78
  79 (* If a class is a subclass of Enum<T>, check that the types of all of
  80  * the constants are compatible with T.
  81  * Also make sure that T is either int, string, or mixed (or an
  82  * abstract type that is one of those under the hood), that all
  83  * constants are ints or strings when T is mixed, and that any type
  84  * hints are compatible with the type. *)
  85 let enum_class_check env tc consts const_types =
  86   let enum_info_opt =
  87     Decl_enum.is_enum (tc.tc_pos, tc.tc_name) tc.tc_enum_type
  88     tc.tc_ancestors in
  89   match enum_info_opt with
  90     | Some (ty_exp, _, ty_constraint) ->
  91         let ety_env = Phase.env_with_self env in
  92         let env, ty_exp = Phase.localize ~ety_env env ty_exp in
  93         let env, (r, ty_exp'), trail =
  94           Typing_tdef.force_expand_typedef ~ety_env env ty_exp in
  95         (match ty_exp' with
  96           (* We disallow first-class enums from being non-exact types, because
  97            * a switch on such an enum can lead to very unexpected results,
  98            * since switch uses == equality. *)
  99           | Tmixed | Tprim Tarraykey when tc.tc_enum_type <> None ->
 100               Errors.enum_type_bad (Reason.to_pos r)
 101                 (Typing_print.error ty_exp') trail
 102           (* We disallow typedefs that point to mixed *)
 103           | Tmixed when snd ty_exp <> Tmixed ->
 104               Errors.enum_type_typedef_mixed (Reason.to_pos r)
 105           | Tmixed -> ()
 106           | Tprim Tint | Tprim Tstring | Tprim Tarraykey -> ()
 107           (* Allow enums in terms of other enums *)
 108           | Tabstract (AKenum _, _) -> ()
 109           (* Don't tell anyone, but we allow type params too, since there are
 110            * Enum subclasses that need to do that *)
 111           | Tabstract (AKgeneric _, _) -> ()
 112           | Tany | Tarraykind _ | Tprim _ | Toption _ | Tvar _
 113             | Tabstract (_, _) | Tclass (_, _) | Ttuple _ | Tanon (_, _)
 114             | Tunresolved _ | Tobject | Tfun _ | Tshape _ ->
 115               Errors.enum_type_bad (Reason.to_pos r)
 116                 (Typing_print.error ty_exp') trail);
 117
 118         (* Make sure that if a constraint was given that the base type is
 119          * actually a subtype of it. *)
 120         let env = (match ty_constraint with
 121           | Some ty ->
 122              let env, ty = Phase.localize ~ety_env env ty in
 123              Typing_ops.sub_type tc.tc_pos Reason.URenum_cstr env ty ty_exp
 124           | None -> env) in
 125
 126         List.fold2_exn ~f:(enum_check_const ty_exp) ~init:env consts const_types
 127
 128     | None -> env
 129
 130 let get_constant tc (seen, has_default) = function
 131   | Default _ -> (seen, true)
 132   | Case ((pos, Class_const (CI (_, cls), (_, const))), _) ->
 133     if cls <> tc.tc_name then
 134       (Errors.enum_switch_wrong_class pos (strip_ns tc.tc_name) (strip_ns cls);
 135        (seen, has_default))
 136     else
 137       (match SMap.get const seen with
 138         | None -> (SMap.add const pos seen, has_default)
 139         | Some old_pos ->
 140           Errors.enum_switch_redundant const old_pos pos;
 141           (seen, has_default))
 142   | Case ((pos, _), _) ->
 143     Errors.enum_switch_not_const pos;
 144     (seen, has_default)
 145
 146 let check_enum_exhaustiveness pos tc caselist =
 147   let (seen, has_default) =
 148     List.fold_left ~f:(get_constant tc) ~init:(SMap.empty, false) caselist in
 149   let consts = SMap.remove SN.Members.mClass tc.tc_consts in
 150   let all_cases_handled = SMap.cardinal seen = SMap.cardinal consts in
 151   match (all_cases_handled, has_default) with
 152     | false, false ->
 153       let const_list = SMap.keys consts in
 154       let unhandled =
 155         List.filter const_list (function k -> not (SMap.mem k seen)) in
 156       Errors.enum_switch_nonexhaustive pos unhandled tc.tc_pos
 157     | true, true -> Errors.enum_switch_redundant_default pos tc.tc_pos
 158     | _ -> ()