From f3f0f919a9fb496c4bf52f8ffb910d59223a0a59 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 25 Apr 2021 09:10:08 +0200 Subject: [PATCH 1/5] Restore come code on references that could be used to find definitions of an element. --- analysis/src/References.ml | 114 ++++++++++++++++++++++++++++++++++++- 1 file changed, 112 insertions(+), 2 deletions(-) diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 0ccfa5ddc..6b2184178 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -46,8 +46,8 @@ let locForPos ~extra pos = arg has the location range of arg heuristic for: [Props, arg], give loc of `arg` *) (* Printf.eprintf "l1 %s\nl2 %s\n" - (SharedTypes.locationToString _l1) - (SharedTypes.locationToString l2); *) + (SharedTypes.locationToString _l1) + (SharedTypes.locationToString l2); *) Some l2 | [(loc1, _); ((loc2, _) as l); (loc3, _)] when loc1 = loc2 && loc2 = loc3 -> (* JSX with at most one child @@ -301,3 +301,113 @@ let definitionForLoc ~pathsForModule ~file ~getUri ~getModule loc = (* oooh wht do I do if the stamp is inside a pseudo-file? *) maybeLog ("Got stamp " ^ string_of_int stamp); definition ~file:env.file ~getModule stamp tip))) + +let isVisible (declared : _ SharedTypes.declared) = + declared.exported + && + let rec loop v = + match v with + | File _ -> true + | NotVisible -> false + | IncludedModule (_, inner) -> loop inner + | ExportedModule (_, inner) -> loop inner + in + loop declared.modulePath + +let rec pathFromVisibility visibilityPath current = + match visibilityPath with + | File _ -> Some current + | IncludedModule (_, inner) -> pathFromVisibility inner current + | ExportedModule (name, inner) -> + pathFromVisibility inner (Nested (name, current)) + | NotVisible -> None + +let pathFromVisibility visibilityPath tipName = + pathFromVisibility visibilityPath (Tip tipName) + +let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri + ~getExtra stamp tip = + let env = Query.fileEnv file in + let open Infix in + match + match tip with + | Constructor name -> + Query.getConstructor file stamp name |?>> fun x -> x.stamp + | Field name -> Query.getField file stamp name |?>> fun x -> x.stamp + | _ -> Some stamp + with + | None -> None + | Some localStamp -> ( + match Hashtbl.find_opt extra.internalReferences localStamp with + | None -> None + | Some local -> + maybeLog ("Checking externals: " ^ string_of_int stamp); + let externals = + match Query.declaredForTip ~stamps:env.file.stamps stamp tip with + | None -> [] + | Some declared -> + if isVisible declared then ( + let alternativeReferences = + match + alternateDeclared ~pathsForModule ~file ~getUri declared tip + with + | None -> [] + | Some (file, extra, {stamp}) -> ( + match + match tip with + | Constructor name -> + Query.getConstructor file stamp name |?>> fun x -> x.stamp + | Field name -> + Query.getField file stamp name |?>> fun x -> x.stamp + | _ -> Some stamp + with + | None -> [] + | Some localStamp -> ( + match + Hashtbl.find_opt extra.internalReferences localStamp + with + | None -> [] + | Some local -> [(file.uri, local)])) + [@@ocaml.doc + "\n\ + \ if this file has a corresponding interface or \ + implementation file\n\ + \ also find the references in that file.\n\ + \ "] + in + match pathFromVisibility declared.modulePath declared.name.txt with + | None -> [] + | Some path -> + maybeLog ("Now checking path " ^ pathToString path); + let thisModuleName = file.moduleName in + let externals = + allModules + |> List.filter (fun name -> name <> file.moduleName) + |> Utils.filterMap (fun name -> + match getModule name with + | Error _ -> None + | Ok file -> ( + match getExtra name with + | Error _ -> None + | Ok extra -> ( + match + Hashtbl.find_opt extra.externalReferences + thisModuleName + with + | None -> None + | Some refs -> + let refs = + refs + |> Utils.filterMap (fun (p, t, l) -> + match p = path && t = tip with + | true -> Some l + | false -> None) + in + Some (file.uri, refs)))) + in + alternativeReferences @ externals) + else ( + maybeLog "Not visible"; + []) + in + Some ((file.uri, local) :: externals)) From 2cd2d3ff2607926cc3f238576e1e37c1fc2b9ce2 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 25 Apr 2021 09:20:15 +0200 Subject: [PATCH 2/5] Recover allReferencesForLoc. --- analysis/src/References.ml | 52 ++++++++++++++++++++++++++++++++------ 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 6b2184178..dbda16891 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -368,12 +368,8 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri with | None -> [] | Some local -> [(file.uri, local)])) - [@@ocaml.doc - "\n\ - \ if this file has a corresponding interface or \ - implementation file\n\ - \ also find the references in that file.\n\ - \ "] + (* if this file has a corresponding interface or implementation file + also find the references in that file *) in match pathFromVisibility declared.modulePath declared.name.txt with | None -> [] @@ -385,8 +381,8 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri |> List.filter (fun name -> name <> file.moduleName) |> Utils.filterMap (fun name -> match getModule name with - | Error _ -> None - | Ok file -> ( + | None -> None + | Some file -> ( match getExtra name with | Error _ -> None | Ok extra -> ( @@ -411,3 +407,43 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri []) in Some ((file.uri, local) :: externals)) + +let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules + ~getModule ~getExtra loc : _ option = + match loc with + | Explanation _ + | Typed (_, NotFound) + | LModule NotFound + | TopLevelModule _ | Constant _ -> + None + | TypeDefinition (_, _, stamp) -> + forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule + ~getExtra stamp Type + | Typed (_, (LocalReference (stamp, tip) | Definition (stamp, tip))) + | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> + maybeLog + ("Finding references for " ^ Uri2.toString file.uri ^ " and stamp " + ^ string_of_int stamp ^ " and tip " ^ tipToString tip); + forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule + ~getExtra stamp tip + | LModule (GlobalReference (moduleName, path, tip)) + | Typed (_, GlobalReference (moduleName, path, tip)) -> ( + match getModule moduleName with + | None -> None + | Some file -> ( + let env = Query.fileEnv file in + match Query.resolvePath ~env ~path ~getModule with + | None -> None + | Some (env, name) -> ( + match Query.exportedForTip ~env name tip with + | None -> None + | Some stamp -> ( + match getUri env.file.uri with + | Error _ -> None + | Ok (file, extra) -> + maybeLog + ("Finding references for (global) " ^ Uri2.toString env.file.uri + ^ " and stamp " ^ string_of_int stamp ^ " and tip " + ^ tipToString tip); + forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules + ~getModule ~getExtra stamp tip)))) From 619f0387c279d8954ca7cb191e7af70f922ff6c5 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 25 Apr 2021 09:30:22 +0200 Subject: [PATCH 3/5] see how to hook it up --- analysis/src/Commands.ml | 32 +++++++++++++++++++++----------- analysis/src/References.ml | 6 +++--- analysis/src/State.ml | 11 +++++++++++ 3 files changed, 35 insertions(+), 14 deletions(-) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 643f7c6db..56d521167 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -103,7 +103,7 @@ let hover state ~file ~line ~col ~extra ~package = in match hoverText with | None -> Protocol.null - | Some s -> Protocol.stringifyHover {contents = s} ) + | Some s -> Protocol.stringifyHover {contents = s}) let hover ~path ~line ~col = let state = TopTypes.empty () in @@ -124,9 +124,19 @@ let definition state ~file ~line ~col ~extra ~package = |> List.filter (fun (l, _) -> not l.Location.loc_ghost) in let pos = Utils.protocolLineColToCmtLoc ~line ~col in + match References.locForPos ~extra:{extra with locations} pos with | None -> Protocol.null | Some (_, loc) -> ( + let zzzTODO = + References.allReferencesForLoc ~pathsForModule:package.pathsForModule + ~file ~extra ~allModules:package.localModules + ~getUri:(State.fileForUri state) + ~getModule:(State.fileForModule state ~package) + ~getExtra:(State.extraForModule state ~package) + loc + in + let locIsModule = match loc with | SharedTypes.LModule _ | TopLevelModule _ -> true @@ -151,7 +161,7 @@ let definition state ~file ~line ~col ~extra ~package = if skipZero then Protocol.null else Protocol.stringifyLocation - {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc} ) + {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc}) let definition ~path ~line ~col = let state = TopTypes.empty () in @@ -180,22 +190,22 @@ let test ~path = let line = i - 1 in let col = mlen - 1 in if mlen >= 3 then ( - ( match String.sub rest 0 3 with + (match String.sub rest 0 3 with | "def" -> print_endline - ( "Definition " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col ); + ("Definition " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); definition ~path ~line ~col | "hov" -> print_endline - ( "Hover " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col ); + ("Hover " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); hover ~path ~line ~col | "com" -> print_endline - ( "Complete " ^ path ^ " " ^ string_of_int line ^ ":" - ^ string_of_int col ); + ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); let currentFile, cout = Filename.open_temp_file "def" "txt" in lines |> List.iteri (fun j l -> @@ -208,7 +218,7 @@ let test ~path = close_out cout; complete ~path ~line ~col ~currentFile; Sys.remove currentFile - | _ -> () ); - print_newline () ) + | _ -> ()); + print_newline ()) in lines |> List.iteri processLine diff --git a/analysis/src/References.ml b/analysis/src/References.ml index dbda16891..b92701eb5 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -384,8 +384,8 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri | None -> None | Some file -> ( match getExtra name with - | Error _ -> None - | Ok extra -> ( + | None -> None + | Some extra -> ( match Hashtbl.find_opt extra.externalReferences thisModuleName @@ -409,7 +409,7 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri Some ((file.uri, local) :: externals)) let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules - ~getModule ~getExtra loc : _ option = + ~getModule ~getExtra loc = match loc with | Explanation _ | Typed (_, NotFound) diff --git a/analysis/src/State.ml b/analysis/src/State.ml index 2054ba261..11d9a3941 100644 --- a/analysis/src/State.ml +++ b/analysis/src/State.ml @@ -75,3 +75,14 @@ let fileForModule state ~package modname = match docsForModule modname state ~package with | None -> None | Some (file, _) -> Some file + +let extraForModule state ~package modname = + if Hashtbl.mem package.pathsForModule modname then + let paths = Hashtbl.find package.pathsForModule modname in + match SharedTypes.getSrc paths with + | None -> None + | Some src -> ( + match getFullFromCmt ~state ~uri:(Uri2.fromPath src) with + | Ok (_package, {extra}) -> Some extra + | Error _ -> None) + else None From d431549d7469b24deff406e8147f644ffa1177aa Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 25 Apr 2021 14:45:34 +0200 Subject: [PATCH 4/5] Add references command. --- analysis/src/Cli.ml | 11 +++- analysis/src/Commands.ml | 61 ++++++++++++++++--- analysis/src/References.ml | 16 ++--- analysis/src/State.ml | 2 +- analysis/tests/src/References.res | 8 +++ .../tests/src/expected/References.res.txt | 6 ++ 6 files changed, 84 insertions(+), 20 deletions(-) create mode 100644 analysis/tests/src/References.res create mode 100644 analysis/tests/src/expected/References.res.txt diff --git a/analysis/src/Cli.ml b/analysis/src/Cli.ml index 0dc1583b9..1423fc22b 100644 --- a/analysis/src/Cli.ml +++ b/analysis/src/Cli.ml @@ -22,9 +22,13 @@ Options: ./run.exe hover src/Foo.res 10 2 - definition: get inferred type for Foo.res at line 10 column 2: + definition: get definition for item in Foo.res at line 10 column 2: - ./run.exe definition src/Foo.res 10 2|} + ./run.exe definition src/Foo.res 10 2 + + references: get references to item in Foo.res at line 10 column 2: + + ./run.exe references src/Foo.res 10 2|} let main () = match Array.to_list Sys.argv with @@ -36,6 +40,9 @@ let main () = | [_; "definition"; path; line; col] -> Commands.definition ~path ~line:(int_of_string line) ~col:(int_of_string col) + | [_; "references"; path; line; col] -> + Commands.references ~path ~line:(int_of_string line) + ~col:(int_of_string col) | _ :: "dump" :: files -> Commands.dump files | [_; "test"; path] -> Commands.test ~path | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 56d521167..6e70f5297 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -128,15 +128,6 @@ let definition state ~file ~line ~col ~extra ~package = match References.locForPos ~extra:{extra with locations} pos with | None -> Protocol.null | Some (_, loc) -> ( - let zzzTODO = - References.allReferencesForLoc ~pathsForModule:package.pathsForModule - ~file ~extra ~allModules:package.localModules - ~getUri:(State.fileForUri state) - ~getModule:(State.fileForModule state ~package) - ~getExtra:(State.extraForModule state ~package) - loc - in - let locIsModule = match loc with | SharedTypes.LModule _ | TopLevelModule _ -> true @@ -175,6 +166,53 @@ let definition ~path ~line ~col = in print_endline result +let references state ~file ~line ~col ~extra ~package = + let open TopTypes in + let locations = + extra.SharedTypes.locations + |> List.filter (fun (l, _) -> not l.Location.loc_ghost) + in + let pos = Utils.protocolLineColToCmtLoc ~line ~col in + + match References.locForPos ~extra:{extra with locations} pos with + | None -> Protocol.null + | Some (_, loc) -> + let allReferences = + References.allReferencesForLoc ~pathsForModule:package.pathsForModule + ~file ~extra ~allModules:package.localModules + ~getUri:(State.fileForUri state) + ~getModule:(State.fileForModule state ~package) + ~getExtra:(State.extraForModule state ~package) + loc + in + let allLocs = + allReferences + |> List.fold_left + (fun acc (uri2, references) -> + (references + |> List.map (fun loc -> + Protocol.stringifyLocation + { + uri = Uri2.toString uri2; + range = Utils.cmtLocToRange loc; + })) + @ acc) + [] + in + "[\n" ^ (allLocs |> String.concat ",\n") ^ "]" + +let references ~path ~line ~col = + let state = TopTypes.empty () in + let filePath = Files.maybeConcat (Unix.getcwd ()) path in + let uri = Uri2.fromPath filePath in + let result = + match State.getFullFromCmt ~state ~uri with + | Error _message -> Protocol.null + | Ok (package, {file; extra}) -> + references state ~file ~line ~col ~extra ~package + in + print_endline result + let test ~path = Uri2.stripPath := true; match Files.readFile path with @@ -202,6 +240,11 @@ let test ~path = ^ string_of_int col); hover ~path ~line ~col + | "ref" -> + print_endline + ("References " ^ path ^ " " ^ string_of_int line ^ ":" + ^ string_of_int col); + references ~path ~line ~col | "com" -> print_endline ("Complete " ^ path ^ " " ^ string_of_int line ^ ":" diff --git a/analysis/src/References.ml b/analysis/src/References.ml index b92701eb5..6df538dea 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -336,10 +336,10 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri | Field name -> Query.getField file stamp name |?>> fun x -> x.stamp | _ -> Some stamp with - | None -> None + | None -> [] | Some localStamp -> ( match Hashtbl.find_opt extra.internalReferences localStamp with - | None -> None + | None -> [] | Some local -> maybeLog ("Checking externals: " ^ string_of_int stamp); let externals = @@ -406,7 +406,7 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri maybeLog "Not visible"; []) in - Some ((file.uri, local) :: externals)) + (file.uri, local) :: externals) let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule ~getExtra loc = @@ -415,7 +415,7 @@ let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules | Typed (_, NotFound) | LModule NotFound | TopLevelModule _ | Constant _ -> - None + [] | TypeDefinition (_, _, stamp) -> forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule ~getExtra stamp Type @@ -429,17 +429,17 @@ let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules | LModule (GlobalReference (moduleName, path, tip)) | Typed (_, GlobalReference (moduleName, path, tip)) -> ( match getModule moduleName with - | None -> None + | None -> [] | Some file -> ( let env = Query.fileEnv file in match Query.resolvePath ~env ~path ~getModule with - | None -> None + | None -> [] | Some (env, name) -> ( match Query.exportedForTip ~env name tip with - | None -> None + | None -> [] | Some stamp -> ( match getUri env.file.uri with - | Error _ -> None + | Error _ -> [] | Ok (file, extra) -> maybeLog ("Finding references for (global) " ^ Uri2.toString env.file.uri diff --git a/analysis/src/State.ml b/analysis/src/State.ml index 11d9a3941..049ab1fb1 100644 --- a/analysis/src/State.ml +++ b/analysis/src/State.ml @@ -77,7 +77,7 @@ let fileForModule state ~package modname = | Some (file, _) -> Some file let extraForModule state ~package modname = - if Hashtbl.mem package.pathsForModule modname then + if Hashtbl.mem package.TopTypes.pathsForModule modname then let paths = Hashtbl.find package.pathsForModule modname in match SharedTypes.getSrc paths with | None -> None diff --git a/analysis/tests/src/References.res b/analysis/tests/src/References.res new file mode 100644 index 000000000..ea15caddd --- /dev/null +++ b/analysis/tests/src/References.res @@ -0,0 +1,8 @@ +let x = 12 +// ^ref + +let a = x + +let b = a + +let c = x diff --git a/analysis/tests/src/expected/References.res.txt b/analysis/tests/src/expected/References.res.txt new file mode 100644 index 000000000..0ac26a362 --- /dev/null +++ b/analysis/tests/src/expected/References.res.txt @@ -0,0 +1,6 @@ +References tests/src/References.res 0:4 +[ +{"uri": "References.res", "range": {"start": {"line": 7, "character": 8}, "end": {"line": 7, "character": 9}}}, +{"uri": "References.res", "range": {"start": {"line": 3, "character": 8}, "end": {"line": 3, "character": 9}}}, +{"uri": "References.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}}] + From 326599eb1f9ef833ceea6d1c1b1b357749f86a5b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 25 Apr 2021 15:13:11 +0200 Subject: [PATCH 5/5] Formatting of the output of references command. --- analysis/src/Commands.ml | 2 +- analysis/tests/src/expected/References.res.txt | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 6e70f5297..cfae5fb99 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -199,7 +199,7 @@ let references state ~file ~line ~col ~extra ~package = @ acc) [] in - "[\n" ^ (allLocs |> String.concat ",\n") ^ "]" + "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]" let references ~path ~line ~col = let state = TopTypes.empty () in diff --git a/analysis/tests/src/expected/References.res.txt b/analysis/tests/src/expected/References.res.txt index 0ac26a362..a94fe94e7 100644 --- a/analysis/tests/src/expected/References.res.txt +++ b/analysis/tests/src/expected/References.res.txt @@ -2,5 +2,6 @@ References tests/src/References.res 0:4 [ {"uri": "References.res", "range": {"start": {"line": 7, "character": 8}, "end": {"line": 7, "character": 9}}}, {"uri": "References.res", "range": {"start": {"line": 3, "character": 8}, "end": {"line": 3, "character": 9}}}, -{"uri": "References.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}}] +{"uri": "References.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}} +]