[display] add display/findReferences

src/compiler/displayOutput.ml

@@ -612,7 +612,7 @@ let process_global_display_mode com tctx = match com.display.dms_kind with
 		(* Option.may (fun cs -> CompilationServer.cache_context cs com) (CompilationServer.get()); *)
 		raise_diagnostics (Diagnostics.Printer.print_diagnostics dctx tctx global)
 	| DMStatistics ->
-		let stats = Statistics.collect_statistics tctx in
+		let stats = Statistics.collect_statistics tctx None in
 		raise_statistics (Statistics.Printer.print_statistics stats)
 	| DMModuleSymbols (Some "") -> ()
 	| DMModuleSymbols filter ->

src/context/compilationServer.ml

@@ -102,6 +102,10 @@ let iter_modules cs com f =
 	let sign = Define.get_signature com.defines in
 	Hashtbl.iter (fun (_,sign') m -> if sign = sign' then f m) cs.cache.c_modules
 
+let is_cached_module cs com path =
+	let sign = Define.get_signature com.defines in
+	Hashtbl.mem cs.cache.c_modules (path,sign)
+
 (* files *)
 
 let find_file cs key =

src/context/display/displayEmitter.ml

@@ -82,7 +82,15 @@ let display_variable ctx v p = match ctx.com.display.dms_kind with
 
 let display_field ctx origin scope cf p = match ctx.com.display.dms_kind with
 	| DMDefinition -> raise_position [cf.cf_name_pos]
-	| DMUsage _ -> reference_position := (cf.cf_name,cf.cf_name_pos,KClassField)
+	| DMUsage _ ->
+		let name,kind = match cf.cf_name,origin with
+			| "new",(Self (TClassDecl c) | Parent(TClassDecl c)) ->
+				(* For constructors, we care about the class name so we don't end up looking for "new". *)
+				snd c.cl_path,KConstructor
+			| _ ->
+				cf.cf_name,KClassField
+		in
+		reference_position := (name,cf.cf_name_pos,kind)
 	| DMHover ->
 		let cf = if Meta.has Meta.Impl cf.cf_meta then
 			prepare_using_field cf

src/context/display/displayJson.ml

@@ -234,6 +234,11 @@ let handler =
 			hctx.display#set_display_file false true false;
 			hctx.display#enable_display DMDefinition;
 		);
+		"display/findReferences", (fun hctx ->
+			Common.define hctx.com Define.NoCOpt;
+			hctx.display#set_display_file false true false;
+			hctx.display#enable_display (DMUsage false);
+		);
 		"display/hover", (fun hctx ->
 			Common.define hctx.com Define.NoCOpt;
 			hctx.display#set_display_file false true false;

src/context/display/findReferences.ml

@@ -151,11 +151,12 @@ let find_possible_references tctx cs =
 		DisplayToplevel.read_class_paths tctx.com ["display";"references"];
 	end;
 	let files = CompilationServer.get_file_list cs tctx.com in
-	let _ = List.iter (fun (file,cfile) ->
-		try
+	let t = Timer.timer ["display";"references";"candidates"] in
+	List.iter (fun (file,cfile) ->
+		let module_name = CompilationServer.get_module_name_of_cfile file cfile in
+		if not (CompilationServer.is_cached_module cs tctx.com (cfile.c_package,module_name)) then try
 			find_possible_references kind name (cfile.c_package,cfile.c_decls);
 		with Exit ->
-			let module_name = CompilationServer.get_module_name_of_cfile file cfile in
 			begin try
 				ignore(tctx.g.do_load_module tctx (cfile.c_package,module_name) null_pos);
 				(* We have to flush immediately so we catch exceptions from weird modules *)
@@ -163,17 +164,21 @@ let find_possible_references tctx cs =
 			with _ ->
 				()
 			end
-	) files in
+	) files;
+	t();
 	()
 
 let find_references tctx com with_definition =
 	let name,pos,kind = !Display.reference_position in
-	let symbols,relations = Statistics.collect_statistics tctx in
+	let t = Timer.timer ["display";"references";"collect"] in
+	let symbols,relations = Statistics.collect_statistics tctx (Some pos) in
+	t();
 	let rec loop acc relations = match relations with
 		| (Statistics.Referenced,p) :: relations -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 	in
+	let t = Timer.timer ["display";"references";"filter"] in
 	let usages = Hashtbl.fold (fun p sym acc ->
 		if p = pos then begin
 			let acc = if with_definition then p :: acc else acc in
@@ -186,5 +191,6 @@ let find_references tctx com with_definition =
 		let c = compare p1.pfile p2.pfile in
 		if c <> 0 then c else compare p1.pmin p2.pmin
 	) usages in
+	t();
 	Display.reference_position := ("",null_pos,KVar);
 	DisplayException.raise_position usages

src/context/display/statistics.ml

@@ -22,20 +22,27 @@ type symbol =
 	| SKEnumField of tenum_field
 	| SKVariable of tvar
 
-let collect_statistics ctx =
+let collect_statistics ctx pfilter =
 	let relations = Hashtbl.create 0 in
 	let symbols = Hashtbl.create 0 in
 	let handled_modules = Hashtbl.create 0 in
-	let add_relation pos r =
-		if pos <> null_pos then try
-			let l = Hashtbl.find relations pos in
+	let check_pos p = p <> null_pos && match pfilter with
+		| None -> true
+		| Some p' ->
+			(* Heuristic, we avoid the pfile check which would have to be uniquified first anyway. It's okay
+			   because we filter in the end again anyway. *)
+			p.pmin = p'.pmin && p.pmax = p'.pmax
+	in
+	let add_relation p r =
+		if check_pos p then try
+			let l = Hashtbl.find relations p in
 			if not (List.mem r l) then
-				Hashtbl.replace relations pos (r :: l)
+				Hashtbl.replace relations p (r :: l)
 		with Not_found ->
-			Hashtbl.add relations pos [r]
+			Hashtbl.add relations p [r]
 	in
 	let declare kind p =
-		if p <> null_pos then begin
+		if check_pos p then begin
 			if not (Hashtbl.mem relations p) then Hashtbl.add relations p [];
 			Hashtbl.replace symbols p kind;
 		end