diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 83bf53358b6..3f3d040ae73 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -335,7 +335,7 @@ type BoundModel private ( if enableBackgroundItemKeyStoreAndSemanticClassification then use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() + let builder = ItemKeyStoreBuilder(tcGlobals) let preventDuplicates = HashSet({ new IEqualityComparer with member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 member _.GetHashCode o = o.GetHashCode() }) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index ce1d84d531c..c44fc6401d2 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -16,6 +16,8 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TcGlobals #nowarn "9" #nowarn "51" @@ -96,8 +98,82 @@ module ItemKeyTags = [] let parameters = "p$p$" +[] +module DebugKeyStore = + + /// A debugging tool to show what's being written into the ItemKeyStore in a more human readable way in the debugger. + type DebugKeyStore() = + + let mutable debugCurrentItem = ResizeArray() + + member val Items = ResizeArray() + + member _.WriteRange(m: range) = debugCurrentItem.Add("range", $"{m}") + + member _.WriteEntityRef(eref: EntityRef) = + debugCurrentItem.Add("EntityRef", $"{eref}") + + member _.WriteILType(ilTy: ILType) = + debugCurrentItem.Add("ILType", $"%A{ilTy}") + + member _.WriteType isStandalone (ty: TType) = + debugCurrentItem.Add("Type", $"{isStandalone} %A{ty}") + + member _.WriteMeasure isStandalone (ms: Measure) = + debugCurrentItem.Add("Measure", $"{isStandalone} %A{ms}") + + member _.WriteTypar (isStandalone: bool) (typar: Typar) = + debugCurrentItem.Add("Typar", $"{isStandalone} %A{typar}") + + member _.WriteValRef(vref: ValRef) = + debugCurrentItem.Add("ValRef", $"{vref}") + + member _.WriteValue(vref: ValRef) = + debugCurrentItem.Add("Value", $"{vref}") + + member _.WriteActivePatternCase (apInfo: ActivePatternInfo) index = + debugCurrentItem.Add("ActivePatternCase", $"{apInfo} {index}") + + member this.FinishItem(item, length) = + debugCurrentItem.Add("length", $"{length}") + this.Items.Add(item, debugCurrentItem) + let itemCount = this.Items.Count + assert (itemCount > 0) + debugCurrentItem <- ResizeArray() + + member _.New() = DebugKeyStore() + + /// A replacement for DebugKeyStore for when we're not debugging. + type _DebugKeyStoreNoop() = + + member inline _.Items = Unchecked.defaultof<_> + + member inline _.WriteRange(_m: range) = () + + member inline _.WriteEntityRef(_eref: EntityRef) = () + + member inline _.WriteILType(_ilTy: ILType) = () + + member inline _.WriteType _isStandalone (_ty: TType) = () + + member inline _.WriteMeasure _isStandalone (_ms: Measure) = () + + member inline _.WriteTypar (_isStandalone: bool) (_typar: Typar) = () + + member inline _.WriteValRef(_vref: ValRef) = () + + member inline _.WriteValue(_vref: ValRef) = () + + member inline _.WriteActivePatternCase (_apInfo: ActivePatternInfo) _index = () + + member inline _.FinishItem(_item, _length) = () + + member inline this.New() = this + + let DebugKeyStoreNoop = _DebugKeyStoreNoop () + [] -type ItemKeyStore(mmf: MemoryMappedFile, length) = +type ItemKeyStore(mmf: MemoryMappedFile, length, tcGlobals, debugStore) = let rangeBuffer = Array.zeroCreate sizeof @@ -107,6 +183,8 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = if isDisposed then raise (ObjectDisposedException("ItemKeyStore")) + member _.DebugStore = debugStore + member _.ReadRange(reader: byref) = reader.ReadBytes(sizeof, rangeBuffer, 0) MemoryMarshal.Cast(Span(rangeBuffer)).[0] @@ -133,7 +211,7 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = member this.FindAll(item: Item) = checkDispose () - let builder = ItemKeyStoreBuilder() + let builder = ItemKeyStoreBuilder(tcGlobals) builder.Write(range0, item) match builder.TryBuildAndReset() with @@ -166,10 +244,13 @@ type ItemKeyStore(mmf: MemoryMappedFile, length) = isDisposed <- true mmf.Dispose() -and [] ItemKeyStoreBuilder() = +and [] ItemKeyStoreBuilder(tcGlobals: TcGlobals) = let b = BlobBuilder() + // Change this to DebugKeyStore() for debugging (DebugStore will be available on ItemKeyStore) + let mutable debug = DebugKeyStoreNoop + let writeChar (c: char) = b.WriteUInt16(uint16 c) let writeUInt16 (i: uint16) = b.WriteUInt16 i @@ -181,16 +262,20 @@ and [] ItemKeyStoreBuilder() = let writeString (str: string) = b.WriteUTF16 str let writeRange (m: range) = + debug.WriteRange m let mutable m = m let ptr = &&m |> NativePtr.toNativeInt |> NativePtr.ofNativeInt b.WriteBytes(ptr, sizeof) let writeEntityRef (eref: EntityRef) = + debug.WriteEntityRef eref writeString ItemKeyTags.entityRef writeString eref.CompiledName eref.CompilationPath.MangledPath |> List.iter (fun str -> writeString str) let rec writeILType (ilTy: ILType) = + debug.WriteILType ilTy + match ilTy with | ILType.TypeVar n -> writeString "!" @@ -231,6 +316,8 @@ and [] ItemKeyStoreBuilder() = writeILType mref.ReturnType let rec writeType isStandalone (ty: TType) = + debug.WriteType isStandalone ty + match stripTyparEqns ty with | TType_forall (_, ty) -> writeType false ty @@ -268,6 +355,8 @@ and [] ItemKeyStoreBuilder() = writeString nm and writeMeasure isStandalone (ms: Measure) = + debug.WriteMeasure isStandalone ms + match ms with | Measure.Var typar -> writeString ItemKeyTags.typeMeasureVar @@ -278,6 +367,8 @@ and [] ItemKeyStoreBuilder() = | _ -> () and writeTypar (isStandalone: bool) (typar: Typar) = + debug.WriteTypar isStandalone typar + match typar.Solution with | Some ty -> writeType isStandalone ty | _ -> @@ -285,13 +376,29 @@ and [] ItemKeyStoreBuilder() = writeInt64 typar.Stamp let writeValRef (vref: ValRef) = + debug.WriteValRef vref + match vref.MemberInfo with | Some memberInfo -> writeString ItemKeyTags.itemValueMember - writeEntityRef memberInfo.ApparentEnclosingEntity + + match vref.IsOverrideOrExplicitImpl, vref.MemberInfo with + | true, + Some { + ImplementedSlotSigs = slotSig :: _tail + } -> slotSig.DeclaringType |> writeType false + | _ -> writeEntityRef memberInfo.ApparentEnclosingEntity + writeString vref.LogicalName writeString ItemKeyTags.parameters - writeType false vref.Type + + match vref.IsInstanceMember, tryDestFunTy tcGlobals vref.Type with + // In case of an instance member, we will skip the type of "this" because it will differ + // between the definition and overrides. Also it's not needed to uniquely identify the reference. + | true, ValueSome (_thisTy, funTy) -> funTy + | _ -> vref.Type + |> writeType false + | _ -> writeString ItemKeyTags.itemValue writeString vref.LogicalName @@ -307,6 +414,8 @@ and [] ItemKeyStoreBuilder() = | Parent eref -> writeEntityRef eref let writeValue (vref: ValRef) = + debug.WriteValue vref + if vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then writeString ItemKeyTags.itemProperty writeString vref.PropertyName @@ -322,6 +431,8 @@ and [] ItemKeyStoreBuilder() = writeValRef vref let writeActivePatternCase (apInfo: ActivePatternInfo) index = + debug.WriteActivePatternCase apInfo index + writeString ItemKeyTags.itemActivePattern match apInfo.ActiveTagsWithRanges with @@ -474,6 +585,7 @@ and [] ItemKeyStoreBuilder() = let postCount = b.Count fixup.WriteInt32(postCount - preCount) + debug.FinishItem(item, postCount - preCount) member _.TryBuildAndReset() = if b.Count > 0 then @@ -495,7 +607,10 @@ and [] ItemKeyStoreBuilder() = b.Clear() - Some(new ItemKeyStore(mmf, length)) + let result = Some(new ItemKeyStore(mmf, length, tcGlobals, debug.Items)) + debug <- debug.New() + result else b.Clear() + debug <- debug.New() None diff --git a/src/Compiler/Service/ItemKey.fsi b/src/Compiler/Service/ItemKey.fsi index aac62b5f27d..11d99e5c00f 100644 --- a/src/Compiler/Service/ItemKey.fsi +++ b/src/Compiler/Service/ItemKey.fsi @@ -5,6 +5,7 @@ namespace FSharp.Compiler.CodeAnalysis open System open FSharp.Compiler.NameResolution open FSharp.Compiler.Text +open FSharp.Compiler.TcGlobals /// Stores a list of item key strings and their ranges in a memory mapped file. [] @@ -17,7 +18,7 @@ type internal ItemKeyStore = [] type internal ItemKeyStoreBuilder = - new: unit -> ItemKeyStoreBuilder + new: TcGlobals -> ItemKeyStoreBuilder member Write: range * Item -> unit diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 1492cf97d2d..5063db40fef 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -533,71 +533,70 @@ match 2 with | Even -> () | Odd -> () module Interfaces = - [] - let ``We find all references to interface methods`` () = - - let source = """ + let project() = + let source1 = """ type IInterface1 = - abstract member Method1 : int + abstract member Property1 : int + abstract member Method1: unit -> int + abstract member Method1: string -> int type IInterface2 = - abstract member Method2 : int - + abstract member Property2 : int + """ + let source2 = """ +open ModuleFirst type internal SomeType() = interface IInterface1 with - member _.Method1 = - 42 + member _.Property1 = 42 + member _.Method1() = 43 + member _.Method1(foo) = 43 interface IInterface2 with - member this.Method2 = - (this :> IInterface1).Method1 + member this.Property2 = + (this :> IInterface1).Property1 """ - SyntheticProject.Create( { sourceFile "Program" [] with Source = source } ).Workflow { - placeCursor "Program" "Method1" - findAllReferences (expectToFind [ - "FileProgram.fs", 4, 20, 27 - "FileProgram.fs", 12, 17, 24 - "FileProgram.fs", 17, 12, 41 // Not sure why we get the whole range here, but it seems to work fine. - ]) - } + SyntheticProject.Create( + { sourceFile "First" [] with Source = source1 }, + { sourceFile "Second" [] with Source = source2 } ) - [] - let ``We find all references to interface methods starting from implementation`` () = - - let source1 = """ -type IInterface1 = - abstract member Method1 : int - -type IInterface2 = - abstract member Method2 : int - """ + let property1Locations() = [ + "FileFirst.fs", 4, 20, 29 + "FileSecond.fs", 7, 17, 26 + "FileSecond.fs", 13, 12, 43 // Not sure why we get the whole range here, but it seems to work fine. + ] - let source2 = """ -open ModuleFirst + let method1Locations() = [ + "FileFirst.fs", 5, 20, 27 + "FileSecond.fs", 8, 17, 24 + ] -type internal SomeType() = + [] + let ``We find all references to interface properties`` () = + project().Workflow { + placeCursor "First" "Property1" + findAllReferences (expectToFind <| property1Locations()) + } - interface IInterface1 with - member _.Method1 = - 42 + [] + let ``We find all references to interface properties starting from implementation`` () = + project().Workflow { + placeCursor "Second" "Property1" + findAllReferences (expectToFind <| property1Locations()) + } - interface IInterface2 with - member this.Method2 = - (this :> IInterface1).Method1 - """ + [] + let ``We find all references to interface methods`` () = + project().Workflow { + placeCursor "First" "Method1" + findAllReferences (expectToFind <| method1Locations()) + } - SyntheticProject.Create( - { sourceFile "First" [] with Source = source1 }, - { sourceFile "Second" [] with Source = source2 } - ).Workflow { + [] + let ``We find all references to interface methods starting from implementation`` () = + project().Workflow { placeCursor "Second" "Method1" - findAllReferences (expectToFind [ - "FileFirst.fs", 4, 20, 27 - "FileSecond.fs", 8, 17, 24 - "FileSecond.fs", 13, 12, 41 // Not sure why we get the whole range here, but it seems to work fine. - ]) + findAllReferences (expectToFind <| method1Locations()) } -