From 5152a89022dccee586186a00db1606c5d40891e3 Mon Sep 17 00:00:00 2001 From: Aleksandr Kuzmenko Date: Thu, 18 Jun 2020 12:50:34 +0300 Subject: [PATCH] [display] find references in one call to statistcs for any amount of symbols in an inheritance tree (closes #9504) --- src/compiler/displayOutput.ml | 2 +- src/context/display/findReferences.ml | 21 ++++++++------- src/context/display/statistics.ml | 37 +++++++++++++++------------ 3 files changed, 31 insertions(+), 29 deletions(-) diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml index 68e61b39675..c5d1e1d5fa7 100644 --- a/src/compiler/displayOutput.ml +++ b/src/compiler/displayOutput.ml @@ -420,7 +420,7 @@ let process_global_display_mode com tctx = | DMDiagnostics _ -> Diagnostics.run com | DMStatistics -> - let stats = Statistics.collect_statistics tctx (SFFile (DisplayPosition.display_position#get).pfile) true in + let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in raise_statistics (Statistics.Printer.print_statistics stats) | DMModuleSymbols (Some "") -> () | DMModuleSymbols filter -> diff --git a/src/context/display/findReferences.ml b/src/context/display/findReferences.ml index f383c66c061..20d5fe2816d 100644 --- a/src/context/display/findReferences.ml +++ b/src/context/display/findReferences.ml @@ -11,12 +11,12 @@ let find_possible_references tctx cs = let name,_,kind = Display.ReferencePosition.get () in ignore(SyntaxExplorer.explore_uncached_modules tctx cs [name,kind]) -let find_references tctx com with_definition name pos kind = +let find_references tctx com with_definition pos_filters = let t = Timer.timer ["display";"references";"collect"] in - let symbols,relations = Statistics.collect_statistics tctx (SFPos pos) true in + let symbols,relations = Statistics.collect_statistics tctx pos_filters true in t(); - let rec loop acc relations = match relations with - | (Statistics.Referenced,p) :: relations -> loop (p :: acc) relations + let rec loop acc (relations:(Statistics.relation * pos) list) = match relations with + | (Statistics.Referenced,p) :: relations when not (List.mem p acc) -> loop (p :: acc) relations | _ :: relations -> loop acc relations | [] -> acc in @@ -95,14 +95,13 @@ let collect_reference_positions com = [name,pos,kind] let find_references tctx com with_definition = - let usages = - List.fold_left (fun acc (name,pos,kind) -> - if pos <> null_pos then begin - acc @ (find_references tctx com with_definition name pos kind) - end - else acc + let pos_filters = + List.fold_left (fun acc (_,p,_) -> + if p = null_pos then acc + else Statistics.SFPos p :: acc ) [] (collect_reference_positions com) in + let usages = find_references tctx com with_definition pos_filters in let usages = List.sort (fun p1 p2 -> let c = compare p1.pfile p2.pfile in @@ -113,7 +112,7 @@ let find_references tctx com with_definition = let find_implementations tctx com name pos kind = let t = Timer.timer ["display";"implementations";"collect"] in - let symbols,relations = Statistics.collect_statistics tctx (SFPos pos) false in + let symbols,relations = Statistics.collect_statistics tctx [SFPos pos] false in t(); let rec loop acc relations = match relations with | ((Statistics.Implemented | Statistics.Overridden | Statistics.Extended),p) :: relations -> loop (p :: acc) relations diff --git a/src/context/display/statistics.ml b/src/context/display/statistics.ml index 5464c37e61f..881e89f3874 100644 --- a/src/context/display/statistics.ml +++ b/src/context/display/statistics.ml @@ -18,7 +18,7 @@ type statistics_filter = | SFPos of pos | SFFile of string -let collect_statistics ctx pfilter with_expressions = +let collect_statistics ctx pos_filters with_expressions = let relations = Hashtbl.create 0 in let symbols = Hashtbl.create 0 in let handled_modules = Hashtbl.create 0 in @@ -33,10 +33,13 @@ let collect_statistics ctx pfilter with_expressions = unique ) in - let check_pos = match pfilter with - | SFNone -> (fun p -> p <> null_pos) - | SFPos p -> (fun p' -> p.pmin = p'.pmin && p.pmax = p'.pmax && path_key p.pfile = path_key p'.pfile) - | SFFile s -> (fun p -> path_key p.pfile = path_key s) + let check_pos p = + List.exists (fun pfilter -> + match pfilter with + | SFNone -> p <> null_pos + | SFPos p1 -> p1.pmin = p.pmin && p1.pmax = p.pmax && path_key p1.pfile = path_key p.pfile + | SFFile s -> path_key p.pfile = path_key s + ) pos_filters in let add_relation p r = if check_pos p then try @@ -71,22 +74,22 @@ let collect_statistics ctx pfilter with_expressions = in let collect_implementations c = let memo = Hashtbl.create 0 in - let rec loop c' = - if not (Hashtbl.mem memo c'.cl_path) then begin - Hashtbl.add memo c'.cl_path true; - if c'.cl_interface then - add_relation c.cl_name_pos (Extended,c'.cl_name_pos) + let rec loop c1 = + if not (Hashtbl.mem memo c1.cl_path) then begin + Hashtbl.add memo c1.cl_path true; + if c1.cl_interface then + add_relation c.cl_name_pos (Extended,c1.cl_name_pos) else begin - add_relation c.cl_name_pos (Implemented,c'.cl_name_pos); + add_relation c.cl_name_pos (Implemented,c1.cl_name_pos); List.iter (fun cf -> try - let cf' = PMap.find cf.cf_name c'.cl_fields in + let cf' = PMap.find cf.cf_name c1.cl_fields in add_relation cf.cf_name_pos (Implemented,cf'.cf_name_pos) with Not_found -> () ) c.cl_ordered_fields end; - List.iter loop c'.cl_descendants + List.iter loop c1.cl_descendants end in List.iter loop c.cl_descendants @@ -101,21 +104,21 @@ let collect_statistics ctx pfilter with_expressions = let patch_string_pos p s = { p with pmin = p.pmax - String.length s } in let related_fields = Hashtbl.create 0 in let field_reference co cf p = - let p' = patch_string_pos p cf.cf_name in - add_relation cf.cf_name_pos (Referenced,p'); + let p1 = patch_string_pos p cf.cf_name in + add_relation cf.cf_name_pos (Referenced,p1); (* extend to related classes for instance fields *) if check_pos cf.cf_name_pos then match co with | Some c -> let id = (c.cl_path,cf.cf_name) in begin try let cfl = Hashtbl.find related_fields id in - List.iter (fun cf -> add_relation cf.cf_name_pos (Referenced,p')) cfl + List.iter (fun cf -> add_relation cf.cf_name_pos (Referenced,p1)) cfl with Not_found -> let cfl = ref [] in let check c = try let cf = PMap.find cf.cf_name c.cl_fields in - add_relation cf.cf_name_pos (Referenced,p'); + add_relation cf.cf_name_pos (Referenced,p1); cfl := cf :: !cfl with Not_found -> ()