hphp/hack/src/typing/tast_check/switch_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 open Utils
  14
  15 module Env = Tast_env
  16 module Cls = Typing_classes_heap
  17 module MakeType = Typing_make_type
  18
  19 let get_constant tc (seen, has_default) = function
  20   | Default _ -> (seen, true)
  21   | Case (((pos, _), Class_const ((_, CI (_, cls)), (_, const))), _) ->
  22     if cls <> Cls.name tc then
  23       (Errors.enum_switch_wrong_class pos (strip_ns (Cls.name tc)) (strip_ns cls);
  24        (seen, has_default))
  25     else
  26       (match SMap.get const seen with
  27         | None -> (SMap.add const pos seen, has_default)
  28         | Some old_pos ->
  29           Errors.enum_switch_redundant const old_pos pos;
  30           (seen, has_default))
  31   | Case (((pos, _), _), _) ->
  32     Errors.enum_switch_not_const pos;
  33     (seen, has_default)
  34
  35 let check_enum_exhaustiveness pos tc caselist coming_from_unresolved =
  36   (* If this check comes from an enum inside a Tunresolved, then
  37      don't punish for having an extra default case *)
  38   let (seen, has_default) =
  39     List.fold_left ~f:(get_constant tc) ~init:(SMap.empty, false) caselist in
  40   let unhandled =
  41     Cls.consts tc
  42     |> Sequence.map ~f:fst
  43     |> Sequence.filter ~f:((<>) SN.Members.mClass)
  44     |> Sequence.filter ~f:(fun id -> not (SMap.mem id seen))
  45     |> Sequence.to_list_rev
  46   in
  47   let all_cases_handled = List.is_empty unhandled in
  48   match (all_cases_handled, has_default, coming_from_unresolved) with
  49     | false, false, _ ->
  50       Errors.enum_switch_nonexhaustive pos unhandled (Cls.pos tc)
  51     | true, true, false -> Errors.enum_switch_redundant_default pos (Cls.pos tc)
  52     | _ -> ()
  53
  54 let rec check_exhaustiveness_ env pos ty caselist enum_coming_from_unresolved =
  55   (* Right now we only do exhaustiveness checking for enums. *)
  56   (* This function has a built in hack where if Tunresolved has an enum
  57      inside then it tells the enum exhaustiveness checker to
  58      not punish for extra default *)
  59   let env, (_, ty) = Env.expand_type env ty in
  60   match ty with
  61     | Tunresolved tyl ->
  62       let new_enum = enum_coming_from_unresolved ||
  63         (List.length tyl> 1 && List.exists tyl ~f:begin fun cur_ty ->
  64         let _, (_, cur_ty) = Env.expand_type env cur_ty in
  65         match cur_ty with
  66           | Tabstract (AKenum _, _) -> true
  67           | _ -> false
  68       end) in
  69       List.fold_left tyl ~init:env ~f:begin fun env ty ->
  70         check_exhaustiveness_ env pos ty caselist new_enum
  71       end
  72     | Tabstract (AKenum id, _) ->
  73       let dep = Typing_deps.Dep.AllMembers id in
  74       let decl_env = Env.get_decl_env env in
  75       Option.iter decl_env.Decl_env.droot
  76         (fun root -> Typing_deps.add_idep root dep);
  77       let tc = unsafe_opt @@ Env.get_enum env id in
  78       check_enum_exhaustiveness pos tc
  79         caselist enum_coming_from_unresolved;
  80       env
  81     | Terr | Tany | Tnonnull | Tarraykind _ | Tclass _ | Toption _
  82       | Tprim _ | Tvar _ | Tfun _ | Tabstract (_, _) | Ttuple _ | Tanon (_, _)
  83       | Tobject | Tshape _ | Tdynamic -> env
  84
  85 let check_exhaustiveness env pos ty caselist =
  86   ignore (check_exhaustiveness_ env pos ty caselist false)
  87
  88 let ensure_valid_switch_case_value_types env scrutinee_ty casel errorf =
  89   let is_subtype ty_sub ty_super = snd (Env.subtype env ty_sub ty_super) in
  90   let ty_num = (Reason.Rnone, Tprim Nast.Tnum) in
  91   let ty_arraykey = (Reason.Rnone, Tprim Nast.Tarraykey) in
  92   let ty_mixed = MakeType.mixed Reason.Rnone in
  93   let ty_traversable = MakeType.traversable Typing_reason.Rnone ty_mixed in
  94   let compatible_types ty1 ty2 =
  95     (is_subtype ty1 ty_num && is_subtype ty2 ty_num) ||
  96     (is_subtype ty1 ty_arraykey && is_subtype ty2 ty_arraykey) ||
  97     (is_subtype ty1 ty_traversable && is_subtype ty2 ty_traversable &&
  98       (is_subtype ty1 ty2 || is_subtype ty2 ty1)) ||
  99     (is_subtype ty1 ty2 && is_subtype ty2 ty1) in
 100   let ensure_valid_switch_case_value_type = function
 101     | Default _ -> ()
 102     | Case (((case_value_p, case_value_ty), _), _) ->
 103       if not (compatible_types case_value_ty scrutinee_ty) then
 104         errorf (Env.get_tcopt env) case_value_p
 105           (Env.print_ty env case_value_ty) (Env.print_ty env scrutinee_ty) in
 106   List.iter casel ensure_valid_switch_case_value_type
 107
 108 let handler errorf = object
 109   inherit Tast_visitor.handler_base
 110
 111   method! at_stmt env x =
 112     match snd x with
 113     | Switch (((scrutinee_pos, scrutinee_ty), _), casel) ->
 114       check_exhaustiveness env scrutinee_pos scrutinee_ty casel;
 115       ensure_valid_switch_case_value_types env scrutinee_ty casel errorf
 116     | _ -> ()
 117 end