hphp/hack/src/typing/tast_check/ppl_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 (* Typing code concerned the <<__PPL>> attribute. *)
  11 open Core_kernel
  12 open Typing_defs
  13 open Tast
  14
  15 module Cls = Typing_classes_heap
  16 module Env = Tast_env
  17 module TLazyHeap = Typing_lazy_heap
  18
  19 let has_ppl_attribute c =
  20   List.exists
  21     c.c_user_attributes
  22     (fun { ua_name; _ } -> SN.UserAttributes.uaProbabilisticModel = snd ua_name)
  23
  24 (* If an object's type is wrapped in a Tabstract, recurse until we've hit the base *)
  25 let rec base_type ty =
  26   match snd ty with
  27   | Tabstract(_, Some ty) -> base_type ty
  28   | _ -> ty
  29
  30 (**
  31  * Given a class, check the class's direct ancestors to verify that if
  32  * one member is annotated with the <<__PPL>> attribute, then all of them are.
  33  *)
  34 let check_ppl_class c =
  35   let is_ppl = has_ppl_attribute c in
  36   let child_class_string = Ast_defs.string_of_class_kind c.c_kind in
  37   let c_pos = fst c.c_name in
  38   let error = Errors.extend_ppl c_pos child_class_string is_ppl in
  39   let check verb parent_class_string =
  40     function
  41     | _, Nast.Happly ((_, name), _) ->
  42       begin match TLazyHeap.get_class name with
  43         | Some parent_type ->
  44           if Cls.ppl parent_type <> is_ppl
  45           then error (Cls.pos parent_type) parent_class_string (Cls.name parent_type) verb
  46           else ()
  47         | None -> ()
  48       end
  49     | _ -> () in
  50   List.iter (c.c_extends) (check "extend" "class");
  51   List.iter (c.c_implements) (check "implement" "interface");
  52   List.iter (c.c_uses) (check "use" "trait");
  53   List.iter (c.c_req_extends) (check "require" "class");
  54   List.iter (c.c_req_implements) (check "require" "interface")
  55
  56 (**
  57  * When we call a method on an object, if the object is a <<__PPL>> object,
  58  * then we can only call it via using the $this->method(...) syntax.
  59  *
  60  * This limits the ability to call it in a way that we are unable to rewrite.
  61  *)
  62 let check_ppl_obj_get env ((p, ty), e) =
  63   let check_type ty =
  64     match snd (base_type ty) with
  65     | Tclass ((_, name), _, _) ->
  66       begin
  67         match TLazyHeap.get_class name with
  68         | Some cls when Cls.ppl cls ->
  69           if not @@ Env.get_inside_ppl_class env
  70           then Errors.invalid_ppl_call p "from a different class";
  71           if Env.get_inside_constructor env
  72           then Errors.invalid_ppl_call p "from inside a <<__PPL>> class constructor";
  73           if not (phys_equal e This)
  74           then Errors.invalid_ppl_call p
  75             "inside a <<__PPL>> class unless using $this-> or $this:: syntax";
  76           ()
  77         | _ -> ()
  78       end
  79     | _ -> () in
  80   let _, type_list = Env.get_concrete_supertypes env ty in
  81   List.iter type_list check_type
  82
  83 (**
  84  * If we are calling a parent method from within a ppl class, we cannot be in
  85  * the constructor of the child class.
  86  *
  87  * We will have already considered parent::__construct.
  88  *)
  89 let check_ppl_parent_method env p =
  90   if Env.get_inside_ppl_class env && Env.get_inside_constructor env
  91   then Errors.invalid_ppl_static_call p "inside a <<__PPL>> class constructor"
  92
  93 (**
  94  * When we call a static method on a class, do not allow ClassName::method
  95  * because we are unable to detect whether the class being referred to
  96  * is a <<__PPL>> annotated class during codegen.
  97  *)
  98 let check_ppl_class_const env p e =
  99   match e with
 100   | CIself
 101   | CIparent
 102   | CIstatic ->
 103     if Env.get_inside_ppl_class env && Env.get_inside_constructor env
 104     then Errors.invalid_ppl_static_call p "inside a <<__PPL>> class constructor"
 105     else ()
 106   | CI (_, name) ->
 107     begin
 108       match TLazyHeap.get_class name with
 109       | Some cls when Cls.ppl cls ->
 110         Errors.invalid_ppl_static_call p "by classname. Use self::, static::, or parent::"
 111       | _ -> ()
 112     end
 113   | CIexpr e -> check_ppl_obj_get env e
 114
 115 let check_ppl_meth_pointers p classname special_name =
 116   match TLazyHeap.get_class classname with
 117   | Some cls when Cls.ppl cls -> Errors.ppl_meth_pointer p special_name
 118   | _ -> ()
 119
 120 let check_ppl_inst_meth env ((p, ty), _) =
 121   let check_type ty =
 122     match snd (base_type ty) with
 123     | Tclass ((_, name), _, _) ->
 124       begin
 125         match TLazyHeap.get_class name with
 126         | Some cls when Cls.ppl cls -> Errors.ppl_meth_pointer p "inst_meth"
 127         | _ -> ()
 128       end
 129     | _ -> () in
 130   let _, type_list = Env.get_concrete_supertypes env ty in
 131   List.iter type_list check_type
 132
 133 let on_call_expr env ((p, _), x) =
 134   match x with
 135   | Obj_get (e, (_, _), _) -> check_ppl_obj_get env e
 136   | Class_const ((_, CIparent), (_, construct)) when construct = SN.Members.__construct -> ()
 137   | Class_const ((_, CIparent), _) -> check_ppl_parent_method env p
 138   | Class_const ((_, e), _) -> check_ppl_class_const env p e
 139   | _ -> ()
 140
 141 let handler = object
 142   inherit Tast_visitor.handler_base
 143
 144   method! at_expr env ((p, _), x) =
 145     match x with
 146     | Call (_, e, _, _, _) -> on_call_expr env e
 147     (* class_meth *)
 148     | Smethod_id ((_, classname), _) -> check_ppl_meth_pointers p classname "class_meth"
 149     (* meth_caller *)
 150     | Method_caller ((_, classname), _) -> check_ppl_meth_pointers p classname "meth_caller"
 151     (* inst_meth *)
 152     | Method_id (instance, _) -> check_ppl_inst_meth env instance
 153     | _ -> ()
 154
 155   method! at_class_ _env c = check_ppl_class c
 156 end