hphp/hack/src/server/findRefsService.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 Option.Monad_infix
  13 open Reordered_argument_collections
  14 open Typing_defs
  15
  16 type member = Ai.ServerFindRefs.member =
  17   | Method of string
  18   | Property of string
  19   | Class_const of string
  20   | Typeconst of string
  21
  22 type action = Ai.ServerFindRefs.action =
  23   | Class of string
  24   | Member of string * member
  25   | Function of string
  26   | GConst of string
  27
  28 (* The class containing the member can be specified in two ways:
  29  * - Class_set - as an explicit, pre-computed set of names, which are then
  30  *   compared using string comparison
  31  * - Subclasses_of - the class's name, in which comparison will use the
  32  *   subtyping relation
  33  *)
  34 type member_class =
  35   | Class_set of SSet.t
  36   | Subclasses_of of string
  37
  38 type action_internal  =
  39   | IClass of string
  40   | IMember of member_class * member
  41   | IFunction of string
  42   | IGConst of string
  43
  44 type result = (string * Pos.absolute) list
  45 type ide_result = (string * Pos.absolute list) option
  46
  47 let process_fun_id results_acc target_fun id =
  48   if target_fun = (snd id)
  49   then results_acc := Pos.Map.add (fst id) (snd id) !results_acc
  50
  51 let check_if_extends_class tcopt target_class_name class_name =
  52   let class_ = Typing_lazy_heap.get_class tcopt class_name in
  53   match class_ with
  54   | Some { Typing_defs.tc_ancestors = imps; _ }
  55       when SMap.mem imps target_class_name -> true
  56   | _ -> false
  57
  58 let is_target_class tcopt target_classes class_name =
  59   match target_classes with
  60   | Class_set s -> SSet.mem s class_name
  61   | Subclasses_of s ->
  62     s = class_name || check_if_extends_class tcopt s class_name
  63
  64 let process_member_id tcopt results_acc target_classes target_member
  65     class_ ~targs:_ id _ _ ~is_method ~is_const =
  66   let member_name = snd id in
  67   let is_target = match target_member with
  68     | Method target_name  -> is_method && (member_name = target_name)
  69     | Property target_name ->
  70       (not is_method) && (not is_const) &&
  71         ((String_utils.lstrip member_name "$") = target_name)
  72     | Class_const target_name -> is_const && (member_name = target_name)
  73     | Typeconst _ -> false
  74   in
  75   if not is_target then () else
  76   let class_name = class_.Typing_defs.tc_name in
  77   if is_target_class tcopt target_classes class_name then
  78     results_acc :=
  79       Pos.Map.add (fst id) (class_name ^ "::" ^ (snd id)) !results_acc
  80
  81 let process_constructor tcopt results_acc
  82     target_classes target_member class_ ~targs _ p =
  83   process_member_id
  84     tcopt results_acc target_classes target_member class_ ~targs
  85     (p, "__construct") () () ~is_method:true ~is_const:false
  86
  87 let process_class_id results_acc target_classes cid mid_option =
  88    if (SSet.mem target_classes (snd cid))
  89    then begin
  90      let class_name = match mid_option with
  91      | None -> snd cid
  92      | Some n -> (snd cid)^"::"^(snd n) in
  93      results_acc := Pos.Map.add (fst cid) class_name !results_acc
  94    end
  95
  96 let process_taccess tcopt results_acc target_classes target_typeconst
  97     class_ typeconst p =
  98   let class_name = class_.tc_name in
  99   let tconst_name = (snd typeconst.ttc_name) in
 100   if (is_target_class tcopt target_classes class_name) &&
 101     (target_typeconst = tconst_name) then
 102   results_acc :=
 103     Pos.Map.add p (class_name ^ "::" ^ tconst_name) !results_acc
 104
 105 let process_gconst_id results_acc target_gconst id =
 106   if target_gconst = (snd id)
 107   then results_acc := Pos.Map.add (fst id) (snd id) !results_acc
 108
 109 let attach_hooks tcopt results_acc = function
 110   | IMember (classes, ((Method _ | Property _ | Class_const _) as member)) ->
 111     let process_member_id =
 112       process_member_id tcopt results_acc classes member in
 113     Typing_hooks.attach_cmethod_hook process_member_id;
 114     Typing_hooks.attach_smethod_hook process_member_id;
 115     Typing_hooks.attach_constructor_hook
 116       (process_constructor tcopt results_acc classes member);
 117   | IMember (classes, Typeconst t) ->
 118     Typing_hooks.attach_taccess_hook
 119       (process_taccess tcopt results_acc classes t)
 120   | IFunction fun_name ->
 121     Typing_hooks.attach_fun_id_hook (process_fun_id results_acc fun_name)
 122   | IClass c ->
 123     let classes = SSet.singleton c in
 124     Decl_hooks.attach_class_id_hook (process_class_id results_acc classes)
 125   | IGConst cst_name ->
 126     Typing_hooks.attach_global_const_hook
 127       (process_gconst_id results_acc cst_name)
 128
 129 let detach_hooks () =
 130   Decl_hooks.remove_all_hooks ();
 131   Typing_hooks.remove_all_hooks ()
 132
 133 let add_if_extends_class tcopt target_class_name class_name acc =
 134   if check_if_extends_class tcopt target_class_name class_name
 135   then SSet.add acc class_name else acc
 136
 137 let find_child_classes tcopt target_class_name files_info files =
 138   SharedMem.invalidate_caches();
 139   Relative_path.Set.fold files ~init:SSet.empty ~f:begin fun fn acc ->
 140     (try
 141       let { FileInfo.classes; _ } =
 142         Relative_path.Map.find_unsafe files_info fn in
 143       List.fold_left classes ~init:acc ~f:begin fun acc cid ->
 144         add_if_extends_class tcopt target_class_name (snd cid) acc
 145       end
 146     with Not_found ->
 147       acc)
 148   end
 149
 150 let get_child_classes_files class_name =
 151   match Naming_heap.TypeIdHeap.get class_name with
 152   | Some (_, `Class) ->
 153     (* Find the files that contain classes that extend class_ *)
 154     let cid_hash =
 155       Typing_deps.Dep.make (Typing_deps.Dep.Class class_name) in
 156     let extend_deps =
 157       Decl_compare.get_extend_deps cid_hash
 158         (Typing_deps.DepSet.singleton cid_hash)
 159     in
 160     Typing_deps.get_files extend_deps
 161   | _ ->
 162     Relative_path.Set.empty
 163
 164 let get_deps_set classes =
 165   let get_filename class_name =
 166     Naming_heap.TypeIdHeap.get class_name >>= fun (pos, _) ->
 167     Some (FileInfo.get_pos_filename pos)
 168   in
 169   SSet.fold classes ~f:begin fun class_name acc ->
 170     match get_filename class_name with
 171     | None -> acc
 172     | Some fn ->
 173       let dep = Typing_deps.Dep.Class class_name in
 174       let bazooka = Typing_deps.get_bazooka dep in
 175       let files = Typing_deps.get_files bazooka in
 176       let files = Relative_path.Set.add files fn in
 177       Relative_path.Set.union files acc
 178   end ~init:Relative_path.Set.empty
 179
 180 let get_deps_set_function f_name =
 181   match Naming_heap.FunPosHeap.get f_name with
 182   | Some pos ->
 183     let fn = FileInfo.get_pos_filename pos in
 184     let dep = Typing_deps.Dep.Fun f_name in
 185     let bazooka = Typing_deps.get_bazooka dep in
 186     let files = Typing_deps.get_files bazooka in
 187     Relative_path.Set.add files fn
 188   | None ->
 189     Relative_path.Set.empty
 190
 191 let get_deps_set_gconst cst_name =
 192   match Naming_heap.ConstPosHeap.get cst_name with
 193   | Some pos ->
 194     let fn = FileInfo.get_pos_filename pos in
 195     let dep = Typing_deps.Dep.GConst cst_name in
 196     let bazooka = Typing_deps.get_bazooka dep in
 197     let files = Typing_deps.get_files bazooka in
 198     Relative_path.Set.add files fn
 199   | None ->
 200     Relative_path.Set.empty
 201
 202 let find_refs tcopt target acc fileinfo_l =
 203   let results_acc = ref Pos.Map.empty in
 204   attach_hooks tcopt results_acc target;
 205   let tcopt = TypecheckerOptions.make_permissive tcopt in
 206   ServerIdeUtils.recheck tcopt fileinfo_l;
 207   detach_hooks ();
 208   Pos.Map.fold begin fun p str acc ->
 209     (str, p) :: acc
 210   end !results_acc acc
 211
 212 let parallel_find_refs workers fileinfo_l target tcopt =
 213   MultiWorker.call
 214     workers
 215     ~job:(find_refs tcopt target)
 216     ~neutral:([])
 217     ~merge:(List.rev_append)
 218     ~next:(MultiWorker.next workers fileinfo_l)
 219
 220 let get_definitions tcopt = function
 221   | IMember (Class_set classes, Method method_name) ->
 222     SSet.fold classes ~init:[] ~f:begin fun class_name acc ->
 223       match Typing_lazy_heap.get_class tcopt class_name with
 224       | Some class_ ->
 225         let add_meth meths acc = match SMap.get meths method_name with
 226           | Some meth when meth.ce_origin = class_.tc_name ->
 227             let pos = Reason.to_pos (fst @@ Lazy.force meth.ce_type) in
 228             (method_name, pos) :: acc
 229           | _ -> acc
 230         in
 231         let acc = add_meth class_.tc_methods acc in
 232         let acc = add_meth class_.tc_smethods acc in
 233         acc
 234       | None -> acc
 235     end
 236   | IClass class_name ->
 237     Option.value ~default:[] begin Naming_heap.TypeIdHeap.get class_name >>=
 238     function (_, `Class) -> Typing_lazy_heap.get_class tcopt class_name >>=
 239       fun class_ -> Some([(class_name, class_.tc_pos)])
 240     | (_, `Typedef) -> Typing_lazy_heap.get_typedef tcopt class_name >>=
 241       fun type_ -> Some([class_name, type_.td_pos])
 242     end
 243   | IFunction fun_name ->
 244     begin match Typing_lazy_heap.get_fun tcopt fun_name with
 245       | Some fun_ -> [fun_name, fun_.ft_pos]
 246       | None -> []
 247     end
 248   | IGConst _
 249   | IMember (Subclasses_of _, _)
 250   | IMember (_, (Property _ | Class_const _ | Typeconst _)) ->
 251     (* this code path is used only in ServerRefactor, we can update it at some
 252        later time *)
 253     []
 254
 255 let find_references tcopt workers target include_defs
 256       files_info files =
 257   let fileinfo_l = Relative_path.Set.fold files ~f:begin fun fn acc ->
 258     match Relative_path.Map.get files_info fn with
 259     | Some fi -> (fn, fi) :: acc
 260     | None -> acc
 261   end ~init:[] in
 262   let results =
 263     if List.length fileinfo_l < 10 then
 264       find_refs tcopt target [] fileinfo_l
 265     else
 266       parallel_find_refs workers fileinfo_l target tcopt
 267     in
 268   if include_defs then
 269     let defs = get_definitions tcopt target in
 270     List.rev_append defs results
 271   else
 272     results
 273
 274 let get_dependent_files_function _workers f_name =
 275   (* This is performant enough to not need to go parallel for now *)
 276   get_deps_set_function f_name
 277
 278 let get_dependent_files_gconst _workers cst_name =
 279   (* This is performant enough to not need to go parallel for now *)
 280   get_deps_set_gconst cst_name
 281
 282 let get_dependent_files _workers input_set =
 283   (* This is performant enough to not need to go parallel for now *)
 284   get_deps_set input_set
 285
 286 let result_to_ide_message x =
 287   let open Ide_message in
 288   Find_references_response (
 289     Option.map x ~f:begin fun (symbol_name, references) ->
 290       let references =
 291         List.map references ~f:Ide_api_types.pos_to_file_range in
 292       {symbol_name; references}
 293     end
 294   )