From e220d26de0d172cca7768ee840a079650b5974e0 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 15 Dec 2022 09:33:31 +0100 Subject: [PATCH 1/4] Add an example of wrong reference with inner modules, .resi, and shadowing. In the example, the reference to `DefinitionWithInterface.Inner.y` leads to `DefinitionWithInterface.y` instead. This seems to happen only when there is an interface file, and the outer module has the same value named `y` as the inner module. See https://github.com/rescript-lang/rescript-vscode/issues/652 --- analysis/tests/src/Cross.res | 3 +++ analysis/tests/src/DefinitionWithInterface.res | 6 +++++- analysis/tests/src/DefinitionWithInterface.resi | 4 ++++ analysis/tests/src/expected/Cross.res.txt | 3 +++ 4 files changed, 15 insertions(+), 1 deletion(-) diff --git a/analysis/tests/src/Cross.res b/analysis/tests/src/Cross.res index 7bc5c8651..051b40411 100644 --- a/analysis/tests/src/Cross.res +++ b/analysis/tests/src/Cross.res @@ -36,3 +36,6 @@ type defT2 = DefinitionWithInterface.t // DefinitionWithInterface.a // ^com + +let yy = DefinitionWithInterface.Inner.y +// ^def \ No newline at end of file diff --git a/analysis/tests/src/DefinitionWithInterface.res b/analysis/tests/src/DefinitionWithInterface.res index b15cca67f..22bc4d41c 100644 --- a/analysis/tests/src/DefinitionWithInterface.res +++ b/analysis/tests/src/DefinitionWithInterface.res @@ -4,4 +4,8 @@ let y = 4 type t = int let aabbcc = 3 -let _ = aabbcc \ No newline at end of file +let _ = aabbcc + +module Inner = { + let y = 100 +} diff --git a/analysis/tests/src/DefinitionWithInterface.resi b/analysis/tests/src/DefinitionWithInterface.resi index 8b357372c..c63048d57 100644 --- a/analysis/tests/src/DefinitionWithInterface.resi +++ b/analysis/tests/src/DefinitionWithInterface.resi @@ -2,3 +2,7 @@ let y: int // ^def type t + +module Inner: { + let y: int +} diff --git a/analysis/tests/src/expected/Cross.res.txt b/analysis/tests/src/expected/Cross.res.txt index b045e8a02..58a474582 100644 --- a/analysis/tests/src/expected/Cross.res.txt +++ b/analysis/tests/src/expected/Cross.res.txt @@ -99,3 +99,6 @@ Pexp_ident DefinitionWithInterface.a:[36:3->36:28] Completable: Cpath Value[DefinitionWithInterface, a] [] +Definition src/Cross.res 39:39 +{"uri": "DefinitionWithInterface.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}} + From d32dfa4ab4373ae9a6e44a59b0a2cbfbae77e1b5 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 15 Dec 2022 15:51:44 +0100 Subject: [PATCH 2/4] Use module path instead of simply the id to find references across res/resi. --- CHANGELOG.md | 2 + analysis/src/Hover.ml | 7 +- analysis/src/ProcessCmt.ml | 12 +- analysis/src/References.ml | 112 +++++++----------- analysis/src/ResolvePath.ml | 2 +- analysis/src/SharedTypes.ml | 34 ++++-- .../tests/src/DefinitionWithInterface.res | 1 + .../tests/src/DefinitionWithInterface.resi | 1 + analysis/tests/src/expected/Cross.res.txt | 2 +- .../expected/DefinitionWithInterface.res.txt | 3 + .../expected/DefinitionWithInterface.resi.txt | 3 + 11 files changed, 96 insertions(+), 83 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4a333dc50..0e2fe53dd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -43,6 +43,8 @@ - Fix issue with references from implementation files which also happen to have interface files https://github.com/rescript-lang/rescript-vscode/issues/645 +- Fix issue where jump to definition would go to the wrong place when there are aliased identifiers in submodules https://github.com/rescript-lang/rescript-vscode/pull/653 + ## v1.8.2 #### :rocket: New Feature diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index f0d7236a4..2bd1ce7bf 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -106,7 +106,8 @@ let hoverWithExpandedTypes ~docstring ~file ~package ~supportsMarkdownLinks typ Markdown.goToDefinitionText ~env ~pos:loc.Warnings.loc_start else "" in - Markdown.divider ^ (if supportsMarkdownLinks then Markdown.spacing else "") + Markdown.divider + ^ (if supportsMarkdownLinks then Markdown.spacing else "") ^ Markdown.codeBlock (decl |> Shared.declToString ~printNameAsIs:true @@ -186,7 +187,7 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem = match ResolvePath.resolvePath ~env ~path ~package with | None -> None | Some (env, name) -> ( - match References.exportedForTip ~env name tip with + match References.exportedForTip ~env ~name tip with | None -> None | Some stamp -> ( match Stamps.findModule file.stamps stamp with @@ -250,4 +251,4 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem = let typeString, docstring = t |> fromType ~docstring in typeString :: docstring) in - Some (String.concat "\n\n" parts) \ No newline at end of file + Some (String.concat "\n\n" parts) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 2318f148f..db5d8cb01 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -249,7 +249,17 @@ let rec forSignatureItem ~env ~(exported : Exported.t) decl |> forTypeDeclaration ~env ~exported ~recStatus) | Tsig_module {md_id; md_attributes; md_loc; md_name = name; md_type = {mty_type}} -> - let item = forTypeModule env mty_type in + let item = + let env = + { + env with + modulePath = + ExportedModule + {name = name.txt; modulePath = env.modulePath; isType = false}; + } + in + forTypeModule env mty_type + in let declared = addDeclared ~item ~name ~extent:md_loc ~stamp:(Ident.binding_time md_id) ~env md_attributes diff --git a/analysis/src/References.ml b/analysis/src/References.ml index fb730a83b..389744a2c 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -145,7 +145,7 @@ let getConstructor (file : File.t) stamp name = | Some const -> Some const) | _ -> None) -let exportedForTip ~(env : QueryEnv.t) name (tip : Tip.t) = +let exportedForTip ~(env : QueryEnv.t) ~name (tip : Tip.t) = match tip with | Value -> Exported.find env.exported Exported.Value name | Field _ | Constructor _ | Type -> @@ -185,7 +185,7 @@ let definedForLoc ~file ~package locKind = Log.log ("Cannot resolve path " ^ pathToString path); None | Some (env, name) -> ( - match exportedForTip ~env name tip with + match exportedForTip ~env ~name tip with | None -> Log.log ("Exported not found for tip " ^ name ^ " > " ^ Tip.toString tip); @@ -200,23 +200,6 @@ let definedForLoc ~file ~package locKind = maybeLog "Yes!! got it"; Some res)))) -let declaredForExportedTip ~(stamps : Stamps.t) ~(exported : Exported.t) name - (tip : Tip.t) = - let bind f x = Option.bind x f in - match tip with - | Value -> - Exported.find exported Exported.Value name - |> bind (fun stamp -> Stamps.findValue stamps stamp) - |> Option.map (fun x -> {x with Declared.item = ()}) - | Field _ | Constructor _ | Type -> - Exported.find exported Exported.Type name - |> bind (fun stamp -> Stamps.findType stamps stamp) - |> Option.map (fun x -> {x with Declared.item = ()}) - | Module -> - Exported.find exported Exported.Module name - |> bind (fun stamp -> Stamps.findModule stamps stamp) - |> Option.map (fun x -> {x with Declared.item = ()}) - (** Find alternative declaration: from res in case of interface, or from resi in case of implementation *) let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = match Hashtbl.find_opt package.pathsForModule file.moduleName with @@ -230,10 +213,18 @@ let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = match Cmt.fullFromUri ~uri:(Uri.fromPath alternateUri) with | None -> None | Some {file; extra} -> ( - match - declaredForExportedTip ~stamps:file.stamps - ~exported:file.structure.exported declared.name.txt tip - with + let env = QueryEnv.fromFile file in + let path = ModulePath.toPath declared.modulePath declared.name.txt in + maybeLog ("find declared for path " ^ pathToString path); + let declaredOpt = + match ResolvePath.resolvePath ~env ~path ~package with + | None -> None + | Some (env, name) -> ( + match exportedForTip ~env ~name tip with + | None -> None + | Some stamp -> declaredForTip ~stamps:file.stamps stamp tip) + in + match declaredOpt with | None -> None | Some declared -> Some (file, extra, declared))) | _ -> @@ -386,7 +377,7 @@ let definitionForLocItem ~full:{file; package} locItem = | None -> None | Some (env, name) -> ( maybeLog ("resolved path:" ^ name); - match exportedForTip ~env name tip with + match exportedForTip ~env ~name tip with | None -> None | Some stamp -> (* oooh wht do I do if the stamp is inside a pseudo-file? *) @@ -425,7 +416,7 @@ let typeDefinitionForLocItem ~full:{file; package} locItem = let isVisible (declared : _ Declared.t) = declared.isExported && - let rec loop v = + let rec loop (v : ModulePath.t) = match v with | File _ -> true | NotVisible -> false @@ -434,17 +425,6 @@ let isVisible (declared : _ Declared.t) = in loop declared.modulePath -let rec pathFromVisibility visibilityPath current = - match visibilityPath with - | File _ -> Some current - | IncludedModule (_, inner) -> pathFromVisibility inner current - | ExportedModule {name; modulePath = inner} -> - pathFromVisibility inner (name :: current) - | NotVisible -> None - -let pathFromVisibility visibilityPath tipName = - pathFromVisibility visibilityPath [tipName] - type references = { uri: Uri.t; locOpt: Location.t option; (* None: reference to a toplevel module *) @@ -497,35 +477,35 @@ let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = (* 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 = - package.projectFiles |> FileSet.elements - |> List.filter (fun name -> name <> file.moduleName) - |> List.map (fun moduleName -> - Cmt.fullsFromModule ~package ~moduleName - |> List.map (fun {file; extra} -> - match - Hashtbl.find_opt extra.externalReferences - thisModuleName - with - | None -> [] - | Some refs -> - let locs = - refs - |> Utils.filterMap (fun (p, t, locs) -> - if p = path && t = tip then Some locs - else None) - in - locs - |> List.map (fun loc -> - {uri = file.uri; locOpt = Some loc}))) - |> List.concat |> List.concat - in - alternativeReferences @ externals) + let path = + ModulePath.toPath declared.modulePath declared.name.txt + in + maybeLog ("Now checking path " ^ pathToString path); + let thisModuleName = file.moduleName in + let externals = + package.projectFiles |> FileSet.elements + |> List.filter (fun name -> name <> file.moduleName) + |> List.map (fun moduleName -> + Cmt.fullsFromModule ~package ~moduleName + |> List.map (fun {file; extra} -> + match + Hashtbl.find_opt extra.externalReferences + thisModuleName + with + | None -> [] + | Some refs -> + let locs = + refs + |> Utils.filterMap (fun (p, t, locs) -> + if p = path && t = tip then Some locs + else None) + in + locs + |> List.map (fun loc -> + {uri = file.uri; locOpt = Some loc}))) + |> List.concat |> List.concat + in + alternativeReferences @ externals) else ( maybeLog "Not visible"; []) @@ -580,7 +560,7 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = match ResolvePath.resolvePath ~env ~path ~package with | None -> [] | Some (env, name) -> ( - match exportedForTip ~env name tip with + match exportedForTip ~env ~name tip with | None -> [] | Some stamp -> ( match Cmt.fullFromUri ~uri:env.file.uri with diff --git a/analysis/src/ResolvePath.ml b/analysis/src/ResolvePath.ml index 36b6c333a..dc930a7e7 100644 --- a/analysis/src/ResolvePath.ml +++ b/analysis/src/ResolvePath.ml @@ -133,7 +133,7 @@ let resolveFromCompilerPath ~env ~package path = | NotFound -> NotFound | Exported (env, name) -> Exported (env, name) -let rec getSourceUri ~(env : QueryEnv.t) ~package path = +let rec getSourceUri ~(env : QueryEnv.t) ~package (path : ModulePath.t) = match path with | File (uri, _moduleName) -> uri | NotVisible -> env.file.uri diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index edf9f22af..1cb3219e6 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -2,11 +2,27 @@ let str s = if s = "" then "\"\"" else s let list l = "[" ^ (l |> List.map str |> String.concat ", ") ^ "]" let ident l = l |> List.map str |> String.concat "." -type modulePath = - | File of Uri.t * string - | NotVisible - | IncludedModule of Path.t * modulePath - | ExportedModule of {name: string; modulePath: modulePath; isType: bool} +type path = string list + +let pathToString (path : path) = path |> String.concat "." + +module ModulePath = struct + type t = + | File of Uri.t * string + | NotVisible + | IncludedModule of Path.t * t + | ExportedModule of {name: string; modulePath: t; isType: bool} + + let toPath modulePath tipName : path = + let rec loop modulePath current = + match modulePath with + | File _ -> current + | IncludedModule (_, inner) -> loop inner current + | ExportedModule {name; modulePath = inner} -> loop inner (name :: current) + | NotVisible -> current + in + loop modulePath [tipName] +end type field = {stamp: int; fname: string Location.loc; typ: Types.type_expr} @@ -102,7 +118,7 @@ module Declared = struct name: string Location.loc; extentLoc: Location.t; stamp: int; - modulePath: modulePath; + modulePath: ModulePath.t; isExported: bool; deprecated: string option; docstring: string list; @@ -257,7 +273,7 @@ module Completion = struct end module Env = struct - type t = {stamps: Stamps.t; modulePath: modulePath} + type t = {stamps: Stamps.t; modulePath: ModulePath.t} end type filePath = string @@ -321,10 +337,6 @@ module Tip = struct | Module -> "Module" end -type path = string list - -let pathToString (path : path) = path |> String.concat "." - let rec pathIdentToString (p : Path.t) = match p with | Pident {name} -> name diff --git a/analysis/tests/src/DefinitionWithInterface.res b/analysis/tests/src/DefinitionWithInterface.res index 22bc4d41c..78dc78103 100644 --- a/analysis/tests/src/DefinitionWithInterface.res +++ b/analysis/tests/src/DefinitionWithInterface.res @@ -8,4 +8,5 @@ let _ = aabbcc module Inner = { let y = 100 + // ^def } diff --git a/analysis/tests/src/DefinitionWithInterface.resi b/analysis/tests/src/DefinitionWithInterface.resi index c63048d57..eacfbc108 100644 --- a/analysis/tests/src/DefinitionWithInterface.resi +++ b/analysis/tests/src/DefinitionWithInterface.resi @@ -5,4 +5,5 @@ type t module Inner: { let y: int + // ^def } diff --git a/analysis/tests/src/expected/Cross.res.txt b/analysis/tests/src/expected/Cross.res.txt index 58a474582..b51c414b8 100644 --- a/analysis/tests/src/expected/Cross.res.txt +++ b/analysis/tests/src/expected/Cross.res.txt @@ -100,5 +100,5 @@ Completable: Cpath Value[DefinitionWithInterface, a] [] Definition src/Cross.res 39:39 -{"uri": "DefinitionWithInterface.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}} +{"uri": "DefinitionWithInterface.res", "range": {"start": {"line": 9, "character": 6}, "end": {"line": 9, "character": 7}}} diff --git a/analysis/tests/src/expected/DefinitionWithInterface.res.txt b/analysis/tests/src/expected/DefinitionWithInterface.res.txt index a133d7fbf..f8d85032d 100644 --- a/analysis/tests/src/expected/DefinitionWithInterface.res.txt +++ b/analysis/tests/src/expected/DefinitionWithInterface.res.txt @@ -1,3 +1,6 @@ Definition src/DefinitionWithInterface.res 0:4 {"uri": "DefinitionWithInterface.resi", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}} +Definition src/DefinitionWithInterface.res 9:6 +{"uri": "DefinitionWithInterface.resi", "range": {"start": {"line": 6, "character": 2}, "end": {"line": 6, "character": 12}}} + diff --git a/analysis/tests/src/expected/DefinitionWithInterface.resi.txt b/analysis/tests/src/expected/DefinitionWithInterface.resi.txt index 256702cc6..10bc34339 100644 --- a/analysis/tests/src/expected/DefinitionWithInterface.resi.txt +++ b/analysis/tests/src/expected/DefinitionWithInterface.resi.txt @@ -1,3 +1,6 @@ Definition src/DefinitionWithInterface.resi 0:4 {"uri": "DefinitionWithInterface.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}} +Definition src/DefinitionWithInterface.resi 6:6 +{"uri": "DefinitionWithInterface.res", "range": {"start": {"line": 9, "character": 6}, "end": {"line": 9, "character": 7}}} + From dc067e54cc63999a68bd7ccd59d87589073e2227 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 15 Dec 2022 16:13:05 +0100 Subject: [PATCH 3/4] refactor --- analysis/src/Hover.ml | 27 +++++------ analysis/src/References.ml | 92 ++++++++++++++++++-------------------- 2 files changed, 55 insertions(+), 64 deletions(-) diff --git a/analysis/src/Hover.ml b/analysis/src/Hover.ml index 2bd1ce7bf..599852273 100644 --- a/analysis/src/Hover.ml +++ b/analysis/src/Hover.ml @@ -184,24 +184,21 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem = | None -> None | Some file -> ( let env = QueryEnv.fromFile file in - match ResolvePath.resolvePath ~env ~path ~package with + match References.exportedForTip ~env ~path ~package ~tip with | None -> None - | Some (env, name) -> ( - match References.exportedForTip ~env ~name tip with + | Some (_env, _name, stamp) -> ( + match Stamps.findModule file.stamps stamp with | None -> None - | Some stamp -> ( - match Stamps.findModule file.stamps stamp with + | Some md -> ( + match References.resolveModuleReference ~file ~package md with | None -> None - | Some md -> ( - match References.resolveModuleReference ~file ~package md with - | None -> None - | Some (file, declared) -> - let name, docstring = - match declared with - | Some d -> (d.name.txt, d.docstring) - | None -> (file.moduleName, file.structure.docstring) - in - showModule ~docstring ~name ~file declared))))) + | Some (file, declared) -> + let name, docstring = + match declared with + | Some d -> (d.name.txt, d.docstring) + | None -> (file.moduleName, file.structure.docstring) + in + showModule ~docstring ~name ~file declared)))) | LModule NotFound -> None | TopLevelModule name -> ( match ProcessCmt.fileForModule ~package name with diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 389744a2c..7ef538cb9 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -145,12 +145,23 @@ let getConstructor (file : File.t) stamp name = | Some const -> Some const) | _ -> None) -let exportedForTip ~(env : QueryEnv.t) ~name (tip : Tip.t) = - match tip with - | Value -> Exported.find env.exported Exported.Value name - | Field _ | Constructor _ | Type -> - Exported.find env.exported Exported.Type name - | Module -> Exported.find env.exported Exported.Module name +let exportedForTip ~env ~path ~package ~(tip : Tip.t) = + match ResolvePath.resolvePath ~env ~path ~package with + | None -> + Log.log ("Cannot resolve path " ^ pathToString path); + None + | Some (env, name) -> ( + let kind = + match tip with + | Value -> Exported.Value + | Field _ | Constructor _ | Type -> Exported.Type + | Module -> Exported.Module + in + match Exported.find env.exported kind name with + | None -> + Log.log ("Exported not found for tip " ^ name ^ " > " ^ Tip.toString tip); + None + | Some stamp -> Some (env, name, stamp)) let definedForLoc ~file ~package locKind = let inner ~file stamp (tip : Tip.t) = @@ -180,25 +191,17 @@ let definedForLoc ~file ~package locKind = None | Some file -> ( let env = QueryEnv.fromFile file in - match ResolvePath.resolvePath ~env ~path ~package with - | None -> - Log.log ("Cannot resolve path " ^ pathToString path); - None - | Some (env, name) -> ( - match exportedForTip ~env ~name tip with + match exportedForTip ~env ~path ~package ~tip with + | None -> None + | Some (env, name, stamp) -> ( + maybeLog ("Getting for " ^ string_of_int stamp ^ " in " ^ name); + match inner ~file:env.file stamp tip with | None -> - Log.log - ("Exported not found for tip " ^ name ^ " > " ^ Tip.toString tip); + Log.log "could not get defined"; None - | Some stamp -> ( - maybeLog ("Getting for " ^ string_of_int stamp ^ " in " ^ name); - match inner ~file:env.file stamp tip with - | None -> - Log.log "could not get defined"; - None - | Some res -> - maybeLog "Yes!! got it"; - Some res)))) + | Some res -> + maybeLog "Yes!! got it"; + Some res))) (** Find alternative declaration: from res in case of interface, or from resi in case of implementation *) let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = @@ -217,12 +220,10 @@ let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = let path = ModulePath.toPath declared.modulePath declared.name.txt in maybeLog ("find declared for path " ^ pathToString path); let declaredOpt = - match ResolvePath.resolvePath ~env ~path ~package with + match exportedForTip ~env ~path ~package ~tip with | None -> None - | Some (env, name) -> ( - match exportedForTip ~env ~name tip with - | None -> None - | Some stamp -> declaredForTip ~stamps:file.stamps stamp tip) + | Some (_env, _name, stamp) -> + declaredForTip ~stamps:file.stamps stamp tip in match declaredOpt with | None -> None @@ -373,16 +374,12 @@ let definitionForLocItem ~full:{file; package} locItem = | None -> None | Some file -> ( let env = QueryEnv.fromFile file in - match ResolvePath.resolvePath ~env ~path ~package with + match exportedForTip ~env ~path ~package ~tip with | None -> None - | Some (env, name) -> ( - maybeLog ("resolved path:" ^ name); - match exportedForTip ~env ~name tip with - | None -> None - | Some stamp -> - (* oooh wht do I do if the stamp is inside a pseudo-file? *) - maybeLog ("Got stamp " ^ string_of_int stamp); - definition ~file:env.file ~package stamp tip))) + | Some (env, _name, stamp) -> + (* oooh wht do I do if the stamp is inside a pseudo-file? *) + maybeLog ("Got stamp " ^ string_of_int stamp); + definition ~file:env.file ~package stamp tip)) let digConstructor ~env ~package path = match ResolvePath.resolveFromCompilerPath ~env ~package path with @@ -557,17 +554,14 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = | None -> [] | Some file -> ( let env = QueryEnv.fromFile file in - match ResolvePath.resolvePath ~env ~path ~package with + match exportedForTip ~env ~path ~package ~tip with | None -> [] - | Some (env, name) -> ( - match exportedForTip ~env ~name tip with + | Some (env, _name, stamp) -> ( + match Cmt.fullFromUri ~uri:env.file.uri with | None -> [] - | Some stamp -> ( - match Cmt.fullFromUri ~uri:env.file.uri with - | None -> [] - | Some full -> - maybeLog - ("Finding references for (global) " ^ Uri.toString env.file.uri - ^ " and stamp " ^ string_of_int stamp ^ " and tip " - ^ Tip.toString tip); - forLocalStamp ~full stamp tip)))) + | Some full -> + maybeLog + ("Finding references for (global) " ^ Uri.toString env.file.uri + ^ " and stamp " ^ string_of_int stamp ^ " and tip " + ^ Tip.toString tip); + forLocalStamp ~full stamp tip))) From 786b6c8e58a7a8038266142885fcbada9c6b2e26 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 15 Dec 2022 16:29:39 +0100 Subject: [PATCH 4/4] Refactor env module path construction. --- analysis/src/ProcessCmt.ml | 48 ++++--------------------------------- analysis/src/SharedTypes.ml | 7 ++++++ 2 files changed, 12 insertions(+), 43 deletions(-) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index db5d8cb01..b005cf2fe 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -249,17 +249,7 @@ let rec forSignatureItem ~env ~(exported : Exported.t) decl |> forTypeDeclaration ~env ~exported ~recStatus) | Tsig_module {md_id; md_attributes; md_loc; md_name = name; md_type = {mty_type}} -> - let item = - let env = - { - env with - modulePath = - ExportedModule - {name = name.txt; modulePath = env.modulePath; isType = false}; - } - in - forTypeModule env mty_type - in + let item = forTypeModule (env |> Env.addModule ~name:name.txt) mty_type in let declared = addDeclared ~item ~name ~extent:md_loc ~stamp:(Ident.binding_time md_id) ~env md_attributes @@ -384,14 +374,7 @@ let rec forStructureItem ~env ~(exported : Exported.t) item = mtd_type = Some {mty_type = modType}; mtd_loc; } -> - let env = - { - env with - modulePath = - ExportedModule - {name = name.txt; modulePath = env.modulePath; isType = true}; - } - in + let env = env |> Env.addModuleType ~name:name.txt in let modTypeItem = forTypeModule env modType in let declared = addDeclared ~item:modTypeItem ~name ~extent:mtd_loc @@ -439,14 +422,7 @@ and forModule env mod_desc moduleName = match mod_desc with | Tmod_ident (path, _lident) -> Ident path | Tmod_structure structure -> - let env = - { - env with - modulePath = - ExportedModule - {name = moduleName; modulePath = env.modulePath; isType = false}; - } - in + let env = env |> Env.addModule ~name:moduleName in let contents = forStructure ~env structure.str_items in Structure contents | Tmod_functor (ident, argName, maybeType, resultExpr) -> @@ -466,26 +442,12 @@ and forModule env mod_desc moduleName = | Tmod_apply (functor_, _arg, _coercion) -> forModule env functor_.mod_desc moduleName | Tmod_unpack (_expr, moduleType) -> - let env = - { - env with - modulePath = - ExportedModule - {name = moduleName; modulePath = env.modulePath; isType = false}; - } - in + let env = env |> Env.addModule ~name:moduleName in forTypeModule env moduleType | Tmod_constraint (expr, typ, _constraint, _coercion) -> (* TODO do this better I think *) let modKind = forModule env expr.mod_desc moduleName in - let env = - { - env with - modulePath = - ExportedModule - {name = moduleName; modulePath = env.modulePath; isType = false}; - } - in + let env = env |> Env.addModule ~name:moduleName in let modTypeKind = forTypeModule env typ in Constraint (modKind, modTypeKind) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 1cb3219e6..549c5ea32 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -274,6 +274,13 @@ end module Env = struct type t = {stamps: Stamps.t; modulePath: ModulePath.t} + let addExportedModule ~name ~isType env = + { + env with + modulePath = ExportedModule {name; modulePath = env.modulePath; isType}; + } + let addModule ~name env = env |> addExportedModule ~name ~isType:false + let addModuleType ~name env = env |> addExportedModule ~name ~isType:true end type filePath = string