From cf54d92fab8df8db3135f1f85c1c683069770d90 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sat, 17 Jun 2023 10:34:03 +0100 Subject: [PATCH 01/10] Avoid checking the same filenames for every graph node. --- .../GraphChecking/DependencyResolution.fs | 43 ++++++++++--------- 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index b30d9753592..0dee4fc1230 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -180,6 +180,23 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP else FileContentMapping.mkFileContent file) + // Files in FSharp.Core have an implicit dependency on `prim-types-prelude.fsi` - add it. + let fsharpCoreImplicitDependency = + let filename = "prim-types-prelude.fsi" + + let implicitDepIdx = + files + |> Array.tryFindIndex (fun f -> FileSystemUtils.fileNameOfPath f.FileName = filename) + + if compilingFSharpCore then + match implicitDepIdx with + | Some idx -> Some idx + | None -> + exn $"Expected to find file '{filename}' during compilation of FSharp.Core, but it was not found." + |> raise + else + None + let findDependencies (file: FileInProject) : FileIndex array = if file.Idx = 0 then // First file cannot have any dependencies. @@ -208,31 +225,17 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP | None -> Array.empty | Some sigIdx -> Array.singleton sigIdx - // Files in FSharp.Core have an implicit dependency on `prim-types-prelude.fsi` - add it. - let fsharpCoreImplicitDependencies = - let filename = "prim-types-prelude.fsi" - - let implicitDepIdx = - files - |> Array.tryFindIndex (fun f -> FileSystemUtils.fileNameOfPath f.FileName = filename) - - [| - if compilingFSharpCore then - match implicitDepIdx with - | Some idx -> - if file.Idx > idx then - yield idx - | None -> - exn $"Expected to find file '{filename}' during compilation of FSharp.Core, but it was not found." - |> raise - |] - + let fsharpCoreImplicitDependencyForThisFile = + match fsharpCoreImplicitDependency with + | Some depIdx when file.Idx > depIdx -> [|depIdx|] + | _ -> [||] + let allDependencies = [| yield! depsResult.FoundDependencies yield! ghostDependencies yield! signatureDependency - yield! fsharpCoreImplicitDependencies + yield! fsharpCoreImplicitDependencyForThisFile |] |> Array.distinct From dbc1fdcb6313877ceebf875f1e4497ec89bc95b0 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sat, 17 Jun 2023 13:33:47 +0100 Subject: [PATCH 02/10] WIP * Avoid duplicate filename creation * use concatenated identifier segments for memoization --- .../GraphChecking/DependencyResolution.fs | 56 ++++++++++++------- .../GraphChecking/FileContentMapping.fs | 8 ++- .../GraphChecking/FileContentMapping.fsi | 4 +- src/Compiler/Driver/GraphChecking/Types.fs | 25 +++++++++ src/Compiler/Driver/GraphChecking/Types.fsi | 18 ++++++ 5 files changed, 87 insertions(+), 24 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index 0dee4fc1230..03c9fa7dcb9 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -1,22 +1,26 @@ module internal FSharp.Compiler.GraphChecking.DependencyResolution +open System +open System.Collections.Concurrent +open System.Collections.Generic +open System.Runtime.CompilerServices open FSharp.Compiler.IO open FSharp.Compiler.Syntax +open Internal.Utilities.Library /// Find a path in the Trie. /// This function could be cached in future if performance is an issue. +[] let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = let rec visit (currentNode: TrieNode) (path: LongIdentifier) = match path with - | [] -> failwith "path should not be empty" - | [ lastNodeFromPath ] -> - match currentNode.Children.TryGetValue(lastNodeFromPath) with - | false, _ -> QueryTrieNodeResult.NodeDoesNotExist - | true, childNode -> - if Set.isEmpty childNode.Files then - QueryTrieNodeResult.NodeDoesNotExposeData - else - QueryTrieNodeResult.NodeExposesData(childNode.Files) + // When we get through all partial identifiers, we've reached the node the full path points to. + | [] -> + if Set.isEmpty currentNode.Files then + QueryTrieNodeResult.NodeDoesNotExposeData + else + QueryTrieNodeResult.NodeExposesData(currentNode.Files) + // More segments to get through | currentPath :: restPath -> match currentNode.Children.TryGetValue(currentPath) with | false, _ -> QueryTrieNodeResult.NodeDoesNotExist @@ -24,8 +28,22 @@ let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = visit trie path +[] let queryTrieMemoized (trie: TrieNode) : QueryTrie = - Internal.Utilities.Library.Tables.memoize (queryTrie trie) + + let queryTrie = queryTrie trie + + // Here we use concatenated identifier segments as cache keys for faster GetHashCode and Equals + let cache = ConcurrentDictionary(Environment.ProcessorCount, capacity=1000) + + fun (id : LongIdentifier) -> + let str = id |> LongIdentifier.toSingleString + match cache.TryGetValue str with + | true, res -> res + | _ -> + let res = queryTrie id + cache[str] <- res + res /// Process namespace declaration. let processNamespaceDeclaration (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = @@ -74,7 +92,7 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) // Both cases need to be processed. let stateAfterFullOpenPath = processOpenPath queryTrie path state - // Any existing open statement could be extended with the current path (if that node where to exists in the trie) + // Any existing open statement could be extended with the current path (if that node were to exists in the trie) // The extended path could add a new link (in case of a module or namespace with types) // It might also not add anything at all (in case it the extended path is still a partial one) (stateAfterFullOpenPath, state.OpenNamespaces) @@ -90,12 +108,10 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) (state, [| 1 .. path.Length |]) ||> Array.fold (fun state takeParts -> let path = List.take takeParts path - // process the name was if it were a FQN - let stateAfterFullIdentifier = processIdentifier queryTrie path state - - // Process the name in combination with the existing open namespaces - (stateAfterFullIdentifier, state.OpenNamespaces) - ||> Set.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc)) + // Process the name as a FQN and in combination with existing open namespaces + let openNamespaces = seq { yield []; yield! state.OpenNamespaces} + (state, openNamespaces) + ||> Seq.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc)) | FileContentEntry.NestedModule (nestedContent = nestedContent) -> // We don't want our current state to be affect by any open statements in the nested module @@ -176,7 +192,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP files |> Array.Parallel.map (fun file -> if file.Idx = 0 then - List.empty + ImmutableArray.empty else FileContentMapping.mkFileContent file) @@ -204,7 +220,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP else let fileContent = fileContents[file.Idx] - let knownFiles = [ 0 .. (file.Idx - 1) ] |> set + let knownFiles = [| 0 .. (file.Idx - 1) |] |> set // File depends on all files above it that define accessible symbols at the root level (global namespace). let filesFromRoot = trie.Files |> Set.filter (fun rootIdx -> rootIdx < file.Idx) // Start by listing root-level dependencies. @@ -214,7 +230,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP let depsResult = initialDepsResult // Seq is faster than List in this case. - ||> Seq.fold (processStateEntry queryTrie) + ||> ImmutableArray.fold (processStateEntry queryTrie) // Add missing links for cases where an unused open namespace did not create a link. let ghostDependencies = collectGhostDependencies file.Idx trie queryTrie depsResult diff --git a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs index b0b44e941fb..c5c0a1fe96a 100644 --- a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs +++ b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs @@ -1,5 +1,6 @@ module internal rec FSharp.Compiler.GraphChecking.FileContentMapping +open System.Collections.Immutable open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps @@ -617,8 +618,8 @@ let visitSynMemberSig (ms: SynMemberSig) : FileContentEntry list = | SynMemberSig.ValField (field, _) -> visitSynField field | SynMemberSig.NestedType _ -> [] -let mkFileContent (f: FileInProject) : FileContentEntry list = - [ +let mkFileContent (f: FileInProject) : ImmutableArray = + [| match f.ParsedInput with | ParsedInput.SigFile (ParsedSigFileInput (contents = contents)) -> for SynModuleOrNamespaceSig (longId = longId; kind = kind; decls = decls; attribs = attribs) in contents do @@ -646,4 +647,5 @@ let mkFileContent (f: FileInProject) : FileContentEntry list = | SynModuleOrNamespaceKind.NamedModule -> let path = longIdentToPath true longId yield FileContentEntry.TopLevelNamespace(path, List.collect visitSynModuleDecl decls) - ] + |] + |> ImmutableArray.CreateRange diff --git a/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi b/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi index d5ef03867b5..257af3a1feb 100644 --- a/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi +++ b/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi @@ -1,4 +1,6 @@ module internal rec FSharp.Compiler.GraphChecking.FileContentMapping +open System.Collections.Immutable + /// Extract the FileContentEntries from the ParsedInput of a file. -val mkFileContent: f: FileInProject -> FileContentEntry list +val mkFileContent: f: FileInProject -> ImmutableArray diff --git a/src/Compiler/Driver/GraphChecking/Types.fs b/src/Compiler/Driver/GraphChecking/Types.fs index c0e8e0f84b1..3d1b6fc0bb3 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fs +++ b/src/Compiler/Driver/GraphChecking/Types.fs @@ -1,6 +1,8 @@ namespace FSharp.Compiler.GraphChecking +open System open System.Collections.Generic +open System.Runtime.CompilerServices open FSharp.Compiler.Syntax /// The index of a file inside a project. @@ -17,6 +19,26 @@ type internal Identifier = string /// For example, `[ "X"; "Y"; "Z" ]` in `open X.Y.Z` type internal LongIdentifier = string list +module LongIdentifier = + let toSingleString (id : LongIdentifier) : string = String.Join(".", id) + +[] +type internal LongIdentifier2 = + | LongIdentifier2 of string[] + + [] + member private this.GetValue() = match this with LongIdentifier2 path -> path + member this.Value with get() = this.GetValue() + + [] + member private this.GetLength() = this.GetValue().Length + member this.Length = this.GetLength() + + member this.ToOld() = this.GetValue() |> Array.toList + + static member Create(id : LongIdentifier) = LongIdentifier2 (id |> List.toArray) + static member Create(id : string[]) = LongIdentifier2 id + /// Combines the file name, index and parsed syntax tree of a file in a project. type internal FileInProject = { @@ -133,7 +155,10 @@ type internal QueryTrieNodeResult = /// A node was found with one or more file links | NodeExposesData of Set +type internal LongIdentifierSpan = ReadOnlySpan + type internal QueryTrie = LongIdentifier -> QueryTrieNodeResult +type internal QueryTrie2 = LongIdentifierSpan -> QueryTrieNodeResult /// Helper class to help map signature files to implementation files and vice versa. type internal FilePairMap(files: FileInProject array) = diff --git a/src/Compiler/Driver/GraphChecking/Types.fsi b/src/Compiler/Driver/GraphChecking/Types.fsi index 7d0ba9bbdd5..4129f261ca3 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fsi +++ b/src/Compiler/Driver/GraphChecking/Types.fsi @@ -1,5 +1,6 @@ namespace FSharp.Compiler.GraphChecking +open System open System.Collections.Generic open FSharp.Compiler.Syntax @@ -17,6 +18,17 @@ type internal Identifier = string /// For example, `[ "X"; "Y"; "Z" ]` in `open X.Y.Z` type internal LongIdentifier = Identifier list +[] +type internal LongIdentifier2 = + private | LongIdentifier2 of string[] + + member Value : string[] + member Length : int + member ToOld : unit -> LongIdentifier + static member Create : LongIdentifier -> LongIdentifier2 + static member Create : string[] -> LongIdentifier2 + + /// Combines the file name, index and parsed syntax tree of a file in a project. type internal FileInProject = { Idx: FileIndex @@ -101,8 +113,14 @@ type internal QueryTrieNodeResult = /// A node was found with one or more files that contain relevant definitions required for type-checking. | NodeExposesData of Set +module LongIdentifier = + val toSingleString : LongIdentifier -> string + +type internal LongIdentifierSpan = ReadOnlySpan + /// A function for querying a Trie (the Trie is defined within the function's context) type internal QueryTrie = LongIdentifier -> QueryTrieNodeResult +type internal QueryTrie2 = LongIdentifierSpan -> QueryTrieNodeResult /// Helper class for mapping signature files to implementation files and vice versa. type internal FilePairMap = From ea30f96878ee6a476c2c982e46a432ae67e5cf0f Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 16:12:28 +0100 Subject: [PATCH 03/10] Revert most changes --- global.json | 4 +-- .../GraphChecking/DependencyResolution.fs | 33 ++++++------------- .../GraphChecking/FileContentMapping.fs | 8 ++--- .../GraphChecking/FileContentMapping.fsi | 4 +-- src/Compiler/Driver/GraphChecking/Types.fs | 25 -------------- src/Compiler/Driver/GraphChecking/Types.fsi | 18 ---------- 6 files changed, 16 insertions(+), 76 deletions(-) diff --git a/global.json b/global.json index 59f2a3742c5..b7b566d7112 100644 --- a/global.json +++ b/global.json @@ -1,11 +1,11 @@ { "sdk": { - "version": "7.0.203", + "version": "7.0.202", "allowPrerelease": true, "rollForward": "latestPatch" }, "tools": { - "dotnet": "7.0.203", + "dotnet": "7.0.202", "vs": { "version": "17.5", "components": ["Microsoft.VisualStudio.Component.FSharp"] diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index 03c9fa7dcb9..49df9d20db6 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -10,7 +10,6 @@ open Internal.Utilities.Library /// Find a path in the Trie. /// This function could be cached in future if performance is an issue. -[] let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = let rec visit (currentNode: TrieNode) (path: LongIdentifier) = match path with @@ -28,22 +27,8 @@ let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = visit trie path -[] let queryTrieMemoized (trie: TrieNode) : QueryTrie = - - let queryTrie = queryTrie trie - - // Here we use concatenated identifier segments as cache keys for faster GetHashCode and Equals - let cache = ConcurrentDictionary(Environment.ProcessorCount, capacity=1000) - - fun (id : LongIdentifier) -> - let str = id |> LongIdentifier.toSingleString - match cache.TryGetValue str with - | true, res -> res - | _ -> - let res = queryTrie id - cache[str] <- res - res + Internal.Utilities.Library.Tables.memoize (queryTrie trie) /// Process namespace declaration. let processNamespaceDeclaration (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = @@ -94,7 +79,7 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) // Any existing open statement could be extended with the current path (if that node were to exists in the trie) // The extended path could add a new link (in case of a module or namespace with types) - // It might also not add anything at all (in case it the extended path is still a partial one) + // It might also not add anything at all (in case the extended path is still a partial one) (stateAfterFullOpenPath, state.OpenNamespaces) ||> Set.fold (fun acc openNS -> processOpenPath queryTrie [ yield! openNS; yield! path ] acc) @@ -108,10 +93,12 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) (state, [| 1 .. path.Length |]) ||> Array.fold (fun state takeParts -> let path = List.take takeParts path - // Process the name as a FQN and in combination with existing open namespaces - let openNamespaces = seq { yield []; yield! state.OpenNamespaces} - (state, openNamespaces) - ||> Seq.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc)) + // process the name was if it were a FQN + let stateAfterFullIdentifier = processIdentifier queryTrie path state + + // Process the name in combination with the existing open namespaces + (stateAfterFullIdentifier, state.OpenNamespaces) + ||> Set.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc)) | FileContentEntry.NestedModule (nestedContent = nestedContent) -> // We don't want our current state to be affect by any open statements in the nested module @@ -192,7 +179,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP files |> Array.Parallel.map (fun file -> if file.Idx = 0 then - ImmutableArray.empty + List.empty else FileContentMapping.mkFileContent file) @@ -230,7 +217,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP let depsResult = initialDepsResult // Seq is faster than List in this case. - ||> ImmutableArray.fold (processStateEntry queryTrie) + ||> Seq.fold (processStateEntry queryTrie) // Add missing links for cases where an unused open namespace did not create a link. let ghostDependencies = collectGhostDependencies file.Idx trie queryTrie depsResult diff --git a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs index c5c0a1fe96a..b0b44e941fb 100644 --- a/src/Compiler/Driver/GraphChecking/FileContentMapping.fs +++ b/src/Compiler/Driver/GraphChecking/FileContentMapping.fs @@ -1,6 +1,5 @@ module internal rec FSharp.Compiler.GraphChecking.FileContentMapping -open System.Collections.Immutable open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps @@ -618,8 +617,8 @@ let visitSynMemberSig (ms: SynMemberSig) : FileContentEntry list = | SynMemberSig.ValField (field, _) -> visitSynField field | SynMemberSig.NestedType _ -> [] -let mkFileContent (f: FileInProject) : ImmutableArray = - [| +let mkFileContent (f: FileInProject) : FileContentEntry list = + [ match f.ParsedInput with | ParsedInput.SigFile (ParsedSigFileInput (contents = contents)) -> for SynModuleOrNamespaceSig (longId = longId; kind = kind; decls = decls; attribs = attribs) in contents do @@ -647,5 +646,4 @@ let mkFileContent (f: FileInProject) : ImmutableArray = | SynModuleOrNamespaceKind.NamedModule -> let path = longIdentToPath true longId yield FileContentEntry.TopLevelNamespace(path, List.collect visitSynModuleDecl decls) - |] - |> ImmutableArray.CreateRange + ] diff --git a/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi b/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi index 257af3a1feb..d5ef03867b5 100644 --- a/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi +++ b/src/Compiler/Driver/GraphChecking/FileContentMapping.fsi @@ -1,6 +1,4 @@ module internal rec FSharp.Compiler.GraphChecking.FileContentMapping -open System.Collections.Immutable - /// Extract the FileContentEntries from the ParsedInput of a file. -val mkFileContent: f: FileInProject -> ImmutableArray +val mkFileContent: f: FileInProject -> FileContentEntry list diff --git a/src/Compiler/Driver/GraphChecking/Types.fs b/src/Compiler/Driver/GraphChecking/Types.fs index 3d1b6fc0bb3..c0e8e0f84b1 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fs +++ b/src/Compiler/Driver/GraphChecking/Types.fs @@ -1,8 +1,6 @@ namespace FSharp.Compiler.GraphChecking -open System open System.Collections.Generic -open System.Runtime.CompilerServices open FSharp.Compiler.Syntax /// The index of a file inside a project. @@ -19,26 +17,6 @@ type internal Identifier = string /// For example, `[ "X"; "Y"; "Z" ]` in `open X.Y.Z` type internal LongIdentifier = string list -module LongIdentifier = - let toSingleString (id : LongIdentifier) : string = String.Join(".", id) - -[] -type internal LongIdentifier2 = - | LongIdentifier2 of string[] - - [] - member private this.GetValue() = match this with LongIdentifier2 path -> path - member this.Value with get() = this.GetValue() - - [] - member private this.GetLength() = this.GetValue().Length - member this.Length = this.GetLength() - - member this.ToOld() = this.GetValue() |> Array.toList - - static member Create(id : LongIdentifier) = LongIdentifier2 (id |> List.toArray) - static member Create(id : string[]) = LongIdentifier2 id - /// Combines the file name, index and parsed syntax tree of a file in a project. type internal FileInProject = { @@ -155,10 +133,7 @@ type internal QueryTrieNodeResult = /// A node was found with one or more file links | NodeExposesData of Set -type internal LongIdentifierSpan = ReadOnlySpan - type internal QueryTrie = LongIdentifier -> QueryTrieNodeResult -type internal QueryTrie2 = LongIdentifierSpan -> QueryTrieNodeResult /// Helper class to help map signature files to implementation files and vice versa. type internal FilePairMap(files: FileInProject array) = diff --git a/src/Compiler/Driver/GraphChecking/Types.fsi b/src/Compiler/Driver/GraphChecking/Types.fsi index 4129f261ca3..7d0ba9bbdd5 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fsi +++ b/src/Compiler/Driver/GraphChecking/Types.fsi @@ -1,6 +1,5 @@ namespace FSharp.Compiler.GraphChecking -open System open System.Collections.Generic open FSharp.Compiler.Syntax @@ -18,17 +17,6 @@ type internal Identifier = string /// For example, `[ "X"; "Y"; "Z" ]` in `open X.Y.Z` type internal LongIdentifier = Identifier list -[] -type internal LongIdentifier2 = - private | LongIdentifier2 of string[] - - member Value : string[] - member Length : int - member ToOld : unit -> LongIdentifier - static member Create : LongIdentifier -> LongIdentifier2 - static member Create : string[] -> LongIdentifier2 - - /// Combines the file name, index and parsed syntax tree of a file in a project. type internal FileInProject = { Idx: FileIndex @@ -113,14 +101,8 @@ type internal QueryTrieNodeResult = /// A node was found with one or more files that contain relevant definitions required for type-checking. | NodeExposesData of Set -module LongIdentifier = - val toSingleString : LongIdentifier -> string - -type internal LongIdentifierSpan = ReadOnlySpan - /// A function for querying a Trie (the Trie is defined within the function's context) type internal QueryTrie = LongIdentifier -> QueryTrieNodeResult -type internal QueryTrie2 = LongIdentifierSpan -> QueryTrieNodeResult /// Helper class for mapping signature files to implementation files and vice versa. type internal FilePairMap = From a2784b93bd69b54da2f6fc97da8cdcf5c6cb86bf Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 16:17:08 +0100 Subject: [PATCH 04/10] Don't validate filepath --- global.json | 4 ++-- .../Driver/GraphChecking/DependencyResolution.fs | 16 ++++++---------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/global.json b/global.json index b7b566d7112..59f2a3742c5 100644 --- a/global.json +++ b/global.json @@ -1,11 +1,11 @@ { "sdk": { - "version": "7.0.202", + "version": "7.0.203", "allowPrerelease": true, "rollForward": "latestPatch" }, "tools": { - "dotnet": "7.0.202", + "dotnet": "7.0.203", "vs": { "version": "17.5", "components": ["Microsoft.VisualStudio.Component.FSharp"] diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index 49df9d20db6..e0a6a44f3ff 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -1,9 +1,5 @@ module internal FSharp.Compiler.GraphChecking.DependencyResolution -open System -open System.Collections.Concurrent -open System.Collections.Generic -open System.Runtime.CompilerServices open FSharp.Compiler.IO open FSharp.Compiler.Syntax open Internal.Utilities.Library @@ -185,13 +181,13 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP // Files in FSharp.Core have an implicit dependency on `prim-types-prelude.fsi` - add it. let fsharpCoreImplicitDependency = - let filename = "prim-types-prelude.fsi" - - let implicitDepIdx = - files - |> Array.tryFindIndex (fun f -> FileSystemUtils.fileNameOfPath f.FileName = filename) - if compilingFSharpCore then + let filename = "prim-types-prelude.fsi" + + let implicitDepIdx = + files + |> Array.tryFindIndex (fun f -> System.IO.Path.GetFileName(f.FileName) = filename) + match implicitDepIdx with | Some idx -> Some idx | None -> From 5b4e5ca82aa7f5b774aa5edd1cf08f5d4bdf0ae8 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 16:28:13 +0100 Subject: [PATCH 05/10] fantomas --- global.json | 4 +- src/Compiler/Driver/CompilerDiagnostics.fs | 288 ++++++++++++----- .../GraphChecking/DependencyResolution.fs | 8 +- src/Compiler/Service/ServiceNavigation.fs | 289 +++++++++++++++--- src/Compiler/Service/ServiceStructure.fs | 25 +- src/Compiler/Service/service.fs | 163 ++++++++-- 6 files changed, 631 insertions(+), 146 deletions(-) diff --git a/global.json b/global.json index 59f2a3742c5..b7b566d7112 100644 --- a/global.json +++ b/global.json @@ -1,11 +1,11 @@ { "sdk": { - "version": "7.0.203", + "version": "7.0.202", "allowPrerelease": true, "rollForward": "latestPatch" }, "tools": { - "dotnet": "7.0.203", + "dotnet": "7.0.202", "vs": { "version": "17.5", "components": ["Microsoft.VisualStudio.Component.FSharp"] diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 7e32d789119..6135b7cb8c6 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -439,23 +439,56 @@ module OldStyleMessages = do FSComp.SR.RunStartupValidation() let SeeAlsoE () = Message("SeeAlso", "%s") - let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") - let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") - let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") - let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") - let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") - let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") - let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") - let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") - let ErrorFromAddingTypeEquationTuplesE () = Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s") - let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") - let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") - let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") - let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") + + let ConstraintSolverTupleDiffLengthsE () = + Message("ConstraintSolverTupleDiffLengths", "%d%d") + + let ConstraintSolverInfiniteTypesE () = + Message("ConstraintSolverInfiniteTypes", "%s%s") + + let ConstraintSolverMissingConstraintE () = + Message("ConstraintSolverMissingConstraint", "%s") + + let ConstraintSolverTypesNotInEqualityRelation1E () = + Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") + + let ConstraintSolverTypesNotInEqualityRelation2E () = + Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") + + let ConstraintSolverTypesNotInSubsumptionRelationE () = + Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") + + let ErrorFromAddingTypeEquation1E () = + Message("ErrorFromAddingTypeEquation1", "%s%s%s") + + let ErrorFromAddingTypeEquation2E () = + Message("ErrorFromAddingTypeEquation2", "%s%s%s") + + let ErrorFromAddingTypeEquationTuplesE () = + Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s") + + let ErrorFromApplyingDefault1E () = + Message("ErrorFromApplyingDefault1", "%s") + + let ErrorFromApplyingDefault2E () = + Message("ErrorFromApplyingDefault2", "") + + let ErrorsFromAddingSubsumptionConstraintE () = + Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") + + let UpperCaseIdentifierInPatternE () = + Message("UpperCaseIdentifierInPattern", "") + let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") - let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") + + let NotUpperCaseConstructorWithoutRQAE () = + Message("NotUpperCaseConstructorWithoutRQA", "") + let FunctionExpectedE () = Message("FunctionExpected", "") - let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") + + let BakedInMemberConstraintNameE () = + Message("BakedInMemberConstraintName", "%s") + let BadEventTransformationE () = Message("BadEventTransformation", "") let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") @@ -467,13 +500,25 @@ module OldStyleMessages = let Duplicate2E () = Message("Duplicate2", "%s%s") let UndefinedName2E () = Message("UndefinedName2", "") let FieldNotMutableE () = Message("FieldNotMutable", "") - let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") + + let FieldsFromDifferentTypesE () = + Message("FieldsFromDifferentTypes", "%s%s") + let VarBoundTwiceE () = Message("VarBoundTwice", "%s") let RecursionE () = Message("Recursion", "%s%s%s%s") - let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") - let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") - let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") - let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") + + let InvalidRuntimeCoercionE () = + Message("InvalidRuntimeCoercion", "%s%s%s") + + let IndeterminateRuntimeCoercionE () = + Message("IndeterminateRuntimeCoercion", "%s%s") + + let IndeterminateStaticCoercionE () = + Message("IndeterminateStaticCoercion", "%s%s") + + let StaticCoercionShouldUseBoxE () = + Message("StaticCoercionShouldUseBox", "%s%s") + let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") @@ -486,16 +531,25 @@ module OldStyleMessages = let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") - let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") + + let NONTERM_hardwhiteLetBindingsE () = + Message("NONTERM.hardwhiteLetBindings", "") + let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") - let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") + + let NONTERM_attrUnionCaseDeclE () = + Message("NONTERM.attrUnionCaseDecl", "") + let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") - let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") + + let NONTERM_objectImplementationMembersE () = + Message("NONTERM.objectImplementationMembers", "") + let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") @@ -508,51 +562,112 @@ module OldStyleMessages = let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") - let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") - let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") - let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") + + let NONTERM_Category_ImplementationFileE () = + Message("NONTERM.Category.ImplementationFile", "") + + let NONTERM_Category_DefinitionE () = + Message("NONTERM.Category.Definition", "") + + let NONTERM_Category_SignatureFileE () = + Message("NONTERM.Category.SignatureFile", "") + let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") let TokenName1E () = Message("TokenName1", "%s") let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") - let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") - let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") - let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") + + let TokenName1TokenName2TokenName3E () = + Message("TokenName1TokenName2TokenName3", "%s%s%s") + + let RuntimeCoercionSourceSealed1E () = + Message("RuntimeCoercionSourceSealed1", "%s") + + let RuntimeCoercionSourceSealed2E () = + Message("RuntimeCoercionSourceSealed2", "%s") + let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") - let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") - let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") - let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") - let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") - let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") - let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") - let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") + + let OverrideDoesntOverride1E () = + Message("OverrideDoesntOverride1", "%s") + + let OverrideDoesntOverride2E () = + Message("OverrideDoesntOverride2", "%s") + + let OverrideDoesntOverride3E () = + Message("OverrideDoesntOverride3", "%s") + + let OverrideDoesntOverride4E () = + Message("OverrideDoesntOverride4", "%s") + + let UnionCaseWrongArgumentsE () = + Message("UnionCaseWrongArguments", "%d%d") + + let UnionPatternsBindDifferentNamesE () = + Message("UnionPatternsBindDifferentNames", "") + + let RequiredButNotSpecifiedE () = + Message("RequiredButNotSpecified", "%s%s%s") + let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") - let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") - let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") + + let DeprecatedThreadStaticBindingWarningE () = + Message("DeprecatedThreadStaticBindingWarning", "") + + let FunctionValueUnexpectedE () = + Message("FunctionValueUnexpected", "%s") + let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") - let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") - let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") - let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") - let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") - let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") + + let UnitTypeExpectedWithEqualityE () = + Message("UnitTypeExpectedWithEquality", "%s") + + let UnitTypeExpectedWithPossiblePropertySetterE () = + Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") + + let UnitTypeExpectedWithPossibleAssignmentE () = + Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") + + let UnitTypeExpectedWithPossibleAssignmentToMutableE () = + Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") + + let RecursiveUseCheckedAtRuntimeE () = + Message("RecursiveUseCheckedAtRuntime", "") + let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") - let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") + + let LetRecEvaluatedOutOfOrderE () = + Message("LetRecEvaluatedOutOfOrder", "") + let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") - let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") - let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") - let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") - let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") - let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") - let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") + + let VirtualAugmentationOnNullValuedTypeE () = + Message("VirtualAugmentationOnNullValuedType", "") + + let NonVirtualAugmentationOnNullValuedTypeE () = + Message("NonVirtualAugmentationOnNullValuedType", "") + + let NonUniqueInferredAbstractSlot1E () = + Message("NonUniqueInferredAbstractSlot1", "%s") + + let NonUniqueInferredAbstractSlot2E () = + Message("NonUniqueInferredAbstractSlot2", "") + + let NonUniqueInferredAbstractSlot3E () = + Message("NonUniqueInferredAbstractSlot3", "%s%s") + + let NonUniqueInferredAbstractSlot4E () = + Message("NonUniqueInferredAbstractSlot4", "") + let Failure3E () = Message("Failure3", "%s") let Failure4E () = Message("Failure4", "%s") let MatchIncomplete1E () = Message("MatchIncomplete1", "") @@ -578,26 +693,63 @@ module OldStyleMessages = let RecoverableParseErrorE () = Message("RecoverableParseError", "") let ReservedKeywordE () = Message("ReservedKeyword", "%s") let IndentationProblemE () = Message("IndentationProblem", "%s") - let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") - let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") - let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") - let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") - let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") - let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") - let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") - let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") - let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") + + let OverrideInIntrinsicAugmentationE () = + Message("OverrideInIntrinsicAugmentation", "") + + let OverrideInExtrinsicAugmentationE () = + Message("OverrideInExtrinsicAugmentation", "") + + let IntfImplInIntrinsicAugmentationE () = + Message("IntfImplInIntrinsicAugmentation", "") + + let IntfImplInExtrinsicAugmentationE () = + Message("IntfImplInExtrinsicAugmentation", "") + + let UnresolvedReferenceNoRangeE () = + Message("UnresolvedReferenceNoRange", "%s") + + let UnresolvedPathReferenceNoRangeE () = + Message("UnresolvedPathReferenceNoRange", "%s%s") + + let HashIncludeNotAllowedInNonScriptE () = + Message("HashIncludeNotAllowedInNonScript", "") + + let HashReferenceNotAllowedInNonScriptE () = + Message("HashReferenceNotAllowedInNonScript", "") + + let HashDirectiveNotAllowedInNonScriptE () = + Message("HashDirectiveNotAllowedInNonScript", "") + let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") - let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") - let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") - let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") - let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") - let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") - let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") - let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") - let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") - let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") + + let HashLoadedSourceHasIssues0E () = + Message("HashLoadedSourceHasIssues0", "") + + let HashLoadedSourceHasIssues1E () = + Message("HashLoadedSourceHasIssues1", "") + + let HashLoadedSourceHasIssues2E () = + Message("HashLoadedSourceHasIssues2", "") + + let HashLoadedScriptConsideredSourceE () = + Message("HashLoadedScriptConsideredSource", "") + + let InvalidInternalsVisibleToAssemblyName1E () = + Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") + + let InvalidInternalsVisibleToAssemblyName2E () = + Message("InvalidInternalsVisibleToAssemblyName2", "%s") + + let LoadedSourceNotFoundIgnoringE () = + Message("LoadedSourceNotFoundIgnoring", "%s") + + let MSBuildReferenceResolutionErrorE () = + Message("MSBuildReferenceResolutionError", "%s%s") + + let TargetInvocationExceptionWrapperE () = + Message("TargetInvocationExceptionWrapper", "%s") #if DEBUG let mutable showParserStackOnParseError = false diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index e0a6a44f3ff..de7a5cd883d 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -187,7 +187,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP let implicitDepIdx = files |> Array.tryFindIndex (fun f -> System.IO.Path.GetFileName(f.FileName) = filename) - + match implicitDepIdx with | Some idx -> Some idx | None -> @@ -195,7 +195,7 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP |> raise else None - + let findDependencies (file: FileInProject) : FileIndex array = if file.Idx = 0 then // First file cannot have any dependencies. @@ -226,9 +226,9 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP let fsharpCoreImplicitDependencyForThisFile = match fsharpCoreImplicitDependency with - | Some depIdx when file.Idx > depIdx -> [|depIdx|] + | Some depIdx when file.Idx > depIdx -> [| depIdx |] | _ -> [||] - + let allDependencies = [| yield! depsResult.FoundDependencies diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index c46fad0bb91..4be6adcdf31 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -145,12 +145,18 @@ module NavigationImpl = // Create declaration (for the left dropdown) let createDeclLid (baseName, lid, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + textOfLid lid - let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) + + let item = + NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) + item, addItemName name, nested let createDecl (baseName, id: Ident, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) + + let item = + NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) + item, addItemName name, nested let createTypeDecl (baseName, lid, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = @@ -158,11 +164,15 @@ module NavigationImpl = // Create member-kind-of-thing for the right dropdown let createMemberLid (lid, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = NavigationItem.Create(textOfLid lid, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + let item = + NavigationItem.Create(textOfLid lid, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + item, addItemName (textOfLid lid) let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + let item = + NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + item, addItemName (id.idText) // Process let-binding @@ -229,7 +239,18 @@ module NavigationImpl = let mBody = fldspecRange fldspec [ - createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, mBody, nested, NavigationEntityKind.Exception, false, access) + createDecl ( + baseName, + id, + NavigationItemKind.Exception, + FSharpGlyph.Exception, + m, + mBody, + nested, + NavigationEntityKind.Exception, + false, + access + ) ] // Process a class declaration or F# type declaration @@ -239,7 +260,9 @@ module NavigationImpl = processExnDefnRepr baseName nested repr and processTycon baseName synTypeDefn = - let (SynTypeDefn (typeInfo = typeInfo; typeRepr = repr; members = membDefns; range = m)) = synTypeDefn + let (SynTypeDefn (typeInfo = typeInfo; typeRepr = repr; members = membDefns; range = m)) = + synTypeDefn + let (SynComponentInfo (longId = lid; accessibility = access)) = typeInfo let topMembers = processMembers membDefns NavigationEntityKind.Class |> snd @@ -265,7 +288,16 @@ module NavigationImpl = [ for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> let mBody = unionRanges (fldspecRange fldspec) id.idRange - createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, mBody, NavigationEntityKind.Union, false, access) + + createMember ( + id, + NavigationItemKind.Other, + FSharpGlyph.Struct, + mBody, + NavigationEntityKind.Union, + false, + access + ) ] let nested = cases @ topMembers @@ -279,7 +311,15 @@ module NavigationImpl = let cases = [ for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> - createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) + createMember ( + id, + NavigationItemKind.Field, + FSharpGlyph.EnumMember, + m, + NavigationEntityKind.Enum, + false, + access + ) ] let nested = cases @ topMembers @@ -294,7 +334,17 @@ module NavigationImpl = [ for SynField (idOpt = id; range = m) in fields do match id with - | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) + | Some ident -> + yield + createMember ( + ident, + NavigationItemKind.Field, + FSharpGlyph.Field, + m, + NavigationEntityKind.Record, + false, + access + ) | _ -> () ] @@ -338,7 +388,15 @@ module NavigationImpl = ] | SynMemberDefn.AbstractSlot(slotSig = SynValSig (ident = SynIdent (id, _); synType = ty; accessibility = access)) -> [ - createMember (id, NavigationItemKind.Method, FSharpGlyph.OverridenMethod, ty.Range, enclosingEntityKind, true, access) + createMember ( + id, + NavigationItemKind.Method, + FSharpGlyph.OverridenMethod, + ty.Range, + enclosingEntityKind, + true, + access + ) ] | SynMemberDefn.NestedType _ -> failwith "tycon as member????" //processTycon tycon | SynMemberDefn.Interface(members = Some (membs)) -> processMembers membs enclosingEntityKind |> snd @@ -372,16 +430,42 @@ module NavigationImpl = match decl with | SynModuleDecl.ModuleAbbrev (id, lid, m) -> let mBody = rangeOfLid lid - createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, [], NavigationEntityKind.Namespace, false, None) - | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); decls = decls; range = m) -> + createDecl ( + baseName, + id, + NavigationItemKind.Module, + FSharpGlyph.Module, + m, + mBody, + [], + NavigationEntityKind.Namespace, + false, + None + ) + + | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access) + decls = decls + range = m) -> // Find let bindings (for the right dropdown) let nested = processNestedDeclarations (decls) let newBaseName = (if (baseName = "") then "" else baseName + ".") + (textOfLid lid) let other = processNavigationTopLevelDeclarations (newBaseName, decls) - let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, nested, NavigationEntityKind.Module, access) + let mBody = + unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + + createDeclLid ( + baseName, + lid, + NavigationItemKind.Module, + FSharpGlyph.Module, + m, + mBody, + nested, + NavigationEntityKind.Module, + access + ) // Get nested modules and types (for the left dropdown) yield! other @@ -414,11 +498,23 @@ module NavigationImpl = else NavigationItemKind.Namespace - let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + let mBody = + unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + let nm = textOfLid id let item = - NavigationItem.Create(nm, kind, FSharpGlyph.Module, m, mBody, singleTopLevel, NavigationEntityKind.Module, false, access) + NavigationItem.Create( + nm, + kind, + FSharpGlyph.Module, + m, + mBody, + singleTopLevel, + NavigationEntityKind.Module, + false, + access + ) let decl = (item, addItemName (nm), nested) decl @@ -464,7 +560,10 @@ module NavigationImpl = // Create declaration (for the left dropdown) let createDeclLid (baseName, lid, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + (textOfLid lid) - let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) + + let item = + NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) + item, addItemName name, nested let createTypeDecl (baseName, lid, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = @@ -472,19 +571,37 @@ module NavigationImpl = let createDecl (baseName, id: Ident, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) + + let item = + NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) + item, addItemName name, nested let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + let item = + NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) + item, addItemName (id.idText) let rec processExnRepr baseName nested inp = - let (SynExceptionDefnRepr (_, SynUnionCase (ident = SynIdent (id, _); caseType = fldspec), _, _, access, m)) = inp + let (SynExceptionDefnRepr (_, SynUnionCase (ident = SynIdent (id, _); caseType = fldspec), _, _, access, m)) = + inp + let mBody = fldspecRange fldspec [ - createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, mBody, nested, NavigationEntityKind.Exception, false, access) + createDecl ( + baseName, + id, + NavigationItemKind.Exception, + FSharpGlyph.Exception, + m, + mBody, + nested, + NavigationEntityKind.Exception, + false, + access + ) ] and processExnSig baseName inp = @@ -493,7 +610,10 @@ module NavigationImpl = processExnRepr baseName nested repr and processTycon baseName inp = - let (SynTypeDefnSig (typeInfo = SynComponentInfo (longId = lid; accessibility = access); typeRepr = repr; members = membDefns; range = m)) = + let (SynTypeDefnSig (typeInfo = SynComponentInfo (longId = lid; accessibility = access) + typeRepr = repr + members = membDefns + range = m)) = inp let topMembers = processSigMembers membDefns @@ -515,7 +635,16 @@ module NavigationImpl = [ for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> let m = unionRanges (fldspecRange fldspec) id.idRange - createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, m, NavigationEntityKind.Union, false, access) + + createMember ( + id, + NavigationItemKind.Other, + FSharpGlyph.Struct, + m, + NavigationEntityKind.Union, + false, + access + ) ] let nested = cases @ topMembers @@ -525,7 +654,15 @@ module NavigationImpl = let cases = [ for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> - createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) + createMember ( + id, + NavigationItemKind.Field, + FSharpGlyph.EnumMember, + m, + NavigationEntityKind.Enum, + false, + access + ) ] let nested = cases @ topMembers @@ -536,7 +673,17 @@ module NavigationImpl = [ for SynField (idOpt = id; range = m) in fields do match id with - | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) + | Some ident -> + yield + createMember ( + ident, + NavigationItemKind.Field, + FSharpGlyph.Field, + m, + NavigationEntityKind.Record, + false, + access + ) | _ -> () ] @@ -560,7 +707,15 @@ module NavigationImpl = | SynMemberSig.Member(memberSig = SynValSig.SynValSig (ident = SynIdent (id, _); accessibility = access; range = m)) -> createMember (id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Class, false, access) | SynMemberSig.ValField (SynField (idOpt = Some rcid; fieldType = ty; accessibility = access), _) -> - createMember (rcid, NavigationItemKind.Field, FSharpGlyph.Field, ty.Range, NavigationEntityKind.Class, false, access) + createMember ( + rcid, + NavigationItemKind.Field, + FSharpGlyph.Field, + ty.Range, + NavigationEntityKind.Class, + false, + access + ) | _ -> () ] @@ -582,17 +737,44 @@ module NavigationImpl = match decl with | SynModuleSigDecl.ModuleAbbrev (id, lid, m) -> let mBody = rangeOfLid lid - createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, [], NavigationEntityKind.Module, false, None) - | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); moduleDecls = decls; range = m) -> + createDecl ( + baseName, + id, + NavigationItemKind.Module, + FSharpGlyph.Module, + m, + mBody, + [], + NavigationEntityKind.Module, + false, + None + ) + + | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access) + moduleDecls = decls + range = m) -> // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations (decls) let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) let other = processNavigationTopLevelSigDeclarations (newBaseName, decls) // Get nested modules and types (for the left dropdown) - let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, nested, NavigationEntityKind.Module, access) + let mBody = + unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + + createDeclLid ( + baseName, + lid, + NavigationItemKind.Module, + FSharpGlyph.Module, + m, + mBody, + nested, + NavigationEntityKind.Module, + access + ) + yield! other | SynModuleSigDecl.Types (tydefs, _) -> @@ -609,7 +791,9 @@ module NavigationImpl = [ for modulSig in modules do - let (SynModuleOrNamespaceSig (id, _isRec, kind, decls, _, _, access, m, _)) = modulSig + let (SynModuleOrNamespaceSig (id, _isRec, kind, decls, _, _, access, m, _)) = + modulSig + let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations (decls) @@ -623,10 +807,21 @@ module NavigationImpl = else NavigationItemKind.Namespace - let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + let mBody = + unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) let item = - NavigationItem.Create(textOfLid id, kind, FSharpGlyph.Module, m, mBody, singleTopLevel, NavigationEntityKind.Module, false, access) + NavigationItem.Create( + textOfLid id, + kind, + FSharpGlyph.Module, + m, + mBody, + singleTopLevel, + NavigationEntityKind.Module, + false, + access + ) let decl = (item, addItemName (textOfLid id), nested) decl @@ -771,7 +966,9 @@ module NavigateTo = addIdent NavigableItemKind.ModuleAbbreviation id isSig container let addExceptionRepr exnRepr isSig container = - let (SynExceptionDefnRepr (_, SynUnionCase(ident = SynIdent (id, _)), _, _, _, _)) = exnRepr + let (SynExceptionDefnRepr (_, SynUnionCase(ident = SynIdent (id, _)), _, _, _, _)) = + exnRepr + addIdent NavigableItemKind.Exception id isSig container NavigableContainer.Container(NavigableContainerType.Exception, [ id.idText ], container) @@ -862,10 +1059,12 @@ module NavigateTo = and walkSynModuleSigDecl (decl: SynModuleSigDecl) container = match decl with | SynModuleSigDecl.ModuleAbbrev (lhs, _, _range) -> addModuleAbbreviation lhs true container - | SynModuleSigDecl.Exception(exnSig = SynExceptionSig (exnRepr = representation)) -> addExceptionRepr representation true container |> ignore + | SynModuleSigDecl.Exception(exnSig = SynExceptionSig (exnRepr = representation)) -> + addExceptionRepr representation true container |> ignore | SynModuleSigDecl.NamespaceFragment fragment -> walkSynModuleOrNamespaceSig fragment container | SynModuleSigDecl.NestedModule (moduleInfo = componentInfo; moduleDecls = nestedDecls) -> - let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo true container + let container = + addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo true container for decl in nestedDecls do walkSynModuleSigDecl decl container @@ -877,8 +1076,11 @@ module NavigateTo = | SynModuleSigDecl.Open _ -> () and walkSynTypeDefnSig (inp: SynTypeDefnSig) container = - let (SynTypeDefnSig (typeInfo = componentInfo; typeRepr = repr; members = members)) = inp - let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo true container + let (SynTypeDefnSig (typeInfo = componentInfo; typeRepr = repr; members = members)) = + inp + + let container = + addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo true container for m in members do walkSynMemberSig m container @@ -931,7 +1133,8 @@ module NavigateTo = | SynModuleDecl.ModuleAbbrev (lhs, _, _) -> addModuleAbbreviation lhs false container | SynModuleDecl.NamespaceFragment (fragment) -> walkSynModuleOrNamespace fragment container | SynModuleDecl.NestedModule (moduleInfo = componentInfo; decls = modules) -> - let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo false container + let container = + addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo false container for m in modules do walkSynModuleDecl m container @@ -944,8 +1147,12 @@ module NavigateTo = | SynModuleDecl.Open _ -> () and walkSynTypeDefn inp container = - let (SynTypeDefn (typeInfo = componentInfo; typeRepr = representation; members = members)) = inp - let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo false container + let (SynTypeDefn (typeInfo = componentInfo; typeRepr = representation; members = members)) = + inp + + let container = + addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo false container + walkSynTypeDefnRepr representation container for m in members do diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index 93625581f3d..e9939beef74 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -520,12 +520,15 @@ module Structure = parseExpr attr.ArgExpr and parseBinding binding = - let (SynBinding (kind = kind; attributes = attrs; valData = valData; expr = expr; range = br)) = binding + let (SynBinding (kind = kind; attributes = attrs; valData = valData; expr = expr; range = br)) = + binding + let (SynValData (memberFlags = memberFlags)) = valData match kind with | SynBindingKind.Normal -> - let collapse = Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs + let collapse = + Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs match memberFlags with | Some { @@ -546,7 +549,9 @@ module Structure = parseBinding bind and parseExprInterface intf = - let (SynInterfaceImpl (interfaceTy = synType; bindings = bindings; range = range)) = intf + let (SynInterfaceImpl (interfaceTy = synType; bindings = bindings; range = range)) = + intf + let collapse = Range.endToEnd synType.Range range |> Range.modEnd -1 rcheck Scope.Interface Collapse.Below range collapse parseBindings bindings @@ -575,7 +580,8 @@ module Structure = }, _, _) -> - let range = mkRange d.Range.FileName (mkPos d.Range.StartLine objectModelRange.StartColumn) d.Range.End + let range = + mkRange d.Range.FileName (mkPos d.Range.StartLine objectModelRange.StartColumn) d.Range.End let collapse = match synPat with @@ -971,7 +977,8 @@ module Structure = | _ -> () and parseTypeDefnSig typeDefn = - let (SynTypeDefnSig (typeInfo = typeInfo; typeRepr = objectModel; members = memberSigs)) = typeDefn + let (SynTypeDefnSig (typeInfo = typeInfo; typeRepr = objectModel; members = memberSigs)) = + typeDefn let (SynComponentInfo (attributes = attribs; typeParams = TyparDecls typeArgs; longId = longId; range = r)) = typeInfo @@ -1077,7 +1084,9 @@ module Structure = let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with | SynModuleSigDecl.Val (valSig, r) -> - let (SynValSig (attributes = attrs; ident = SynIdent (ident, _); range = valrange)) = valSig + let (SynValSig (attributes = attrs; ident = SynIdent (ident, _); range = valrange)) = + valSig + let collapse = Range.endToEnd ident.idRange valrange rcheck Scope.Val Collapse.Below r collapse parseAttributes attrs @@ -1099,7 +1108,9 @@ module Structure = | _ -> () let parseModuleOrNamespaceSigs moduleSig = - let (SynModuleOrNamespaceSig (longId, _, kind, decls, _, attribs, _, r, _)) = moduleSig + let (SynModuleOrNamespaceSig (longId, _, kind, decls, _, attribs, _, r, _)) = + moduleSig + parseAttributes attribs let rangeEnd = lastModuleSigDeclRangeElse r decls let idrange = longIdentRange longId diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index ae56b28acb2..b3050e8bbab 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -43,7 +43,9 @@ module EnvMisc = let checkFileInProjectCacheSize = GetEnvInteger "FCS_CheckFileInProjectCacheSize" 10 let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 - let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 + + let frameworkTcImportsCacheStrongSize = + GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 //---------------------------------------------------------------------------- // BackgroundCompiler @@ -214,7 +216,8 @@ type BackgroundCompiler areSimilar = FSharpProjectOptions.UseSameProject ) - let frameworkTcImportsCache = FrameworkImportsCache(frameworkTcImportsCacheStrongSize) + let frameworkTcImportsCache = + FrameworkImportsCache(frameworkTcImportsCacheStrongSize) // We currently share one global dependency provider for all scripts for the FSharpChecker. // For projects, one is used per project. @@ -362,7 +365,11 @@ type BackgroundCompiler // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. let parseFileCache = - MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) + MruCache( + parseFileCacheSize, + areSimilar = AreSimilarForParsing, + areSame = AreSameForParsing + ) // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache // @@ -429,7 +436,8 @@ type BackgroundCompiler | Some getBuilder -> node { match! getBuilder with - | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags + | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> + return builderOpt, creationDiags | _ -> // The builder could be re-created, // clear the check file caches that are associated with it. @@ -479,7 +487,18 @@ type BackgroundCompiler let res = GraphNode( node { - let! res = self.CheckOneFileImplAux(parseResults, sourceText, fileName, options, builder, tcPrior, tcInfo, creationDiags) + let! res = + self.CheckOneFileImplAux( + parseResults, + sourceText, + fileName, + options, + builder, + tcPrior, + tcInfo, + creationDiags + ) + Interlocked.Increment(&actualCheckFileCount) |> ignore return res } @@ -488,7 +507,15 @@ type BackgroundCompiler checkFileInProjectCache.Set(ltok, key, res) res) - member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) = + member _.ParseFile + ( + fileName: string, + sourceText: ISourceText, + options: FSharpParsingOptions, + cache: bool, + flatErrors: bool, + userOpName: string + ) = async { use _ = Activity.start @@ -518,12 +545,22 @@ type BackgroundCompiler captureIdentifiersWhenParsing ) - let res = FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) + let res = + FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) + parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) return res else let parseDiagnostics, parseTree, anyErrors = - ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, false, flatErrors, captureIdentifiersWhenParsing) + ParseAndCheckFile.parseFile ( + sourceText, + fileName, + options, + userOpName, + false, + flatErrors, + captureIdentifiersWhenParsing + ) return FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) } @@ -575,7 +612,9 @@ type BackgroundCompiler let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) - let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) + + let cachedResultsOpt = + parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) match cachedResultsOpt with | Some cachedResults -> @@ -707,7 +746,17 @@ type BackgroundCompiler match tcPrior.TryPeekTcInfo() with | Some tcInfo -> let! checkResults = - bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + bc.CheckOneFileImpl( + parseResults, + sourceText, + fileName, + options, + fileVersion, + builder, + tcPrior, + tcInfo, + creationDiags + ) return Some checkResults | None -> return None @@ -715,7 +764,15 @@ type BackgroundCompiler } /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. - member bc.CheckFileInProject(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = + member bc.CheckFileInProject + ( + parseResults: FSharpParseFileResults, + fileName, + fileVersion, + sourceText: ISourceText, + options, + userOpName + ) = node { use _ = Activity.start @@ -729,7 +786,8 @@ type BackgroundCompiler let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with - | None -> return FSharpCheckFileAnswer.Succeeded(FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) + | None -> + return FSharpCheckFileAnswer.Succeeded(FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) | Some builder -> // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) @@ -739,11 +797,30 @@ type BackgroundCompiler | _ -> let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() - return! bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + + return! + bc.CheckOneFileImpl( + parseResults, + sourceText, + fileName, + options, + fileVersion, + builder, + tcPrior, + tcInfo, + creationDiags + ) } /// Parses and checks the source file and returns untyped AST and check results. - member bc.ParseAndCheckFileInProject(fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = + member bc.ParseAndCheckFileInProject + ( + fileName: string, + fileVersion, + sourceText: ISourceText, + options: FSharpProjectOptions, + userOpName + ) = node { use _ = Activity.start @@ -772,7 +849,11 @@ type BackgroundCompiler let! tcInfo = tcPrior.GetOrComputeTcInfo() // Do the parsing. let parsingOptions = - FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) + FSharpParsingOptions.FromTcConfig( + builder.TcConfig, + Array.ofList builder.SourceFiles, + options.UseScriptResolutionRules + ) GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang @@ -791,7 +872,17 @@ type BackgroundCompiler FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, builder.AllDependenciesDeprecated) let! checkResults = - bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) + bc.CheckOneFileImpl( + parseResults, + sourceText, + fileName, + options, + fileVersion, + builder, + tcPrior, + tcInfo, + creationDiags + ) return (parseResults, checkResults) } @@ -974,7 +1065,13 @@ type BackgroundCompiler } /// Try to get recent approximate type check results for a file. - member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = + member _.TryGetRecentCheckResultsForFile + ( + fileName: string, + options: FSharpProjectOptions, + sourceText: ISourceText option, + _userOpName: string + ) = use _ = Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" @@ -1056,7 +1153,13 @@ type BackgroundCompiler options) let results = - FSharpCheckProjectResults(options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, diagnostics, Some details) + FSharpCheckProjectResults( + options.ProjectFileName, + Some tcProj.TcConfig, + keepAssemblyContents, + diagnostics, + Some details + ) return results } @@ -1140,7 +1243,8 @@ type BackgroundCompiler use diagnostics = new DiagnosticsScope(otherFlags |> Array.contains "--flaterrors") - let useSimpleResolution = otherFlags |> Array.exists (fun x -> x = "--simpleresolution") + let useSimpleResolution = + otherFlags |> Array.exists (fun x -> x = "--simpleresolution") let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading @@ -1198,7 +1302,13 @@ type BackgroundCompiler let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> - FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false, options.OtherOptions |> Array.contains "--flaterrors")) + FSharpDiagnostic.CreateFromException( + exn, + isError, + range.Zero, + false, + options.OtherOptions |> Array.contains "--flaterrors" + )) return options, (diags @ diagnostics.Diagnostics) } @@ -1222,7 +1332,8 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] + use _ = + Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1398,7 +1509,8 @@ type FSharpChecker if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." - let parallelReferenceResolution = inferParallelReferenceResolution parallelReferenceResolution + let parallelReferenceResolution = + inferParallelReferenceResolution parallelReferenceResolution FSharpChecker( legacyReferenceResolver, @@ -1478,7 +1590,9 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" - use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] + + use _ = + Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { let ctok = CompilationThreadToken() @@ -1780,7 +1894,8 @@ open FSharp.Compiler.DiagnosticsLogger type CompilerEnvironment() = /// Source file extensions - static let compilableExtensions = FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes + static let compilableExtensions = + FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes /// Single file projects extensions static let singleFileProjectExtensions = FSharpScriptFileSuffixes From 590ae52edf457d693c144a924d84c8b1b0f2d260 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 16:29:16 +0100 Subject: [PATCH 06/10] Revert unrelated fantomas changes --- src/Compiler/Service/ServiceNavigation.fs | 289 +++------------------- src/Compiler/Service/ServiceStructure.fs | 25 +- src/Compiler/Service/service.fs | 163 ++---------- 3 files changed, 72 insertions(+), 405 deletions(-) diff --git a/src/Compiler/Service/ServiceNavigation.fs b/src/Compiler/Service/ServiceNavigation.fs index 4be6adcdf31..c46fad0bb91 100755 --- a/src/Compiler/Service/ServiceNavigation.fs +++ b/src/Compiler/Service/ServiceNavigation.fs @@ -145,18 +145,12 @@ module NavigationImpl = // Create declaration (for the left dropdown) let createDeclLid (baseName, lid, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + textOfLid lid - - let item = - NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) - + let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) item, addItemName name, nested let createDecl (baseName, id: Ident, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - - let item = - NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) - + let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) item, addItemName name, nested let createTypeDecl (baseName, lid, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = @@ -164,15 +158,11 @@ module NavigationImpl = // Create member-kind-of-thing for the right dropdown let createMemberLid (lid, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = - NavigationItem.Create(textOfLid lid, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - + let item = NavigationItem.Create(textOfLid lid, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) item, addItemName (textOfLid lid) let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = - NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - + let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) item, addItemName (id.idText) // Process let-binding @@ -239,18 +229,7 @@ module NavigationImpl = let mBody = fldspecRange fldspec [ - createDecl ( - baseName, - id, - NavigationItemKind.Exception, - FSharpGlyph.Exception, - m, - mBody, - nested, - NavigationEntityKind.Exception, - false, - access - ) + createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, mBody, nested, NavigationEntityKind.Exception, false, access) ] // Process a class declaration or F# type declaration @@ -260,9 +239,7 @@ module NavigationImpl = processExnDefnRepr baseName nested repr and processTycon baseName synTypeDefn = - let (SynTypeDefn (typeInfo = typeInfo; typeRepr = repr; members = membDefns; range = m)) = - synTypeDefn - + let (SynTypeDefn (typeInfo = typeInfo; typeRepr = repr; members = membDefns; range = m)) = synTypeDefn let (SynComponentInfo (longId = lid; accessibility = access)) = typeInfo let topMembers = processMembers membDefns NavigationEntityKind.Class |> snd @@ -288,16 +265,7 @@ module NavigationImpl = [ for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> let mBody = unionRanges (fldspecRange fldspec) id.idRange - - createMember ( - id, - NavigationItemKind.Other, - FSharpGlyph.Struct, - mBody, - NavigationEntityKind.Union, - false, - access - ) + createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, mBody, NavigationEntityKind.Union, false, access) ] let nested = cases @ topMembers @@ -311,15 +279,7 @@ module NavigationImpl = let cases = [ for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> - createMember ( - id, - NavigationItemKind.Field, - FSharpGlyph.EnumMember, - m, - NavigationEntityKind.Enum, - false, - access - ) + createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) ] let nested = cases @ topMembers @@ -334,17 +294,7 @@ module NavigationImpl = [ for SynField (idOpt = id; range = m) in fields do match id with - | Some ident -> - yield - createMember ( - ident, - NavigationItemKind.Field, - FSharpGlyph.Field, - m, - NavigationEntityKind.Record, - false, - access - ) + | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) | _ -> () ] @@ -388,15 +338,7 @@ module NavigationImpl = ] | SynMemberDefn.AbstractSlot(slotSig = SynValSig (ident = SynIdent (id, _); synType = ty; accessibility = access)) -> [ - createMember ( - id, - NavigationItemKind.Method, - FSharpGlyph.OverridenMethod, - ty.Range, - enclosingEntityKind, - true, - access - ) + createMember (id, NavigationItemKind.Method, FSharpGlyph.OverridenMethod, ty.Range, enclosingEntityKind, true, access) ] | SynMemberDefn.NestedType _ -> failwith "tycon as member????" //processTycon tycon | SynMemberDefn.Interface(members = Some (membs)) -> processMembers membs enclosingEntityKind |> snd @@ -430,42 +372,16 @@ module NavigationImpl = match decl with | SynModuleDecl.ModuleAbbrev (id, lid, m) -> let mBody = rangeOfLid lid + createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, [], NavigationEntityKind.Namespace, false, None) - createDecl ( - baseName, - id, - NavigationItemKind.Module, - FSharpGlyph.Module, - m, - mBody, - [], - NavigationEntityKind.Namespace, - false, - None - ) - - | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access) - decls = decls - range = m) -> + | SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); decls = decls; range = m) -> // Find let bindings (for the right dropdown) let nested = processNestedDeclarations (decls) let newBaseName = (if (baseName = "") then "" else baseName + ".") + (textOfLid lid) let other = processNavigationTopLevelDeclarations (newBaseName, decls) - let mBody = - unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - - createDeclLid ( - baseName, - lid, - NavigationItemKind.Module, - FSharpGlyph.Module, - m, - mBody, - nested, - NavigationEntityKind.Module, - access - ) + let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, nested, NavigationEntityKind.Module, access) // Get nested modules and types (for the left dropdown) yield! other @@ -498,23 +414,11 @@ module NavigationImpl = else NavigationItemKind.Namespace - let mBody = - unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) - + let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) let nm = textOfLid id let item = - NavigationItem.Create( - nm, - kind, - FSharpGlyph.Module, - m, - mBody, - singleTopLevel, - NavigationEntityKind.Module, - false, - access - ) + NavigationItem.Create(nm, kind, FSharpGlyph.Module, m, mBody, singleTopLevel, NavigationEntityKind.Module, false, access) let decl = (item, addItemName (nm), nested) decl @@ -560,10 +464,7 @@ module NavigationImpl = // Create declaration (for the left dropdown) let createDeclLid (baseName, lid, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = let name = (if baseName <> "" then baseName + "." else "") + (textOfLid lid) - - let item = - NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) - + let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, false, access) item, addItemName name, nested let createTypeDecl (baseName, lid, baseGlyph, m, mBody, nested, enclosingEntityKind, access) = @@ -571,37 +472,19 @@ module NavigationImpl = let createDecl (baseName, id: Ident, kind, baseGlyph, m, mBody, nested, enclosingEntityKind, isAbstract, access) = let name = (if baseName <> "" then baseName + "." else "") + id.idText - - let item = - NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) - + let item = NavigationItem.Create(name, kind, baseGlyph, m, mBody, false, enclosingEntityKind, isAbstract, access) item, addItemName name, nested let createMember (id: Ident, kind, baseGlyph, m, enclosingEntityKind, isAbstract, access) = - let item = - NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) - + let item = NavigationItem.Create(id.idText, kind, baseGlyph, m, m, false, enclosingEntityKind, isAbstract, access) item, addItemName (id.idText) let rec processExnRepr baseName nested inp = - let (SynExceptionDefnRepr (_, SynUnionCase (ident = SynIdent (id, _); caseType = fldspec), _, _, access, m)) = - inp - + let (SynExceptionDefnRepr (_, SynUnionCase (ident = SynIdent (id, _); caseType = fldspec), _, _, access, m)) = inp let mBody = fldspecRange fldspec [ - createDecl ( - baseName, - id, - NavigationItemKind.Exception, - FSharpGlyph.Exception, - m, - mBody, - nested, - NavigationEntityKind.Exception, - false, - access - ) + createDecl (baseName, id, NavigationItemKind.Exception, FSharpGlyph.Exception, m, mBody, nested, NavigationEntityKind.Exception, false, access) ] and processExnSig baseName inp = @@ -610,10 +493,7 @@ module NavigationImpl = processExnRepr baseName nested repr and processTycon baseName inp = - let (SynTypeDefnSig (typeInfo = SynComponentInfo (longId = lid; accessibility = access) - typeRepr = repr - members = membDefns - range = m)) = + let (SynTypeDefnSig (typeInfo = SynComponentInfo (longId = lid; accessibility = access); typeRepr = repr; members = membDefns; range = m)) = inp let topMembers = processSigMembers membDefns @@ -635,16 +515,7 @@ module NavigationImpl = [ for SynUnionCase (ident = SynIdent (id, _); caseType = fldspec) in cases -> let m = unionRanges (fldspecRange fldspec) id.idRange - - createMember ( - id, - NavigationItemKind.Other, - FSharpGlyph.Struct, - m, - NavigationEntityKind.Union, - false, - access - ) + createMember (id, NavigationItemKind.Other, FSharpGlyph.Struct, m, NavigationEntityKind.Union, false, access) ] let nested = cases @ topMembers @@ -654,15 +525,7 @@ module NavigationImpl = let cases = [ for SynEnumCase (ident = SynIdent (id, _); range = m) in cases -> - createMember ( - id, - NavigationItemKind.Field, - FSharpGlyph.EnumMember, - m, - NavigationEntityKind.Enum, - false, - access - ) + createMember (id, NavigationItemKind.Field, FSharpGlyph.EnumMember, m, NavigationEntityKind.Enum, false, access) ] let nested = cases @ topMembers @@ -673,17 +536,7 @@ module NavigationImpl = [ for SynField (idOpt = id; range = m) in fields do match id with - | Some ident -> - yield - createMember ( - ident, - NavigationItemKind.Field, - FSharpGlyph.Field, - m, - NavigationEntityKind.Record, - false, - access - ) + | Some ident -> yield createMember (ident, NavigationItemKind.Field, FSharpGlyph.Field, m, NavigationEntityKind.Record, false, access) | _ -> () ] @@ -707,15 +560,7 @@ module NavigationImpl = | SynMemberSig.Member(memberSig = SynValSig.SynValSig (ident = SynIdent (id, _); accessibility = access; range = m)) -> createMember (id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Class, false, access) | SynMemberSig.ValField (SynField (idOpt = Some rcid; fieldType = ty; accessibility = access), _) -> - createMember ( - rcid, - NavigationItemKind.Field, - FSharpGlyph.Field, - ty.Range, - NavigationEntityKind.Class, - false, - access - ) + createMember (rcid, NavigationItemKind.Field, FSharpGlyph.Field, ty.Range, NavigationEntityKind.Class, false, access) | _ -> () ] @@ -737,44 +582,17 @@ module NavigationImpl = match decl with | SynModuleSigDecl.ModuleAbbrev (id, lid, m) -> let mBody = rangeOfLid lid + createDecl (baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, [], NavigationEntityKind.Module, false, None) - createDecl ( - baseName, - id, - NavigationItemKind.Module, - FSharpGlyph.Module, - m, - mBody, - [], - NavigationEntityKind.Module, - false, - None - ) - - | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access) - moduleDecls = decls - range = m) -> + | SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo (longId = lid; accessibility = access); moduleDecls = decls; range = m) -> // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations (decls) let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) let other = processNavigationTopLevelSigDeclarations (newBaseName, decls) // Get nested modules and types (for the left dropdown) - let mBody = - unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) - - createDeclLid ( - baseName, - lid, - NavigationItemKind.Module, - FSharpGlyph.Module, - m, - mBody, - nested, - NavigationEntityKind.Module, - access - ) - + let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other) + createDeclLid (baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, mBody, nested, NavigationEntityKind.Module, access) yield! other | SynModuleSigDecl.Types (tydefs, _) -> @@ -791,9 +609,7 @@ module NavigationImpl = [ for modulSig in modules do - let (SynModuleOrNamespaceSig (id, _isRec, kind, decls, _, _, access, m, _)) = - modulSig - + let (SynModuleOrNamespaceSig (id, _isRec, kind, decls, _, _, access, m, _)) = modulSig let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations (decls) @@ -807,21 +623,10 @@ module NavigationImpl = else NavigationItemKind.Namespace - let mBody = - unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) + let mBody = unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid id) other) let item = - NavigationItem.Create( - textOfLid id, - kind, - FSharpGlyph.Module, - m, - mBody, - singleTopLevel, - NavigationEntityKind.Module, - false, - access - ) + NavigationItem.Create(textOfLid id, kind, FSharpGlyph.Module, m, mBody, singleTopLevel, NavigationEntityKind.Module, false, access) let decl = (item, addItemName (textOfLid id), nested) decl @@ -966,9 +771,7 @@ module NavigateTo = addIdent NavigableItemKind.ModuleAbbreviation id isSig container let addExceptionRepr exnRepr isSig container = - let (SynExceptionDefnRepr (_, SynUnionCase(ident = SynIdent (id, _)), _, _, _, _)) = - exnRepr - + let (SynExceptionDefnRepr (_, SynUnionCase(ident = SynIdent (id, _)), _, _, _, _)) = exnRepr addIdent NavigableItemKind.Exception id isSig container NavigableContainer.Container(NavigableContainerType.Exception, [ id.idText ], container) @@ -1059,12 +862,10 @@ module NavigateTo = and walkSynModuleSigDecl (decl: SynModuleSigDecl) container = match decl with | SynModuleSigDecl.ModuleAbbrev (lhs, _, _range) -> addModuleAbbreviation lhs true container - | SynModuleSigDecl.Exception(exnSig = SynExceptionSig (exnRepr = representation)) -> - addExceptionRepr representation true container |> ignore + | SynModuleSigDecl.Exception(exnSig = SynExceptionSig (exnRepr = representation)) -> addExceptionRepr representation true container |> ignore | SynModuleSigDecl.NamespaceFragment fragment -> walkSynModuleOrNamespaceSig fragment container | SynModuleSigDecl.NestedModule (moduleInfo = componentInfo; moduleDecls = nestedDecls) -> - let container = - addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo true container + let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo true container for decl in nestedDecls do walkSynModuleSigDecl decl container @@ -1076,11 +877,8 @@ module NavigateTo = | SynModuleSigDecl.Open _ -> () and walkSynTypeDefnSig (inp: SynTypeDefnSig) container = - let (SynTypeDefnSig (typeInfo = componentInfo; typeRepr = repr; members = members)) = - inp - - let container = - addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo true container + let (SynTypeDefnSig (typeInfo = componentInfo; typeRepr = repr; members = members)) = inp + let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo true container for m in members do walkSynMemberSig m container @@ -1133,8 +931,7 @@ module NavigateTo = | SynModuleDecl.ModuleAbbrev (lhs, _, _) -> addModuleAbbreviation lhs false container | SynModuleDecl.NamespaceFragment (fragment) -> walkSynModuleOrNamespace fragment container | SynModuleDecl.NestedModule (moduleInfo = componentInfo; decls = modules) -> - let container = - addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo false container + let container = addComponentInfo NavigableContainerType.Module NavigableItemKind.Module componentInfo false container for m in modules do walkSynModuleDecl m container @@ -1147,12 +944,8 @@ module NavigateTo = | SynModuleDecl.Open _ -> () and walkSynTypeDefn inp container = - let (SynTypeDefn (typeInfo = componentInfo; typeRepr = representation; members = members)) = - inp - - let container = - addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo false container - + let (SynTypeDefn (typeInfo = componentInfo; typeRepr = representation; members = members)) = inp + let container = addComponentInfo NavigableContainerType.Type NavigableItemKind.Type componentInfo false container walkSynTypeDefnRepr representation container for m in members do diff --git a/src/Compiler/Service/ServiceStructure.fs b/src/Compiler/Service/ServiceStructure.fs index e9939beef74..93625581f3d 100644 --- a/src/Compiler/Service/ServiceStructure.fs +++ b/src/Compiler/Service/ServiceStructure.fs @@ -520,15 +520,12 @@ module Structure = parseExpr attr.ArgExpr and parseBinding binding = - let (SynBinding (kind = kind; attributes = attrs; valData = valData; expr = expr; range = br)) = - binding - + let (SynBinding (kind = kind; attributes = attrs; valData = valData; expr = expr; range = br)) = binding let (SynValData (memberFlags = memberFlags)) = valData match kind with | SynBindingKind.Normal -> - let collapse = - Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs + let collapse = Range.endToEnd binding.RangeOfBindingWithoutRhs binding.RangeOfBindingWithRhs match memberFlags with | Some { @@ -549,9 +546,7 @@ module Structure = parseBinding bind and parseExprInterface intf = - let (SynInterfaceImpl (interfaceTy = synType; bindings = bindings; range = range)) = - intf - + let (SynInterfaceImpl (interfaceTy = synType; bindings = bindings; range = range)) = intf let collapse = Range.endToEnd synType.Range range |> Range.modEnd -1 rcheck Scope.Interface Collapse.Below range collapse parseBindings bindings @@ -580,8 +575,7 @@ module Structure = }, _, _) -> - let range = - mkRange d.Range.FileName (mkPos d.Range.StartLine objectModelRange.StartColumn) d.Range.End + let range = mkRange d.Range.FileName (mkPos d.Range.StartLine objectModelRange.StartColumn) d.Range.End let collapse = match synPat with @@ -977,8 +971,7 @@ module Structure = | _ -> () and parseTypeDefnSig typeDefn = - let (SynTypeDefnSig (typeInfo = typeInfo; typeRepr = objectModel; members = memberSigs)) = - typeDefn + let (SynTypeDefnSig (typeInfo = typeInfo; typeRepr = objectModel; members = memberSigs)) = typeDefn let (SynComponentInfo (attributes = attribs; typeParams = TyparDecls typeArgs; longId = longId; range = r)) = typeInfo @@ -1084,9 +1077,7 @@ module Structure = let rec parseModuleSigDeclaration (decl: SynModuleSigDecl) = match decl with | SynModuleSigDecl.Val (valSig, r) -> - let (SynValSig (attributes = attrs; ident = SynIdent (ident, _); range = valrange)) = - valSig - + let (SynValSig (attributes = attrs; ident = SynIdent (ident, _); range = valrange)) = valSig let collapse = Range.endToEnd ident.idRange valrange rcheck Scope.Val Collapse.Below r collapse parseAttributes attrs @@ -1108,9 +1099,7 @@ module Structure = | _ -> () let parseModuleOrNamespaceSigs moduleSig = - let (SynModuleOrNamespaceSig (longId, _, kind, decls, _, attribs, _, r, _)) = - moduleSig - + let (SynModuleOrNamespaceSig (longId, _, kind, decls, _, attribs, _, r, _)) = moduleSig parseAttributes attribs let rangeEnd = lastModuleSigDeclRangeElse r decls let idrange = longIdentRange longId diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index b3050e8bbab..ae56b28acb2 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -43,9 +43,7 @@ module EnvMisc = let checkFileInProjectCacheSize = GetEnvInteger "FCS_CheckFileInProjectCacheSize" 10 let projectCacheSizeDefault = GetEnvInteger "FCS_ProjectCacheSizeDefault" 3 - - let frameworkTcImportsCacheStrongSize = - GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 + let frameworkTcImportsCacheStrongSize = GetEnvInteger "FCS_frameworkTcImportsCacheStrongSizeDefault" 8 //---------------------------------------------------------------------------- // BackgroundCompiler @@ -216,8 +214,7 @@ type BackgroundCompiler areSimilar = FSharpProjectOptions.UseSameProject ) - let frameworkTcImportsCache = - FrameworkImportsCache(frameworkTcImportsCacheStrongSize) + let frameworkTcImportsCache = FrameworkImportsCache(frameworkTcImportsCacheStrongSize) // We currently share one global dependency provider for all scripts for the FSharpChecker. // For projects, one is used per project. @@ -365,11 +362,7 @@ type BackgroundCompiler // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.parseFileInProjectCache. Most recently used cache for parsing files. let parseFileCache = - MruCache( - parseFileCacheSize, - areSimilar = AreSimilarForParsing, - areSame = AreSameForParsing - ) + MruCache(parseFileCacheSize, areSimilar = AreSimilarForParsing, areSame = AreSameForParsing) // STATIC ROOT: FSharpLanguageServiceTestable.FSharpChecker.checkFileInProjectCache // @@ -436,8 +429,7 @@ type BackgroundCompiler | Some getBuilder -> node { match! getBuilder with - | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> - return builderOpt, creationDiags + | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags | _ -> // The builder could be re-created, // clear the check file caches that are associated with it. @@ -487,18 +479,7 @@ type BackgroundCompiler let res = GraphNode( node { - let! res = - self.CheckOneFileImplAux( - parseResults, - sourceText, - fileName, - options, - builder, - tcPrior, - tcInfo, - creationDiags - ) - + let! res = self.CheckOneFileImplAux(parseResults, sourceText, fileName, options, builder, tcPrior, tcInfo, creationDiags) Interlocked.Increment(&actualCheckFileCount) |> ignore return res } @@ -507,15 +488,7 @@ type BackgroundCompiler checkFileInProjectCache.Set(ltok, key, res) res) - member _.ParseFile - ( - fileName: string, - sourceText: ISourceText, - options: FSharpParsingOptions, - cache: bool, - flatErrors: bool, - userOpName: string - ) = + member _.ParseFile(fileName: string, sourceText: ISourceText, options: FSharpParsingOptions, cache: bool, flatErrors: bool, userOpName: string) = async { use _ = Activity.start @@ -545,22 +518,12 @@ type BackgroundCompiler captureIdentifiersWhenParsing ) - let res = - FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) - + let res = FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) parseCacheLock.AcquireLock(fun ltok -> parseFileCache.Set(ltok, (fileName, hash, options), res)) return res else let parseDiagnostics, parseTree, anyErrors = - ParseAndCheckFile.parseFile ( - sourceText, - fileName, - options, - userOpName, - false, - flatErrors, - captureIdentifiersWhenParsing - ) + ParseAndCheckFile.parseFile (sourceText, fileName, options, userOpName, false, flatErrors, captureIdentifiersWhenParsing) return FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, options.SourceFiles) } @@ -612,9 +575,7 @@ type BackgroundCompiler let hash = sourceText.GetHashCode() |> int64 let key = (fileName, hash, options) - - let cachedResultsOpt = - parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) + let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) match cachedResultsOpt with | Some cachedResults -> @@ -746,17 +707,7 @@ type BackgroundCompiler match tcPrior.TryPeekTcInfo() with | Some tcInfo -> let! checkResults = - bc.CheckOneFileImpl( - parseResults, - sourceText, - fileName, - options, - fileVersion, - builder, - tcPrior, - tcInfo, - creationDiags - ) + bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return Some checkResults | None -> return None @@ -764,15 +715,7 @@ type BackgroundCompiler } /// Type-check the result obtained by parsing. Force the evaluation of the antecedent type checking context if needed. - member bc.CheckFileInProject - ( - parseResults: FSharpParseFileResults, - fileName, - fileVersion, - sourceText: ISourceText, - options, - userOpName - ) = + member bc.CheckFileInProject(parseResults: FSharpParseFileResults, fileName, fileVersion, sourceText: ISourceText, options, userOpName) = node { use _ = Activity.start @@ -786,8 +729,7 @@ type BackgroundCompiler let! builderOpt, creationDiags = getOrCreateBuilder (options, userOpName) match builderOpt with - | None -> - return FSharpCheckFileAnswer.Succeeded(FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) + | None -> return FSharpCheckFileAnswer.Succeeded(FSharpCheckFileResults.MakeEmpty(fileName, creationDiags, keepAssemblyContents)) | Some builder -> // Check the cache. We can only use cached results when there is no work to do to bring the background builder up-to-date let! cachedResults = bc.GetCachedCheckFileResult(builder, fileName, sourceText, options) @@ -797,30 +739,11 @@ type BackgroundCompiler | _ -> let! tcPrior = builder.GetCheckResultsBeforeFileInProject fileName let! tcInfo = tcPrior.GetOrComputeTcInfo() - - return! - bc.CheckOneFileImpl( - parseResults, - sourceText, - fileName, - options, - fileVersion, - builder, - tcPrior, - tcInfo, - creationDiags - ) + return! bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) } /// Parses and checks the source file and returns untyped AST and check results. - member bc.ParseAndCheckFileInProject - ( - fileName: string, - fileVersion, - sourceText: ISourceText, - options: FSharpProjectOptions, - userOpName - ) = + member bc.ParseAndCheckFileInProject(fileName: string, fileVersion, sourceText: ISourceText, options: FSharpProjectOptions, userOpName) = node { use _ = Activity.start @@ -849,11 +772,7 @@ type BackgroundCompiler let! tcInfo = tcPrior.GetOrComputeTcInfo() // Do the parsing. let parsingOptions = - FSharpParsingOptions.FromTcConfig( - builder.TcConfig, - Array.ofList builder.SourceFiles, - options.UseScriptResolutionRules - ) + FSharpParsingOptions.FromTcConfig(builder.TcConfig, Array.ofList builder.SourceFiles, options.UseScriptResolutionRules) GraphNode.SetPreferredUILang tcPrior.TcConfig.preferredUiLang @@ -872,17 +791,7 @@ type BackgroundCompiler FSharpParseFileResults(parseDiagnostics, parseTree, anyErrors, builder.AllDependenciesDeprecated) let! checkResults = - bc.CheckOneFileImpl( - parseResults, - sourceText, - fileName, - options, - fileVersion, - builder, - tcPrior, - tcInfo, - creationDiags - ) + bc.CheckOneFileImpl(parseResults, sourceText, fileName, options, fileVersion, builder, tcPrior, tcInfo, creationDiags) return (parseResults, checkResults) } @@ -1065,13 +974,7 @@ type BackgroundCompiler } /// Try to get recent approximate type check results for a file. - member _.TryGetRecentCheckResultsForFile - ( - fileName: string, - options: FSharpProjectOptions, - sourceText: ISourceText option, - _userOpName: string - ) = + member _.TryGetRecentCheckResultsForFile(fileName: string, options: FSharpProjectOptions, sourceText: ISourceText option, _userOpName: string) = use _ = Activity.start "BackgroundCompiler.GetSemanticClassificationForFile" @@ -1153,13 +1056,7 @@ type BackgroundCompiler options) let results = - FSharpCheckProjectResults( - options.ProjectFileName, - Some tcProj.TcConfig, - keepAssemblyContents, - diagnostics, - Some details - ) + FSharpCheckProjectResults(options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, diagnostics, Some details) return results } @@ -1243,8 +1140,7 @@ type BackgroundCompiler use diagnostics = new DiagnosticsScope(otherFlags |> Array.contains "--flaterrors") - let useSimpleResolution = - otherFlags |> Array.exists (fun x -> x = "--simpleresolution") + let useSimpleResolution = otherFlags |> Array.exists (fun x -> x = "--simpleresolution") let loadedTimeStamp = defaultArg loadedTimeStamp DateTime.MaxValue // Not 'now', we don't want to force reloading @@ -1302,13 +1198,7 @@ type BackgroundCompiler let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> - FSharpDiagnostic.CreateFromException( - exn, - isError, - range.Zero, - false, - options.OtherOptions |> Array.contains "--flaterrors" - )) + FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false, options.OtherOptions |> Array.contains "--flaterrors")) return options, (diags @ diagnostics.Diagnostics) } @@ -1332,8 +1222,7 @@ type BackgroundCompiler () member bc.ClearCache(options: seq, _userOpName) = - use _ = - Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] + use _ = Activity.start "BackgroundCompiler.ClearCache" [| Activity.Tags.userOpName, _userOpName |] lock gate (fun () -> options @@ -1509,8 +1398,7 @@ type FSharpChecker if keepAssemblyContents && enablePartialTypeChecking then invalidArg "enablePartialTypeChecking" "'keepAssemblyContents' and 'enablePartialTypeChecking' cannot be both enabled." - let parallelReferenceResolution = - inferParallelReferenceResolution parallelReferenceResolution + let parallelReferenceResolution = inferParallelReferenceResolution parallelReferenceResolution FSharpChecker( legacyReferenceResolver, @@ -1590,9 +1478,7 @@ type FSharpChecker member _.Compile(argv: string[], ?userOpName: string) = let _userOpName = defaultArg userOpName "Unknown" - - use _ = - Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] + use _ = Activity.start "FSharpChecker.Compile" [| Activity.Tags.userOpName, _userOpName |] async { let ctok = CompilationThreadToken() @@ -1894,8 +1780,7 @@ open FSharp.Compiler.DiagnosticsLogger type CompilerEnvironment() = /// Source file extensions - static let compilableExtensions = - FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes + static let compilableExtensions = FSharpSigFileSuffixes @ FSharpImplFileSuffixes @ FSharpScriptFileSuffixes /// Single file projects extensions static let singleFileProjectExtensions = FSharpScriptFileSuffixes From f21a87a59a397e15b82a3ad82f876da498a39e98 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 16:36:11 +0100 Subject: [PATCH 07/10] Revert more fantomas --- src/Compiler/Driver/CompilerDiagnostics.fs | 288 +++++---------------- 1 file changed, 68 insertions(+), 220 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 6135b7cb8c6..7e32d789119 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -439,56 +439,23 @@ module OldStyleMessages = do FSComp.SR.RunStartupValidation() let SeeAlsoE () = Message("SeeAlso", "%s") - - let ConstraintSolverTupleDiffLengthsE () = - Message("ConstraintSolverTupleDiffLengths", "%d%d") - - let ConstraintSolverInfiniteTypesE () = - Message("ConstraintSolverInfiniteTypes", "%s%s") - - let ConstraintSolverMissingConstraintE () = - Message("ConstraintSolverMissingConstraint", "%s") - - let ConstraintSolverTypesNotInEqualityRelation1E () = - Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") - - let ConstraintSolverTypesNotInEqualityRelation2E () = - Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") - - let ConstraintSolverTypesNotInSubsumptionRelationE () = - Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") - - let ErrorFromAddingTypeEquation1E () = - Message("ErrorFromAddingTypeEquation1", "%s%s%s") - - let ErrorFromAddingTypeEquation2E () = - Message("ErrorFromAddingTypeEquation2", "%s%s%s") - - let ErrorFromAddingTypeEquationTuplesE () = - Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s") - - let ErrorFromApplyingDefault1E () = - Message("ErrorFromApplyingDefault1", "%s") - - let ErrorFromApplyingDefault2E () = - Message("ErrorFromApplyingDefault2", "") - - let ErrorsFromAddingSubsumptionConstraintE () = - Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") - - let UpperCaseIdentifierInPatternE () = - Message("UpperCaseIdentifierInPattern", "") - + let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d") + let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s") + let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s") + let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") + let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") + let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") + let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") + let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") + let ErrorFromAddingTypeEquationTuplesE () = Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s") + let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") + let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") + let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") + let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "") let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "") - - let NotUpperCaseConstructorWithoutRQAE () = - Message("NotUpperCaseConstructorWithoutRQA", "") - + let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "") let FunctionExpectedE () = Message("FunctionExpected", "") - - let BakedInMemberConstraintNameE () = - Message("BakedInMemberConstraintName", "%s") - + let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s") let BadEventTransformationE () = Message("BadEventTransformation", "") let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "") let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s") @@ -500,25 +467,13 @@ module OldStyleMessages = let Duplicate2E () = Message("Duplicate2", "%s%s") let UndefinedName2E () = Message("UndefinedName2", "") let FieldNotMutableE () = Message("FieldNotMutable", "") - - let FieldsFromDifferentTypesE () = - Message("FieldsFromDifferentTypes", "%s%s") - + let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s") let VarBoundTwiceE () = Message("VarBoundTwice", "%s") let RecursionE () = Message("Recursion", "%s%s%s%s") - - let InvalidRuntimeCoercionE () = - Message("InvalidRuntimeCoercion", "%s%s%s") - - let IndeterminateRuntimeCoercionE () = - Message("IndeterminateRuntimeCoercion", "%s%s") - - let IndeterminateStaticCoercionE () = - Message("IndeterminateStaticCoercion", "%s%s") - - let StaticCoercionShouldUseBoxE () = - Message("StaticCoercionShouldUseBox", "%s%s") - + let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s") + let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s") + let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s") + let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s") let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "") let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s") let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s") @@ -531,25 +486,16 @@ module OldStyleMessages = let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "") let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "") let NONTERM_localBindingE () = Message("NONTERM.localBinding", "") - - let NONTERM_hardwhiteLetBindingsE () = - Message("NONTERM.hardwhiteLetBindings", "") - + let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "") let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "") let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "") let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "") let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "") let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "") let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "") - - let NONTERM_attrUnionCaseDeclE () = - Message("NONTERM.attrUnionCaseDecl", "") - + let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "") let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "") - - let NONTERM_objectImplementationMembersE () = - Message("NONTERM.objectImplementationMembers", "") - + let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "") let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "") let NONTERM_openDeclE () = Message("NONTERM.openDecl", "") let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "") @@ -562,112 +508,51 @@ module OldStyleMessages = let NONTERM_attributeListE () = Message("NONTERM.attributeList", "") let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "") let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "") - - let NONTERM_Category_ImplementationFileE () = - Message("NONTERM.Category.ImplementationFile", "") - - let NONTERM_Category_DefinitionE () = - Message("NONTERM.Category.Definition", "") - - let NONTERM_Category_SignatureFileE () = - Message("NONTERM.Category.SignatureFile", "") - + let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "") + let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "") + let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "") let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "") let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "") let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "") let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "") let TokenName1E () = Message("TokenName1", "%s") let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s") - - let TokenName1TokenName2TokenName3E () = - Message("TokenName1TokenName2TokenName3", "%s%s%s") - - let RuntimeCoercionSourceSealed1E () = - Message("RuntimeCoercionSourceSealed1", "%s") - - let RuntimeCoercionSourceSealed2E () = - Message("RuntimeCoercionSourceSealed2", "%s") - + let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s") + let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s") + let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s") let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s") let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "") let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "") - - let OverrideDoesntOverride1E () = - Message("OverrideDoesntOverride1", "%s") - - let OverrideDoesntOverride2E () = - Message("OverrideDoesntOverride2", "%s") - - let OverrideDoesntOverride3E () = - Message("OverrideDoesntOverride3", "%s") - - let OverrideDoesntOverride4E () = - Message("OverrideDoesntOverride4", "%s") - - let UnionCaseWrongArgumentsE () = - Message("UnionCaseWrongArguments", "%d%d") - - let UnionPatternsBindDifferentNamesE () = - Message("UnionPatternsBindDifferentNames", "") - - let RequiredButNotSpecifiedE () = - Message("RequiredButNotSpecified", "%s%s%s") - + let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s") + let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s") + let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s") + let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s") + let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d") + let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "") + let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s") let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "") let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s") - - let DeprecatedThreadStaticBindingWarningE () = - Message("DeprecatedThreadStaticBindingWarning", "") - - let FunctionValueUnexpectedE () = - Message("FunctionValueUnexpected", "%s") - + let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "") + let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s") let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s") - - let UnitTypeExpectedWithEqualityE () = - Message("UnitTypeExpectedWithEquality", "%s") - - let UnitTypeExpectedWithPossiblePropertySetterE () = - Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") - - let UnitTypeExpectedWithPossibleAssignmentE () = - Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") - - let UnitTypeExpectedWithPossibleAssignmentToMutableE () = - Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") - - let RecursiveUseCheckedAtRuntimeE () = - Message("RecursiveUseCheckedAtRuntime", "") - + let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s") + let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s") + let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s") + let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s") + let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "") let LetRecUnsound1E () = Message("LetRecUnsound1", "%s") let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s") let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s") - - let LetRecEvaluatedOutOfOrderE () = - Message("LetRecEvaluatedOutOfOrder", "") - + let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "") let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "") let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "") let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "") - - let VirtualAugmentationOnNullValuedTypeE () = - Message("VirtualAugmentationOnNullValuedType", "") - - let NonVirtualAugmentationOnNullValuedTypeE () = - Message("NonVirtualAugmentationOnNullValuedType", "") - - let NonUniqueInferredAbstractSlot1E () = - Message("NonUniqueInferredAbstractSlot1", "%s") - - let NonUniqueInferredAbstractSlot2E () = - Message("NonUniqueInferredAbstractSlot2", "") - - let NonUniqueInferredAbstractSlot3E () = - Message("NonUniqueInferredAbstractSlot3", "%s%s") - - let NonUniqueInferredAbstractSlot4E () = - Message("NonUniqueInferredAbstractSlot4", "") - + let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "") + let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "") + let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s") + let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "") + let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s") + let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "") let Failure3E () = Message("Failure3", "%s") let Failure4E () = Message("Failure4", "%s") let MatchIncomplete1E () = Message("MatchIncomplete1", "") @@ -693,63 +578,26 @@ module OldStyleMessages = let RecoverableParseErrorE () = Message("RecoverableParseError", "") let ReservedKeywordE () = Message("ReservedKeyword", "%s") let IndentationProblemE () = Message("IndentationProblem", "%s") - - let OverrideInIntrinsicAugmentationE () = - Message("OverrideInIntrinsicAugmentation", "") - - let OverrideInExtrinsicAugmentationE () = - Message("OverrideInExtrinsicAugmentation", "") - - let IntfImplInIntrinsicAugmentationE () = - Message("IntfImplInIntrinsicAugmentation", "") - - let IntfImplInExtrinsicAugmentationE () = - Message("IntfImplInExtrinsicAugmentation", "") - - let UnresolvedReferenceNoRangeE () = - Message("UnresolvedReferenceNoRange", "%s") - - let UnresolvedPathReferenceNoRangeE () = - Message("UnresolvedPathReferenceNoRange", "%s%s") - - let HashIncludeNotAllowedInNonScriptE () = - Message("HashIncludeNotAllowedInNonScript", "") - - let HashReferenceNotAllowedInNonScriptE () = - Message("HashReferenceNotAllowedInNonScript", "") - - let HashDirectiveNotAllowedInNonScriptE () = - Message("HashDirectiveNotAllowedInNonScript", "") - + let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "") + let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "") + let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "") + let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "") + let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s") + let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s") + let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "") + let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "") + let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "") let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s") let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s") - - let HashLoadedSourceHasIssues0E () = - Message("HashLoadedSourceHasIssues0", "") - - let HashLoadedSourceHasIssues1E () = - Message("HashLoadedSourceHasIssues1", "") - - let HashLoadedSourceHasIssues2E () = - Message("HashLoadedSourceHasIssues2", "") - - let HashLoadedScriptConsideredSourceE () = - Message("HashLoadedScriptConsideredSource", "") - - let InvalidInternalsVisibleToAssemblyName1E () = - Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") - - let InvalidInternalsVisibleToAssemblyName2E () = - Message("InvalidInternalsVisibleToAssemblyName2", "%s") - - let LoadedSourceNotFoundIgnoringE () = - Message("LoadedSourceNotFoundIgnoring", "%s") - - let MSBuildReferenceResolutionErrorE () = - Message("MSBuildReferenceResolutionError", "%s%s") - - let TargetInvocationExceptionWrapperE () = - Message("TargetInvocationExceptionWrapper", "%s") + let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "") + let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "") + let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "") + let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "") + let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s") + let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s") + let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s") + let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s") + let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s") #if DEBUG let mutable showParserStackOnParseError = false From 60bbcfd67762f8dcea1ab889c7b47bb36e3caa1d Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 18:33:23 +0100 Subject: [PATCH 08/10] Speedup `queryTrie` - don't memoize as that's costly, refactor the code --- .../GraphChecking/DependencyResolution.fs | 76 +++++++++++-------- .../GraphChecking/DependencyResolution.fsi | 2 +- .../TypeChecks/Graph/QueryTrieTests.fs | 2 +- 3 files changed, 46 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index de7a5cd883d..c787547071d 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -1,34 +1,47 @@ module internal FSharp.Compiler.GraphChecking.DependencyResolution -open FSharp.Compiler.IO open FSharp.Compiler.Syntax open Internal.Utilities.Library -/// Find a path in the Trie. -/// This function could be cached in future if performance is an issue. -let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = +/// Find a path from a starting TrieNode and return the end node or None +let queryTriePartial (trie: TrieNode) (path: LongIdentifier) : TrieNode option = let rec visit (currentNode: TrieNode) (path: LongIdentifier) = match path with // When we get through all partial identifiers, we've reached the node the full path points to. - | [] -> - if Set.isEmpty currentNode.Files then - QueryTrieNodeResult.NodeDoesNotExposeData - else - QueryTrieNodeResult.NodeExposesData(currentNode.Files) + | [] -> Some currentNode // More segments to get through | currentPath :: restPath -> match currentNode.Children.TryGetValue(currentPath) with - | false, _ -> QueryTrieNodeResult.NodeDoesNotExist + | false, _ -> None | true, childNode -> visit childNode restPath visit trie path -let queryTrieMemoized (trie: TrieNode) : QueryTrie = - Internal.Utilities.Library.Tables.memoize (queryTrie trie) +let mapNodeToQueryResult (node : TrieNode option) : QueryTrieNodeResult = + match node with + | Some finalNode -> + if Set.isEmpty finalNode.Files then + QueryTrieNodeResult.NodeDoesNotExposeData + else + QueryTrieNodeResult.NodeExposesData(finalNode.Files) + | None -> + QueryTrieNodeResult.NodeDoesNotExist + +/// Find a path in the Trie. +let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = + queryTriePartial trie path + |> mapNodeToQueryResult + +/// Same as 'queryTrie' but allows passing in a path combined from two parts, avoiding list allocation. +let queryTrieDual (trie: TrieNode) (path1: LongIdentifier) (path2: LongIdentifier) : QueryTrieNodeResult = + match queryTriePartial trie path1 with + | Some intermediateNode -> queryTriePartial intermediateNode path2 + | None -> None + |> mapNodeToQueryResult /// Process namespace declaration. -let processNamespaceDeclaration (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = - let queryResult = queryTrie path +let processNamespaceDeclaration (trie: TrieNode) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = + let queryResult = queryTrie trie path match queryResult with | QueryTrieNodeResult.NodeDoesNotExist -> state @@ -37,8 +50,8 @@ let processNamespaceDeclaration (queryTrie: QueryTrie) (path: LongIdentifier) (s /// Process an "open" statement. /// The statement could link to files and/or should be tracked as an open namespace. -let processOpenPath (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = - let queryResult = queryTrie path +let processOpenPath (trie: TrieNode) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = + let queryResult = queryTrie trie path match queryResult with | QueryTrieNodeResult.NodeDoesNotExist -> state @@ -46,9 +59,7 @@ let processOpenPath (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileCo | QueryTrieNodeResult.NodeExposesData files -> state.AddOpenNamespace(path, files) /// Process an identifier. -let processIdentifier (queryTrie: QueryTrie) (path: LongIdentifier) (state: FileContentQueryState) : FileContentQueryState = - let queryResult = queryTrie path - +let processIdentifier (queryResult : QueryTrieNodeResult) (state: FileContentQueryState) : FileContentQueryState = match queryResult with | QueryTrieNodeResult.NodeDoesNotExist -> state | QueryTrieNodeResult.NodeDoesNotExposeData -> @@ -58,26 +69,26 @@ let processIdentifier (queryTrie: QueryTrie) (path: LongIdentifier) (state: File | QueryTrieNodeResult.NodeExposesData files -> state.AddDependencies files /// Typically used to fold FileContentEntry items over a FileContentQueryState -let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) (entry: FileContentEntry) : FileContentQueryState = +let rec processStateEntry (trie: TrieNode) (state: FileContentQueryState) (entry: FileContentEntry) : FileContentQueryState = match entry with | FileContentEntry.TopLevelNamespace (topLevelPath, content) -> let state = match topLevelPath with | [] -> state - | _ -> processNamespaceDeclaration queryTrie topLevelPath state + | _ -> processNamespaceDeclaration trie topLevelPath state - List.fold (processStateEntry queryTrie) state content + List.fold (processStateEntry trie) state content | FileContentEntry.OpenStatement path -> // An open statement can directly reference file or be a partial open statement // Both cases need to be processed. - let stateAfterFullOpenPath = processOpenPath queryTrie path state + let stateAfterFullOpenPath = processOpenPath trie path state // Any existing open statement could be extended with the current path (if that node were to exists in the trie) // The extended path could add a new link (in case of a module or namespace with types) // It might also not add anything at all (in case the extended path is still a partial one) (stateAfterFullOpenPath, state.OpenNamespaces) - ||> Set.fold (fun acc openNS -> processOpenPath queryTrie [ yield! openNS; yield! path ] acc) + ||> Set.fold (fun acc openNS -> processOpenPath trie [ yield! openNS; yield! path ] acc) | FileContentEntry.PrefixedIdentifier path -> match path with @@ -90,15 +101,17 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) ||> Array.fold (fun state takeParts -> let path = List.take takeParts path // process the name was if it were a FQN - let stateAfterFullIdentifier = processIdentifier queryTrie path state + let stateAfterFullIdentifier = processIdentifier (queryTrieDual trie [] path) state // Process the name in combination with the existing open namespaces (stateAfterFullIdentifier, state.OpenNamespaces) - ||> Set.fold (fun acc openNS -> processIdentifier queryTrie [ yield! openNS; yield! path ] acc)) + ||> Set.fold (fun acc openNS -> + let queryResult = queryTrieDual trie openNS path + processIdentifier queryResult acc)) | FileContentEntry.NestedModule (nestedContent = nestedContent) -> // We don't want our current state to be affect by any open statements in the nested module - let nestedState = List.fold (processStateEntry queryTrie) state nestedContent + let nestedState = List.fold (processStateEntry trie) state nestedContent // Afterward we are only interested in the found dependencies in the nested module let foundDependencies = Set.union state.FoundDependencies nestedState.FoundDependencies @@ -122,11 +135,11 @@ let rec processStateEntry (queryTrie: QueryTrie) (state: FileContentQueryState) /// This function returns an array with a potential extra dependencies that makes sure that any such namespaces can be resolved (if they exists). /// For each unused namespace `open` we return at most one file that defines that namespace. /// -let collectGhostDependencies (fileIndex: FileIndex) (trie: TrieNode) (queryTrie: QueryTrie) (result: FileContentQueryState) = +let collectGhostDependencies (fileIndex: FileIndex) (trie: TrieNode) (result: FileContentQueryState) = // For each opened namespace, if none of already resolved dependencies define it, return the top-most file that defines it. Set.toArray result.OpenedNamespaces |> Array.choose (fun path -> - match queryTrie path with + match queryTrie trie path with | QueryTrieNodeResult.NodeExposesData _ | QueryTrieNodeResult.NodeDoesNotExist -> None | QueryTrieNodeResult.NodeDoesNotExposeData -> @@ -169,7 +182,6 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP | ParsedInput.SigFile _ -> Some f) let trie = TrieMapping.mkTrie trieInput - let queryTrie: QueryTrie = queryTrieMemoized trie let fileContents = files @@ -213,10 +225,10 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP let depsResult = initialDepsResult // Seq is faster than List in this case. - ||> Seq.fold (processStateEntry queryTrie) + ||> Seq.fold (processStateEntry trie) // Add missing links for cases where an unused open namespace did not create a link. - let ghostDependencies = collectGhostDependencies file.Idx trie queryTrie depsResult + let ghostDependencies = collectGhostDependencies file.Idx trie depsResult // Add a link from implementation files to their signature files. let signatureDependency = diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi b/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi index ef0bddec478..e754272edf0 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi @@ -8,7 +8,7 @@ val queryTrie: trie: TrieNode -> path: LongIdentifier -> QueryTrieNodeResult /// Process an open path (found in the ParsedInput) with a given FileContentQueryState. /// This code is only used directly in unit tests. val processOpenPath: - queryTrie: QueryTrie -> path: LongIdentifier -> state: FileContentQueryState -> FileContentQueryState + trie: TrieNode -> path: LongIdentifier -> state: FileContentQueryState -> FileContentQueryState /// /// Construct an approximate* dependency graph for files within a project, based on their ASTs. diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/QueryTrieTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/QueryTrieTests.fs index 0da67c406f6..1c06fe9dee2 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/QueryTrieTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/QueryTrieTests.fs @@ -807,7 +807,7 @@ let ``ProcessOpenStatement full path match`` () = Set.empty let result = - processOpenPath (queryTrie fantomasCoreTrie) [ "Fantomas"; "Core"; "AstExtensions" ] state + processOpenPath fantomasCoreTrie [ "Fantomas"; "Core"; "AstExtensions" ] state let dep = Seq.exactlyOne result.FoundDependencies Assert.AreEqual(indexOf "AstExtensions.fsi", dep) From 3098bc3bd2f3c132f380f34db5e2bf1889f9c2f8 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Sun, 18 Jun 2023 18:42:20 +0100 Subject: [PATCH 09/10] fantomas --- .../Driver/GraphChecking/DependencyResolution.fs | 12 +++++------- .../Driver/GraphChecking/DependencyResolution.fsi | 3 +-- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index c787547071d..4cf689963cb 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -17,21 +17,19 @@ let queryTriePartial (trie: TrieNode) (path: LongIdentifier) : TrieNode option = visit trie path -let mapNodeToQueryResult (node : TrieNode option) : QueryTrieNodeResult = +let mapNodeToQueryResult (node: TrieNode option) : QueryTrieNodeResult = match node with | Some finalNode -> if Set.isEmpty finalNode.Files then QueryTrieNodeResult.NodeDoesNotExposeData else QueryTrieNodeResult.NodeExposesData(finalNode.Files) - | None -> - QueryTrieNodeResult.NodeDoesNotExist + | None -> QueryTrieNodeResult.NodeDoesNotExist /// Find a path in the Trie. let queryTrie (trie: TrieNode) (path: LongIdentifier) : QueryTrieNodeResult = - queryTriePartial trie path - |> mapNodeToQueryResult - + queryTriePartial trie path |> mapNodeToQueryResult + /// Same as 'queryTrie' but allows passing in a path combined from two parts, avoiding list allocation. let queryTrieDual (trie: TrieNode) (path1: LongIdentifier) (path2: LongIdentifier) : QueryTrieNodeResult = match queryTriePartial trie path1 with @@ -59,7 +57,7 @@ let processOpenPath (trie: TrieNode) (path: LongIdentifier) (state: FileContentQ | QueryTrieNodeResult.NodeExposesData files -> state.AddOpenNamespace(path, files) /// Process an identifier. -let processIdentifier (queryResult : QueryTrieNodeResult) (state: FileContentQueryState) : FileContentQueryState = +let processIdentifier (queryResult: QueryTrieNodeResult) (state: FileContentQueryState) : FileContentQueryState = match queryResult with | QueryTrieNodeResult.NodeDoesNotExist -> state | QueryTrieNodeResult.NodeDoesNotExposeData -> diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi b/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi index e754272edf0..88d92de75a1 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fsi @@ -7,8 +7,7 @@ val queryTrie: trie: TrieNode -> path: LongIdentifier -> QueryTrieNodeResult /// Process an open path (found in the ParsedInput) with a given FileContentQueryState. /// This code is only used directly in unit tests. -val processOpenPath: - trie: TrieNode -> path: LongIdentifier -> state: FileContentQueryState -> FileContentQueryState +val processOpenPath: trie: TrieNode -> path: LongIdentifier -> state: FileContentQueryState -> FileContentQueryState /// /// Construct an approximate* dependency graph for files within a project, based on their ASTs. From 9a9672465ebd4f0155853d009e208729b62f51b5 Mon Sep 17 00:00:00 2001 From: Janusz Wrobel Date: Mon, 19 Jun 2023 08:53:52 +0100 Subject: [PATCH 10/10] Revert SDK update --- global.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/global.json b/global.json index b7b566d7112..59f2a3742c5 100644 --- a/global.json +++ b/global.json @@ -1,11 +1,11 @@ { "sdk": { - "version": "7.0.202", + "version": "7.0.203", "allowPrerelease": true, "rollForward": "latestPatch" }, "tools": { - "dotnet": "7.0.202", + "dotnet": "7.0.203", "vs": { "version": "17.5", "components": ["Microsoft.VisualStudio.Component.FSharp"]