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 643f7c6db..cfae5fb99 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,6 +124,7 @@ 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) -> ( @@ -151,7 +152,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 @@ -165,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") ^ "\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 @@ -180,22 +228,27 @@ 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 + | "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 ^ ":" - ^ 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 +261,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 0ccfa5ddc..6df538dea 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,149 @@ 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 -> [] + | Some localStamp -> ( + match Hashtbl.find_opt extra.internalReferences localStamp with + | 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)])) + (* 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 -> [] + | 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 + | None -> None + | Some file -> ( + match getExtra name with + | None -> None + | Some 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 + (file.uri, local) :: externals) + +let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules + ~getModule ~getExtra loc = + match loc with + | Explanation _ + | Typed (_, NotFound) + | LModule NotFound + | TopLevelModule _ | Constant _ -> + [] + | 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 -> [] + | Some file -> ( + let env = Query.fileEnv file in + match Query.resolvePath ~env ~path ~getModule with + | None -> [] + | Some (env, name) -> ( + match Query.exportedForTip ~env name tip with + | None -> [] + | Some stamp -> ( + match getUri env.file.uri with + | Error _ -> [] + | 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)))) diff --git a/analysis/src/State.ml b/analysis/src/State.ml index 2054ba261..049ab1fb1 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.TopTypes.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 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..a94fe94e7 --- /dev/null +++ b/analysis/tests/src/expected/References.res.txt @@ -0,0 +1,7 @@ +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}}} +] +