From f85322440db3bd21b43cfd66287931576bce4afb Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 7 Sep 2023 19:09:49 +0200 Subject: [PATCH 1/5] wip --- src/Compiler/Service/ItemKey.fs | 68 ++++++++++++- .../FSharpChecker/FindReferences.fs | 98 +++++++++---------- 2 files changed, 113 insertions(+), 53 deletions(-) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index ce1d84d531c..b968f3c2c4c 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -16,6 +16,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.TypedTreeOps #nowarn "9" #nowarn "51" @@ -97,7 +98,7 @@ module ItemKeyTags = let parameters = "p$p$" [] -type ItemKeyStore(mmf: MemoryMappedFile, length) = +type ItemKeyStore(mmf: MemoryMappedFile, length, debugStore) = let rangeBuffer = Array.zeroCreate sizeof @@ -107,6 +108,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] @@ -170,6 +173,36 @@ and [] ItemKeyStoreBuilder() = let b = BlobBuilder() + let mutable debugStore = ResizeArray() + let mutable debugCurrentItem = ResizeArray() + + let debugWriteRange(m: range) = + debugCurrentItem.Add("range", $"{m}") + + let debugWriteEntityRef (eref: EntityRef) = + debugCurrentItem.Add("EntityRef", $"{eref}") + + let debugWriteILType (ilTy: ILType) = + debugCurrentItem.Add("ILType", $"%A{ilTy}") + + let debugWriteType isStandalone (ty: TType) = + debugCurrentItem.Add("Type", $"{isStandalone} %A{ty}") + + let debugWriteMeasure isStandalone (ms: Measure) = + debugCurrentItem.Add("Measure", $"{isStandalone} %A{ms}") + + let debugWriteTypar (isStandalone: bool) (typar: Typar) = + debugCurrentItem.Add("Typar", $"{isStandalone} %A{typar}") + + let debugWriteValRef (vref: ValRef) = + debugCurrentItem.Add("ValRef", $"{vref}") + + let debugWriteValue (vref: ValRef) = + debugCurrentItem.Add("Value", $"{vref}") + + let debugWriteActivePatternCase (apInfo: ActivePatternInfo) index = + debugCurrentItem.Add("ActivePatternCase", $"{apInfo} {index}") + let writeChar (c: char) = b.WriteUInt16(uint16 c) let writeUInt16 (i: uint16) = b.WriteUInt16 i @@ -181,16 +214,19 @@ and [] ItemKeyStoreBuilder() = let writeString (str: string) = b.WriteUTF16 str let writeRange (m: range) = + debugWriteRange m let mutable m = m let ptr = &&m |> NativePtr.toNativeInt |> NativePtr.ofNativeInt b.WriteBytes(ptr, sizeof) let writeEntityRef (eref: EntityRef) = + debugWriteEntityRef eref writeString ItemKeyTags.entityRef writeString eref.CompiledName eref.CompilationPath.MangledPath |> List.iter (fun str -> writeString str) let rec writeILType (ilTy: ILType) = + debugWriteILType ilTy match ilTy with | ILType.TypeVar n -> writeString "!" @@ -231,6 +267,7 @@ and [] ItemKeyStoreBuilder() = writeILType mref.ReturnType let rec writeType isStandalone (ty: TType) = + debugWriteType isStandalone ty match stripTyparEqns ty with | TType_forall (_, ty) -> writeType false ty @@ -268,6 +305,7 @@ and [] ItemKeyStoreBuilder() = writeString nm and writeMeasure isStandalone (ms: Measure) = + debugWriteMeasure isStandalone ms match ms with | Measure.Var typar -> writeString ItemKeyTags.typeMeasureVar @@ -278,6 +316,7 @@ and [] ItemKeyStoreBuilder() = | _ -> () and writeTypar (isStandalone: bool) (typar: Typar) = + debugWriteTypar isStandalone typar match typar.Solution with | Some ty -> writeType isStandalone ty | _ -> @@ -285,13 +324,25 @@ and [] ItemKeyStoreBuilder() = writeInt64 typar.Stamp let writeValRef (vref: ValRef) = + debugWriteValRef 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 + + if vref.IsInstanceMember && isFunTy vref.Type then + let _domainTy, rangeTy = destFunTy vref.Type + writeType false rangeTy + else + writeType false vref.Type + | _ -> writeString ItemKeyTags.itemValue writeString vref.LogicalName @@ -307,6 +358,8 @@ and [] ItemKeyStoreBuilder() = | Parent eref -> writeEntityRef eref let writeValue (vref: ValRef) = + debugWriteValue vref + if vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then writeString ItemKeyTags.itemProperty writeString vref.PropertyName @@ -322,6 +375,8 @@ and [] ItemKeyStoreBuilder() = writeValRef vref let writeActivePatternCase (apInfo: ActivePatternInfo) index = + debugWriteActivePatternCase apInfo index + writeString ItemKeyTags.itemActivePattern match apInfo.ActiveTagsWithRanges with @@ -474,6 +529,8 @@ and [] ItemKeyStoreBuilder() = let postCount = b.Count fixup.WriteInt32(postCount - preCount) + debugStore.Add(item, debugCurrentItem) + debugCurrentItem <- ResizeArray() member _.TryBuildAndReset() = if b.Count > 0 then @@ -495,7 +552,10 @@ and [] ItemKeyStoreBuilder() = b.Clear() - Some(new ItemKeyStore(mmf, length)) + let result = Some(new ItemKeyStore(mmf, length, debugStore)) + debugStore <- ResizeArray() + result else b.Clear() + debugStore <- ResizeArray() None diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 1492cf97d2d..6a52c397d0d 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -533,71 +533,71 @@ 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", 12, 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", 4, 20, 29 + "FileSecond.fs", 7, 17, 26 + "FileSecond.fs", 12, 12, 43 + ] -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()) } - From e8627486d5a07eafa9898044c141cddb0e6b8b18 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Fri, 8 Sep 2023 14:20:35 +0200 Subject: [PATCH 2/5] fixed --- src/Compiler/Service/IncrementalBuild.fs | 2 +- src/Compiler/Service/ItemKey.fs | 155 ++++++++++++------ src/Compiler/Service/ItemKey.fsi | 3 +- .../FSharpChecker/FindReferences.fs | 9 +- 4 files changed, 109 insertions(+), 60 deletions(-) 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 b968f3c2c4c..43dbdb6f14d 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -17,6 +17,7 @@ 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" @@ -97,8 +98,75 @@ module ItemKeyTags = [] let parameters = "p$p$" +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() + +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 + [] -type ItemKeyStore(mmf: MemoryMappedFile, length, debugStore) = +type ItemKeyStore(mmf: MemoryMappedFile, length, tcGlobals, debugStore) = let rangeBuffer = Array.zeroCreate sizeof @@ -136,7 +204,7 @@ type ItemKeyStore(mmf: MemoryMappedFile, length, debugStore) = member this.FindAll(item: Item) = checkDispose () - let builder = ItemKeyStoreBuilder() + let builder = ItemKeyStoreBuilder(tcGlobals) builder.Write(range0, item) match builder.TryBuildAndReset() with @@ -169,39 +237,12 @@ type ItemKeyStore(mmf: MemoryMappedFile, length, debugStore) = isDisposed <- true mmf.Dispose() -and [] ItemKeyStoreBuilder() = +and [] ItemKeyStoreBuilder(tcGlobals: TcGlobals) = let b = BlobBuilder() - let mutable debugStore = ResizeArray() - let mutable debugCurrentItem = ResizeArray() - - let debugWriteRange(m: range) = - debugCurrentItem.Add("range", $"{m}") - - let debugWriteEntityRef (eref: EntityRef) = - debugCurrentItem.Add("EntityRef", $"{eref}") - - let debugWriteILType (ilTy: ILType) = - debugCurrentItem.Add("ILType", $"%A{ilTy}") - - let debugWriteType isStandalone (ty: TType) = - debugCurrentItem.Add("Type", $"{isStandalone} %A{ty}") - - let debugWriteMeasure isStandalone (ms: Measure) = - debugCurrentItem.Add("Measure", $"{isStandalone} %A{ms}") - - let debugWriteTypar (isStandalone: bool) (typar: Typar) = - debugCurrentItem.Add("Typar", $"{isStandalone} %A{typar}") - - let debugWriteValRef (vref: ValRef) = - debugCurrentItem.Add("ValRef", $"{vref}") - - let debugWriteValue (vref: ValRef) = - debugCurrentItem.Add("Value", $"{vref}") - - let debugWriteActivePatternCase (apInfo: ActivePatternInfo) index = - debugCurrentItem.Add("ActivePatternCase", $"{apInfo} {index}") + // Change this to DebugKeyStore() for debugging (DebugStore will be available on ItemKeyStore) + let mutable debug = DebugKeyStoreNoop() let writeChar (c: char) = b.WriteUInt16(uint16 c) @@ -214,19 +255,20 @@ and [] ItemKeyStoreBuilder() = let writeString (str: string) = b.WriteUTF16 str let writeRange (m: range) = - debugWriteRange m + debug.WriteRange m let mutable m = m let ptr = &&m |> NativePtr.toNativeInt |> NativePtr.ofNativeInt b.WriteBytes(ptr, sizeof) let writeEntityRef (eref: EntityRef) = - debugWriteEntityRef eref + debug.WriteEntityRef eref writeString ItemKeyTags.entityRef writeString eref.CompiledName eref.CompilationPath.MangledPath |> List.iter (fun str -> writeString str) let rec writeILType (ilTy: ILType) = - debugWriteILType ilTy + debug.WriteILType ilTy + match ilTy with | ILType.TypeVar n -> writeString "!" @@ -267,7 +309,8 @@ and [] ItemKeyStoreBuilder() = writeILType mref.ReturnType let rec writeType isStandalone (ty: TType) = - debugWriteType isStandalone ty + debug.WriteType isStandalone ty + match stripTyparEqns ty with | TType_forall (_, ty) -> writeType false ty @@ -305,7 +348,8 @@ and [] ItemKeyStoreBuilder() = writeString nm and writeMeasure isStandalone (ms: Measure) = - debugWriteMeasure isStandalone ms + debug.WriteMeasure isStandalone ms + match ms with | Measure.Var typar -> writeString ItemKeyTags.typeMeasureVar @@ -316,7 +360,8 @@ and [] ItemKeyStoreBuilder() = | _ -> () and writeTypar (isStandalone: bool) (typar: Typar) = - debugWriteTypar isStandalone typar + debug.WriteTypar isStandalone typar + match typar.Solution with | Some ty -> writeType isStandalone ty | _ -> @@ -324,24 +369,29 @@ and [] ItemKeyStoreBuilder() = writeInt64 typar.Stamp let writeValRef (vref: ValRef) = - debugWriteValRef vref + debug.WriteValRef vref + match vref.MemberInfo with | Some memberInfo -> writeString ItemKeyTags.itemValueMember match vref.IsOverrideOrExplicitImpl, vref.MemberInfo with - | true, Some { ImplementedSlotSigs = slotSig :: _tail } -> slotSig.DeclaringType |> writeType false - | _ -> - writeEntityRef memberInfo.ApparentEnclosingEntity + | true, + Some { + ImplementedSlotSigs = slotSig :: _tail + } -> slotSig.DeclaringType |> writeType false + | _ -> writeEntityRef memberInfo.ApparentEnclosingEntity writeString vref.LogicalName writeString ItemKeyTags.parameters - if vref.IsInstanceMember && isFunTy vref.Type then - let _domainTy, rangeTy = destFunTy vref.Type - writeType false rangeTy + if vref.IsInstanceMember && isFunTy tcGlobals vref.Type then + // 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. + destFunTy tcGlobals vref.Type |> snd else - writeType false vref.Type + vref.Type + |> writeType false | _ -> writeString ItemKeyTags.itemValue @@ -358,7 +408,7 @@ and [] ItemKeyStoreBuilder() = | Parent eref -> writeEntityRef eref let writeValue (vref: ValRef) = - debugWriteValue vref + debug.WriteValue vref if vref.IsPropertyGetterMethod || vref.IsPropertySetterMethod then writeString ItemKeyTags.itemProperty @@ -375,7 +425,7 @@ and [] ItemKeyStoreBuilder() = writeValRef vref let writeActivePatternCase (apInfo: ActivePatternInfo) index = - debugWriteActivePatternCase apInfo index + debug.WriteActivePatternCase apInfo index writeString ItemKeyTags.itemActivePattern @@ -529,8 +579,7 @@ and [] ItemKeyStoreBuilder() = let postCount = b.Count fixup.WriteInt32(postCount - preCount) - debugStore.Add(item, debugCurrentItem) - debugCurrentItem <- ResizeArray() + debug.FinishItem(item, postCount - preCount) member _.TryBuildAndReset() = if b.Count > 0 then @@ -552,10 +601,10 @@ and [] ItemKeyStoreBuilder() = b.Clear() - let result = Some(new ItemKeyStore(mmf, length, debugStore)) - debugStore <- ResizeArray() + let result = Some(new ItemKeyStore(mmf, length, tcGlobals, debug.Items)) + debug <- debug.New() result else b.Clear() - debugStore <- ResizeArray() + 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 6a52c397d0d..5063db40fef 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -533,7 +533,7 @@ match 2 with | Even -> () | Odd -> () module Interfaces = - let project() = + let project() = let source1 = """ type IInterface1 = abstract member Property1 : int @@ -564,13 +564,12 @@ type internal SomeType() = let property1Locations() = [ "FileFirst.fs", 4, 20, 29 "FileSecond.fs", 7, 17, 26 - "FileSecond.fs", 12, 12, 43 // Not sure why we get the whole range here, but it seems to work fine. + "FileSecond.fs", 13, 12, 43 // Not sure why we get the whole range here, but it seems to work fine. ] let method1Locations() = [ - "FileFirst.fs", 4, 20, 29 - "FileSecond.fs", 7, 17, 26 - "FileSecond.fs", 12, 12, 43 + "FileFirst.fs", 5, 20, 27 + "FileSecond.fs", 8, 17, 24 ] [] From 0bedc658eff27ce7f8c27dd6d125ec314201f813 Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Fri, 8 Sep 2023 14:35:10 +0200 Subject: [PATCH 3/5] comment --- src/Compiler/Service/ItemKey.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 43dbdb6f14d..d5f244c7743 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -98,6 +98,7 @@ module ItemKeyTags = [] let parameters = "p$p$" +/// 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() @@ -139,6 +140,7 @@ type DebugKeyStore() = member _.New() = DebugKeyStore() +/// A replacement for DebugKeyStore for when we're not debugging. type DebugKeyStoreNoop() = member inline _.Items = Unchecked.defaultof<_> From 68dedfc4d9c86494aa9772091f087b3cb00fe4a7 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 12 Sep 2023 14:07:19 +0200 Subject: [PATCH 4/5] tryDestFunTy instead of DestFunTy --- src/Compiler/Service/ItemKey.fs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index d5f244c7743..0cca167ba11 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -387,12 +387,11 @@ and [] ItemKeyStoreBuilder(tcGlobals: TcGlobals) = writeString vref.LogicalName writeString ItemKeyTags.parameters - if vref.IsInstanceMember && isFunTy tcGlobals vref.Type then - // 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. - destFunTy tcGlobals vref.Type |> snd - else - 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 | _ -> From 72c6b06f8abb62cf21e462dedcabf4bf93ba6082 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 12 Sep 2023 14:16:38 +0200 Subject: [PATCH 5/5] Single instance of DebugKeyStoreNoop --- src/Compiler/Service/ItemKey.fs | 91 +++++++++++++++++---------------- 1 file changed, 48 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 0cca167ba11..c44fc6401d2 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -98,74 +98,79 @@ module ItemKeyTags = [] let parameters = "p$p$" -/// A debugging tool to show what's being written into the ItemKeyStore in a more human readable way in the debugger. -type DebugKeyStore() = +[] +module DebugKeyStore = - let mutable debugCurrentItem = ResizeArray() + /// A debugging tool to show what's being written into the ItemKeyStore in a more human readable way in the debugger. + type DebugKeyStore() = - member val Items = ResizeArray() + let mutable debugCurrentItem = ResizeArray() - member _.WriteRange(m: range) = debugCurrentItem.Add("range", $"{m}") + member val Items = ResizeArray() - member _.WriteEntityRef(eref: EntityRef) = - debugCurrentItem.Add("EntityRef", $"{eref}") + member _.WriteRange(m: range) = debugCurrentItem.Add("range", $"{m}") - member _.WriteILType(ilTy: ILType) = - debugCurrentItem.Add("ILType", $"%A{ilTy}") + member _.WriteEntityRef(eref: EntityRef) = + debugCurrentItem.Add("EntityRef", $"{eref}") - member _.WriteType isStandalone (ty: TType) = - debugCurrentItem.Add("Type", $"{isStandalone} %A{ty}") + member _.WriteILType(ilTy: ILType) = + debugCurrentItem.Add("ILType", $"%A{ilTy}") - member _.WriteMeasure isStandalone (ms: Measure) = - debugCurrentItem.Add("Measure", $"{isStandalone} %A{ms}") + member _.WriteType isStandalone (ty: TType) = + debugCurrentItem.Add("Type", $"{isStandalone} %A{ty}") - member _.WriteTypar (isStandalone: bool) (typar: Typar) = - debugCurrentItem.Add("Typar", $"{isStandalone} %A{typar}") + member _.WriteMeasure isStandalone (ms: Measure) = + debugCurrentItem.Add("Measure", $"{isStandalone} %A{ms}") - member _.WriteValRef(vref: ValRef) = - debugCurrentItem.Add("ValRef", $"{vref}") + member _.WriteTypar (isStandalone: bool) (typar: Typar) = + debugCurrentItem.Add("Typar", $"{isStandalone} %A{typar}") - member _.WriteValue(vref: ValRef) = - debugCurrentItem.Add("Value", $"{vref}") + member _.WriteValRef(vref: ValRef) = + debugCurrentItem.Add("ValRef", $"{vref}") - member _.WriteActivePatternCase (apInfo: ActivePatternInfo) index = - debugCurrentItem.Add("ActivePatternCase", $"{apInfo} {index}") + member _.WriteValue(vref: ValRef) = + debugCurrentItem.Add("Value", $"{vref}") - 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 _.WriteActivePatternCase (apInfo: ActivePatternInfo) index = + debugCurrentItem.Add("ActivePatternCase", $"{apInfo} {index}") - member _.New() = DebugKeyStore() + member this.FinishItem(item, length) = + debugCurrentItem.Add("length", $"{length}") + this.Items.Add(item, debugCurrentItem) + let itemCount = this.Items.Count + assert (itemCount > 0) + debugCurrentItem <- ResizeArray() -/// A replacement for DebugKeyStore for when we're not debugging. -type DebugKeyStoreNoop() = + member _.New() = DebugKeyStore() - member inline _.Items = Unchecked.defaultof<_> + /// A replacement for DebugKeyStore for when we're not debugging. + type _DebugKeyStoreNoop() = - member inline _.WriteRange(_m: range) = () + member inline _.Items = Unchecked.defaultof<_> - member inline _.WriteEntityRef(_eref: EntityRef) = () + member inline _.WriteRange(_m: range) = () - member inline _.WriteILType(_ilTy: ILType) = () + member inline _.WriteEntityRef(_eref: EntityRef) = () - member inline _.WriteType _isStandalone (_ty: TType) = () + member inline _.WriteILType(_ilTy: ILType) = () - member inline _.WriteMeasure _isStandalone (_ms: Measure) = () + member inline _.WriteType _isStandalone (_ty: TType) = () - member inline _.WriteTypar (_isStandalone: bool) (_typar: Typar) = () + member inline _.WriteMeasure _isStandalone (_ms: Measure) = () - member inline _.WriteValRef(_vref: ValRef) = () + member inline _.WriteTypar (_isStandalone: bool) (_typar: Typar) = () - member inline _.WriteValue(_vref: ValRef) = () + member inline _.WriteValRef(_vref: ValRef) = () - member inline _.WriteActivePatternCase (_apInfo: ActivePatternInfo) _index = () + member inline _.WriteValue(_vref: ValRef) = () - member inline _.FinishItem(_item, _length) = () + member inline _.WriteActivePatternCase (_apInfo: ActivePatternInfo) _index = () - member inline this.New() = this + member inline _.FinishItem(_item, _length) = () + + member inline this.New() = this + + let DebugKeyStoreNoop = _DebugKeyStoreNoop () [] type ItemKeyStore(mmf: MemoryMappedFile, length, tcGlobals, debugStore) = @@ -244,7 +249,7 @@ and [] ItemKeyStoreBuilder(tcGlobals: TcGlobals) = let b = BlobBuilder() // Change this to DebugKeyStore() for debugging (DebugStore will be available on ItemKeyStore) - let mutable debug = DebugKeyStoreNoop() + let mutable debug = DebugKeyStoreNoop let writeChar (c: char) = b.WriteUInt16(uint16 c)