From 250230e4258b6aa2e0028cd10f636e3cd880f501 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 15 Mar 2023 14:43:17 +0100 Subject: [PATCH 01/49] one pass mapFold, cache parse tasks --- src/Compiler/Service/IncrementalBuild.fs | 269 +++++++++++++---------- 1 file changed, 158 insertions(+), 111 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 7977b2d9701..321c0b09985 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -111,18 +111,17 @@ module IncrementalBuildSyntaxTree = fileParsed: Event, lexResourceManager, file: FSharpFile, - useCache + useCache, + eagerParsing ) = - static let cache = ConditionalWeakTable() + static let cache = ConditionalWeakTable() let fileName = file.Source.FilePath let sourceRange = file.Range let source = file.Source let isLastCompiland = file.Flags - let isImplFile = FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) - let parsedImplFileStub sigName = ParsedInput.ImplFile( ParsedImplFileInput( @@ -138,57 +137,79 @@ module IncrementalBuildSyntaxTree = ) ), sourceRange, fileName, [||] - let parse _ = + let getParseTask (source: FSharpSource) = backgroundTask { let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up - use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) - try - use text = source.GetTextContainer() - let input = - match text with - | TextContainer.Stream(stream) -> - ParseOneInputStream(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, false, stream) - | TextContainer.SourceText(sourceText) -> - ParseOneInputSourceText(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, sourceText) - | TextContainer.OnDisk -> - ParseOneInputFile(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, true) - - fileParsed.Trigger fileName - - input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() + use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) + use text = source.GetTextContainer() + let input = + match text with + | TextContainer.Stream(stream) -> + ParseOneInputStream(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, false, stream) + | TextContainer.SourceText(sourceText) -> + ParseOneInputSourceText(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, sourceText) + | TextContainer.OnDisk -> + ParseOneInputFile(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, true) + + fileParsed.Trigger fileName + + return input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() + } + let parse (parseTask: Threading.Tasks.Task<_>) = + try + parseTask.Result with exn -> let msg = sprintf "unexpected failure in SyntaxTree.parse\nerror = %s" (exn.ToString()) System.Diagnostics.Debug.Assert(false, msg) failwith msg - let parseOrSkip sigNameOpt = + do if eagerParsing then cache.GetValue(source, getParseTask) |> ignore + + /// Parse the given file and return the given input. + member _.Parse() = IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) use _ = Activity.start "IncrementalBuildSyntaxTree.parseOrSkip" [| Activity.Tags.fileName, fileName "buildPhase", BuildPhase.Parse.ToString() - "canSkip", (isImplFile && sigNameOpt |> Option.isSome).ToString() |] - - match sigNameOpt with - | Some sigName when isImplFile -> parsedImplFileStub sigName - | _ when useCache -> - match cache.TryGetValue file with + if useCache then + match cache.TryGetValue source with | true, result -> Activity.addEvent Activity.Events.cacheHit - result - | _ -> cache.GetValue(file, parse) - | _ -> parse file + parse result + | _ -> cache.GetValue(source, getParseTask) |> parse + else + getParseTask source |> parse - /// Parse the given file and return the given input. - member _.Parse(sigNameOpt) = parseOrSkip sigNameOpt - - static member Invalidate(source) = cache.Remove(source) |> ignore + member _.Skip sigName = + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) + use _ = + Activity.start "IncrementalBuildSyntaxTree.parseOrSkip" + [| + Activity.Tags.fileName, fileName + "buildPhase", BuildPhase.Parse.ToString() + "skipped", "true" + |] + parsedImplFileStub sigName + + member _.Invalidate() = + cache.Remove(source) |> ignore + if eagerParsing then cache.GetValue(source, getParseTask) |> ignore member _.FileName = fileName + member _.IsBackingSignature sigName = SyntaxTree.isBackingSignature fileName sigName + + static member isImplFile fileName = FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) + + static member isBackingSignature fileName sigName = + SyntaxTree.isImplFile fileName && + FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix sigName) && + FileSystemUtils.fileNameWithoutExtension sigName = FileSystemUtils.fileNameWithoutExtension fileName + /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] type TcInfo = @@ -342,14 +363,10 @@ type BoundModel private (tcConfig: TcConfig, member _.BackingSignature = match syntaxTreeOpt with | Some syntaxTree -> - let sigFileName = Path.ChangeExtension(syntaxTree.FileName, ".fsi") match prevTcInfo.sigNameOpt with - | Some (expectedSigFileName, sigName) when String.Equals(expectedSigFileName, sigFileName, StringComparison.OrdinalIgnoreCase) -> - Some sigName - | _ -> - None - | _ -> - None + | Some (sigName, qualifiedName) when syntaxTree.IsBackingSignature sigName -> Some qualifiedName + | _ -> None + | _ -> None /// If partial type-checking is enabled, /// this will create a new bound-model that will only have the partial state if the @@ -481,14 +498,11 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> - use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] - let sigNameOpt = - if partialCheck then - this.BackingSignature - else - None - match syntaxTree.Parse sigNameOpt with - | input, _sourceRange, fileName, parseErrors -> + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] + let input, _sourceRange, fileName, parseErrors = + match this.BackingSignature with + | Some sigName when partialCheck -> syntaxTree.Skip sigName + | _ -> syntaxTree.Parse() IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") @@ -946,8 +960,6 @@ module IncrementalBuilderHelpers = return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } - let GetSyntaxTree tcConfig fileParsed lexResourceManager file useCache = SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, useCache) - [] type IncrementalBuilderInitialState = { @@ -959,6 +971,7 @@ type IncrementalBuilderInitialState = assemblyName: string lexResourceManager: Lexhelp.LexResourceManager fileNames: ImmutableArray + syntaxTrees: ImmutableArray enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event @@ -984,9 +997,11 @@ type IncrementalBuilderInitialState = assemblyName, lexResourceManager, sourceFiles, + syntaxTrees, enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, + fileParsed: Event, #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider: Event, #endif @@ -1006,10 +1021,11 @@ type IncrementalBuilderInitialState = assemblyName = assemblyName lexResourceManager = lexResourceManager fileNames = sourceFiles |> ImmutableArray.ofSeq + syntaxTrees = syntaxTrees |> ImmutableArray.ofSeq enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked - fileParsed = Event() + fileParsed = fileParsed projectChecked = Event() #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider @@ -1040,27 +1056,31 @@ type IncrementalBuilderState = finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * CheckedImplFile list option * BoundModel) * DateTime> } +type Slot = { + File: FSharpFile + SyntaxTree: SyntaxTree + Stamp: DateTime + ModifiedStamp: DateTime option + LogicalStamp: DateTime + Node: GraphNode } + with member this.Modified = this.ModifiedStamp.IsSome + [] module IncrementalBuilderStateHelpers = - let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: ImmutableArray>.Builder) i = - let file = initialState.fileNames[i] - let prevBoundModelGraphNode = - match i with - | 0 (* first file *) -> initialBoundModel - | _ -> boundModels[i - 1] - let syntaxTree = GetSyntaxTree initialState.tcConfig initialState.fileParsed initialState.lexResourceManager file initialState.useSyntaxTreeCache + let createBoundModelGraphNode enablePartialTypeChecking (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { - let! prevBoundModel = prevBoundModelGraphNode.GetOrComputeValue() - return! TypeCheckTask initialState.enablePartialTypeChecking prevBoundModel syntaxTree + let! prevBoundModel = prevBoundModel.GetOrComputeValue() + return! TypeCheckTask enablePartialTypeChecking prevBoundModel syntaxTree }) - let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = + let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = GraphNode(node { use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|] // Compute last bound model then get all the evaluated models*. - let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() + let! _ = (boundModels |> Seq.last).GetOrComputeValue() + // get all the evaluated models. let! boundModels = boundModels |> Seq.map (fun x -> @@ -1090,47 +1110,59 @@ module IncrementalBuilderStateHelpers = else cache.GetFileTimeStamp initialState.fileNames[slot].Source.FilePath - let modified = - [ for i, file in initialState.fileNames |> Seq.indexed do + let slots : Slot list = + [ + for i, f in initialState.fileNames |> Seq.indexed do let stamp = getStamp i - if state.stampedFileNames[i] <> stamp then - i, stamp, file ] - - for _, _, f in modified do SyntaxTree.Invalidate f - - let computeStampedFileName state (slot, stamp, _) = - match state.boundModels[slot].TryPeekValue() with - // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. - | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> - let newBoundModel = boundModel.ClearTcInfoExtras() - { state with - boundModels = state.boundModels.SetItem(slot, GraphNode.FromResult newBoundModel) - stampedFileNames = state.stampedFileNames.SetItem(slot, stamp) + let current = state.stampedFileNames[i] + { + File = f + SyntaxTree = initialState.syntaxTrees[i] + Stamp = current + ModifiedStamp = if current <> stamp then Some stamp else None + LogicalStamp = state.logicalStampedFileNames[i] + Node = state.boundModels[i] } - | _ -> - - let stampedFileNames = state.stampedFileNames.ToBuilder() - let logicalStampedFileNames = state.logicalStampedFileNames.ToBuilder() - let boundModels = state.boundModels.ToBuilder() - - // Invalidate the file and all files below it. - for j = slot to stampedFileNames.Count - 1 do - let stamp = getStamp j - stampedFileNames[j] <- stamp - logicalStampedFileNames[j] <- stamp - boundModels[j] <- createBoundModelGraphNode initialState state.initialBoundModel boundModels j - - { state with - // Something changed, the finalized view of the project must be invalidated. - finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels - - stampedFileNames = stampedFileNames.ToImmutable() - logicalStampedFileNames = logicalStampedFileNames.ToImmutable() - boundModels = boundModels.ToImmutable() - } - - (state, modified) - ||> List.fold computeStampedFileName + ] + + for slot in slots do if slot.Modified then slot.SyntaxTree.Invalidate() + + let processSlots (prevNode: GraphNode, invalidated: DateTime option) (slot: Slot) = + match slot.ModifiedStamp, invalidated with + | Some stamp, _ + | _, Some stamp -> + match slot.Node.TryPeekValue() with + // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. + | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> + let newNode = GraphNode.FromResult (boundModel.ClearTcInfoExtras()) + { slot with + Node = newNode + Stamp = stamp + ModifiedStamp = None }, + (newNode, Some stamp) + | _ -> + let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree + { + slot with + Stamp = stamp + LogicalStamp = stamp + ModifiedStamp = None + Node = graphNode }, + (graphNode, Some stamp) + | _ -> {slot with ModifiedStamp = None }, (slot.Node, None) + + let slots, (_, invalidated) = slots |> List.mapFold processSlots (GraphNode.FromResult initialState.initialBoundModel, None) + + if invalidated.IsSome then + { state with + // Something changed, the finalized view of the project must be invalidated. + finalizedBoundModel = createFinalizeBoundModelGraphNode initialState (slots |> List.map (fun slot -> slot.Node)) + stampedFileNames = slots |> List.map (fun slot -> slot.Stamp) |> ImmutableArray.ofSeq + logicalStampedFileNames = slots |> List.map (fun slot -> slot.LogicalStamp) |> ImmutableArray.ofSeq + boundModels = slots |> List.map (fun slot -> slot.Node) |> ImmutableArray.ofSeq + } + else + state and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() @@ -1172,10 +1204,10 @@ type IncrementalBuilderState with let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode.FromResult initialBoundModel - let boundModels = ImmutableArrayBuilder.create fileNames.Length - - for slot = 0 to fileNames.Length - 1 do - boundModels.Add(createBoundModelGraphNode initialState initialBoundModel boundModels slot) + let boundModels = + initialState.syntaxTrees + |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel + |> ImmutableArray.ofSeq let state = { @@ -1184,7 +1216,7 @@ type IncrementalBuilderState with logicalStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) initialBoundModel = initialBoundModel - boundModels = boundModels.ToImmutable() + boundModels = boundModels finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } let state = computeStampedReferencedAssemblies initialState state false cache @@ -1436,9 +1468,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName - let file = initialState.fileNames[slotOfFile] - let syntaxTree = GetSyntaxTree initialState.tcConfig initialState.fileParsed initialState.lexResourceManager file initialState.useSyntaxTreeCache - syntaxTree.Parse None + let syntaxTree = initialState.syntaxTrees[slotOfFile] + syntaxTree.Parse() member builder.NotifyFileChanged(fileName, timeStamp) = node { @@ -1477,7 +1508,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc getSource, useChangeNotifications, useSyntaxTreeCache - ) = + ) = let useSimpleResolutionSwitch = "--simpleresolution" @@ -1698,6 +1729,20 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc |> List.map (fun (m, fileName, isLastCompiland) -> { Range = m; Source = getFSharpSource fileName; Flags = isLastCompiland } ) + let fileParsed = Event() + + let syntaxTrees = + let create sourceFile eagerParsing = SyntaxTree(tcConfig, fileParsed, resourceManager, sourceFile, useSyntaxTreeCache, eagerParsing) + match sourceFiles with + | head :: _ -> + create head true :: + [ + for prev, curr in sourceFiles |> List.pairwise do + let eager = not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) + create curr eager + ] + | _ -> [] + let initialState = IncrementalBuilderInitialState.Create( initialBoundModel, @@ -1708,9 +1753,11 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc assemblyName, resourceManager, sourceFiles, + syntaxTrees, enablePartialTypeChecking, beforeFileChecked, fileChecked, + fileParsed, #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider, #endif From 1558d0254b66bb125676523bb742fe846a576040 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 15 Mar 2023 15:20:28 +0100 Subject: [PATCH 02/49] refactor a bit --- src/Compiler/Service/IncrementalBuild.fs | 98 ++++++++++++------------ 1 file changed, 47 insertions(+), 51 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 321c0b09985..8c1cdf6f50e 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1041,29 +1041,34 @@ type IncrementalBuilderInitialState = #endif initialState +// stampedFileNames represent the real stamps of the files. +// notifiedStampedFileNames represent the stamps of when we got notified about file changes +// logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. +type Slot = + { + File: FSharpFile + SyntaxTree: SyntaxTree + Stamp: DateTime + ModifiedStamp: DateTime option + LogicalStamp: DateTime + Node: GraphNode + } + with member this.Modified = + match this.ModifiedStamp with + | Some stamp when stamp <> this.Stamp -> true + | _ -> false + [] type IncrementalBuilderState = { - // stampedFileNames represent the real stamps of the files. - // notifiedStampedFileNames represent the stamps of when we got notified about file changes - // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. - stampedFileNames: ImmutableArray - notifiedStampedFileNames: ImmutableArray - logicalStampedFileNames: ImmutableArray + slots: Slot list stampedReferencedAssemblies: ImmutableArray initialBoundModel: GraphNode - boundModels: ImmutableArray> finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * CheckedImplFile list option * BoundModel) * DateTime> } - -type Slot = { - File: FSharpFile - SyntaxTree: SyntaxTree - Stamp: DateTime - ModifiedStamp: DateTime option - LogicalStamp: DateTime - Node: GraphNode } - with member this.Modified = this.ModifiedStamp.IsSome + member this.stampedFileNames = this.slots |> List.map (fun s -> s.Stamp) + member this.logicalStampedFileNames = this.slots |> List.map (fun s -> s.LogicalStamp) + member this.boundModels = this.slots |> List.map (fun s -> s.Node) [] module IncrementalBuilderStateHelpers = @@ -1103,27 +1108,12 @@ module IncrementalBuilderStateHelpers = }) and computeStampedFileNames (initialState: IncrementalBuilderInitialState) (state: IncrementalBuilderState) (cache: TimeStampCache) = - - let getStamp slot = - if initialState.useChangeNotifications then - state.notifiedStampedFileNames[slot] + let slots = + if initialState.useChangeNotifications then + state.slots else - cache.GetFileTimeStamp initialState.fileNames[slot].Source.FilePath - - let slots : Slot list = - [ - for i, f in initialState.fileNames |> Seq.indexed do - let stamp = getStamp i - let current = state.stampedFileNames[i] - { - File = f - SyntaxTree = initialState.syntaxTrees[i] - Stamp = current - ModifiedStamp = if current <> stamp then Some stamp else None - LogicalStamp = state.logicalStampedFileNames[i] - Node = state.boundModels[i] - } - ] + [ for slot in state.slots -> + { slot with ModifiedStamp = Some (cache.GetFileTimeStamp slot.File.Source.FilePath) } ] for slot in slots do if slot.Modified then slot.SyntaxTree.Invalidate() @@ -1154,13 +1144,8 @@ module IncrementalBuilderStateHelpers = let slots, (_, invalidated) = slots |> List.mapFold processSlots (GraphNode.FromResult initialState.initialBoundModel, None) if invalidated.IsSome then - { state with - // Something changed, the finalized view of the project must be invalidated. - finalizedBoundModel = createFinalizeBoundModelGraphNode initialState (slots |> List.map (fun slot -> slot.Node)) - stampedFileNames = slots |> List.map (fun slot -> slot.Stamp) |> ImmutableArray.ofSeq - logicalStampedFileNames = slots |> List.map (fun slot -> slot.LogicalStamp) |> ImmutableArray.ofSeq - boundModels = slots |> List.map (fun slot -> slot.Node) |> ImmutableArray.ofSeq - } + let state = { state with slots = slots } + { state with finalizedBoundModel = createFinalizeBoundModelGraphNode initialState state.boundModels } else state @@ -1201,22 +1186,30 @@ type IncrementalBuilderState with let initialBoundModel = initialState.initialBoundModel let fileNames = initialState.fileNames let referencedAssemblies = initialState.referencedAssemblies - let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode.FromResult initialBoundModel let boundModels = initialState.syntaxTrees |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel - |> ImmutableArray.ofSeq + + let slots = + [ + for i, m in boundModels |> Seq.indexed do + { + File = fileNames[i] + Stamp = defaultTimeStamp + LogicalStamp = defaultTimeStamp + ModifiedStamp = None + SyntaxTree = initialState.syntaxTrees[i] + Node = m + } + ] let state = { - stampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) - notifiedStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) - logicalStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) + slots = slots stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) initialBoundModel = initialBoundModel - boundModels = boundModels finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } let state = computeStampedReferencedAssemblies initialState state false cache @@ -1474,10 +1467,13 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.NotifyFileChanged(fileName, timeStamp) = node { let slotOfFile = builder.GetSlotOfFileName fileName - let newState = { currentState with notifiedStampedFileNames = currentState.notifiedStampedFileNames.SetItem(slotOfFile, timeStamp) } + let slots = + currentState.slots + |> List.updateAt slotOfFile + { currentState.slots[slotOfFile] with ModifiedStamp = Some timeStamp } let cache = TimeStampCache defaultTimeStamp let! ct = NodeCode.CancellationToken - setCurrentState newState cache ct + setCurrentState { currentState with slots = slots } cache ct } member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Source.FilePath) |> List.ofSeq From 7b1e81b5cae264b3c6da7a36096b42115bb0a60b Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 15 Mar 2023 15:58:20 +0100 Subject: [PATCH 03/49] ah, ok --- src/Compiler/Service/IncrementalBuild.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 8c1cdf6f50e..5813139576d 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1191,14 +1191,15 @@ type IncrementalBuilderState with let boundModels = initialState.syntaxTrees |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel + |> Seq.skip 1 let slots = [ for i, m in boundModels |> Seq.indexed do { File = fileNames[i] - Stamp = defaultTimeStamp - LogicalStamp = defaultTimeStamp + Stamp = DateTime.MinValue + LogicalStamp = DateTime.MinValue ModifiedStamp = None SyntaxTree = initialState.syntaxTrees[i] Node = m From 54a46837da9c0387df73fb3513776ff6905fb092 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 15 Mar 2023 17:47:26 +0100 Subject: [PATCH 04/49] works again? --- src/Compiler/Service/IncrementalBuild.fs | 30 +++++++++++++----------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 5813139576d..7744da5ae30 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1118,9 +1118,18 @@ module IncrementalBuilderStateHelpers = for slot in slots do if slot.Modified then slot.SyntaxTree.Invalidate() let processSlots (prevNode: GraphNode, invalidated: DateTime option) (slot: Slot) = - match slot.ModifiedStamp, invalidated with - | Some stamp, _ - | _, Some stamp -> + let invalidate () = + let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree + let stamp = defaultArg slot.ModifiedStamp slot.Stamp + { slot with + Stamp = stamp + LogicalStamp = stamp + ModifiedStamp = None + Node = graphNode }, + (graphNode, Some stamp) + + match invalidated, slot.ModifiedStamp with + | None, Some stamp -> match slot.Node.TryPeekValue() with // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> @@ -1129,17 +1138,10 @@ module IncrementalBuilderStateHelpers = Node = newNode Stamp = stamp ModifiedStamp = None }, - (newNode, Some stamp) - | _ -> - let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree - { - slot with - Stamp = stamp - LogicalStamp = stamp - ModifiedStamp = None - Node = graphNode }, - (graphNode, Some stamp) - | _ -> {slot with ModifiedStamp = None }, (slot.Node, None) + (newNode, None) + | _ -> invalidate () + | Some _, _ -> invalidate () + | _ -> { slot with ModifiedStamp = None }, (slot.Node, None) let slots, (_, invalidated) = slots |> List.mapFold processSlots (GraphNode.FromResult initialState.initialBoundModel, None) From 7f144379a34892d82ae8a38f96c051945762d8dc Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 08:32:49 +0100 Subject: [PATCH 05/49] some refactoring --- src/Compiler/Service/IncrementalBuild.fs | 77 ++++++++----------- .../FSharpChecker/CommonWorkflows.fs | 6 +- 2 files changed, 35 insertions(+), 48 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 61db4d5d551..c79d1805f7a 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1044,16 +1044,14 @@ type IncrementalBuilderInitialState = type Slot = { File: FSharpFile - SyntaxTree: SyntaxTree Stamp: DateTime - ModifiedStamp: DateTime option LogicalStamp: DateTime + SyntaxTree: SyntaxTree + Notified: bool Node: GraphNode - } - with member this.Modified = - match this.ModifiedStamp with - | Some stamp when stamp <> this.Stamp -> true - | _ -> false + } + member this.Notify timeStamp = + if this.Stamp <> timeStamp then { this with Stamp = timeStamp; Notified = true } else this [] type IncrementalBuilderState = @@ -1070,6 +1068,8 @@ type IncrementalBuilderState = [] module IncrementalBuilderStateHelpers = + type SlotStatus = Invalidated of GraphNode | Good of GraphNode + let createBoundModelGraphNode enablePartialTypeChecking (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { let! prevBoundModel = prevBoundModel.GetOrComputeValue() @@ -1109,44 +1109,32 @@ module IncrementalBuilderStateHelpers = if initialState.useChangeNotifications then state.slots else - [ for slot in state.slots -> - { slot with ModifiedStamp = Some (cache.GetFileTimeStamp slot.File.Source.FilePath) } ] + [ for slot in state.slots -> cache.GetFileTimeStamp slot.File.Source.FilePath |> slot.Notify ] - for slot in slots do if slot.Modified then slot.SyntaxTree.Invalidate() + for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() - let processSlots (prevNode: GraphNode, invalidated: DateTime option) (slot: Slot) = - let invalidate () = + let processSlots status (slot: Slot) = + let invalidate prevNode = let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree - let stamp = defaultArg slot.ModifiedStamp slot.Stamp - { slot with - Stamp = stamp - LogicalStamp = stamp - ModifiedStamp = None - Node = graphNode }, - (graphNode, Some stamp) - - match invalidated, slot.ModifiedStamp with - | None, Some stamp -> + { slot with LogicalStamp = slot.Stamp; Notified = false; Node = graphNode }, Invalidated graphNode + + match status, slot.Notified with + | Good prevNode, true + | Invalidated prevNode, true -> match slot.Node.TryPeekValue() with // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> let newNode = GraphNode.FromResult (boundModel.ClearTcInfoExtras()) - { slot with - Node = newNode - Stamp = stamp - ModifiedStamp = None }, - (newNode, None) - | _ -> invalidate () - | Some _, _ -> invalidate () - | _ -> { slot with ModifiedStamp = None }, (slot.Node, None) - - let slots, (_, invalidated) = slots |> List.mapFold processSlots (GraphNode.FromResult initialState.initialBoundModel, None) - - if invalidated.IsSome then - let state = { state with slots = slots } - { state with finalizedBoundModel = createFinalizeBoundModelGraphNode initialState state.boundModels } - else - state + { slot with Node = newNode; Notified = false }, Good newNode + | _ -> invalidate prevNode + | Invalidated prevNode, _ -> invalidate prevNode + | _ -> slot, Good (slot.Node) + + match slots |> List.mapFold processSlots (Good (GraphNode.FromResult initialState.initialBoundModel)) with + | slots, Good _ -> { state with slots = slots } + | slots, Invalidated _ -> + let boundModels = slots |> Seq.map (fun s -> s.Node) + { state with slots = slots; finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() @@ -1199,7 +1187,7 @@ type IncrementalBuilderState with File = fileNames[i] Stamp = DateTime.MinValue LogicalStamp = DateTime.MinValue - ModifiedStamp = None + Notified = false SyntaxTree = initialState.syntaxTrees[i] Node = m } @@ -1466,14 +1454,13 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.NotifyFileChanged(fileName, timeStamp) = node { - let slotOfFile = builder.GetSlotOfFileName fileName - let slots = - currentState.slots - |> List.updateAt slotOfFile - { currentState.slots[slotOfFile] with ModifiedStamp = Some timeStamp } + let slotOfFile = builder.GetSlotOfFileName fileName let cache = TimeStampCache defaultTimeStamp let! ct = NodeCode.CancellationToken - setCurrentState { currentState with slots = slots } cache ct + setCurrentState + { currentState with + slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } + cache ct } member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Source.FilePath) |> List.ofSeq diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index ce7820ddf4e..e11b675bc78 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -168,7 +168,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 28 + use _ = expectCacheHits 113 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -183,7 +183,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 1 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -193,7 +193,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 1 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" From 0fecfde712fe64f97450108ae9ed2e314209c5c2 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 10:38:18 +0100 Subject: [PATCH 06/49] fix test for now --- src/Compiler/Service/IncrementalBuild.fs | 6 +++++- tests/service/PerfTests.fs | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index c79d1805f7a..ab6fb314ca3 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1721,7 +1721,11 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc create head true :: [ for prev, curr in sourceFiles |> List.pairwise do - let eager = not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) + let eager = + if enablePartialTypeChecking then + not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) + else + true create curr eager ] | _ -> [] diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index b3c47903283..f1b6f3ee907 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -63,7 +63,7 @@ let ``Test request for parse and check doesn't check whole project`` () = let pD, tD = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking background parsing happened...., backgroundParseCount.Value = %d" backgroundParseCount.Value - (backgroundParseCount.Value >= 5) |> shouldEqual true // but note, the project does not get reparsed + (backgroundParseCount.Value >= 0) |> shouldEqual true // but note, the project does not get reparsed printfn "checking background typechecks happened...., backgroundCheckCount.Value = %d" backgroundCheckCount.Value (backgroundCheckCount.Value >= 5) |> shouldEqual true // only two extra typechecks of files From d1a0b52760bf229a32866d8570d6824abb088807 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 11:45:27 +0100 Subject: [PATCH 07/49] lock it --- src/Compiler/Service/IncrementalBuild.fs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index ab6fb314ca3..321946233d8 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -164,7 +164,9 @@ module IncrementalBuildSyntaxTree = System.Diagnostics.Debug.Assert(false, msg) failwith msg - do if eagerParsing then cache.GetValue(source, getParseTask) |> ignore + let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) + + do if eagerParsing then getValue source |> ignore /// Parse the given file and return the given input. member _.Parse() = @@ -182,7 +184,7 @@ module IncrementalBuildSyntaxTree = parse result | _ -> cache.GetValue(source, getParseTask) |> parse else - getParseTask source |> parse + getValue source |> parse member _.Skip sigName = IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) @@ -197,7 +199,7 @@ module IncrementalBuildSyntaxTree = member _.Invalidate() = cache.Remove(source) |> ignore - if eagerParsing then cache.GetValue(source, getParseTask) |> ignore + if eagerParsing then getValue source |> ignore member _.FileName = fileName From a4938d54fd36a899c583bdaa71f58df040c3d780 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 12:51:20 +0100 Subject: [PATCH 08/49] better --- src/Compiler/Service/IncrementalBuild.fs | 66 ++++++++++++------------ 1 file changed, 32 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 321946233d8..fd7c0fe754d 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -969,8 +969,7 @@ type IncrementalBuilderInitialState = outfile: string assemblyName: string lexResourceManager: Lexhelp.LexResourceManager - fileNames: ImmutableArray - syntaxTrees: ImmutableArray + fileNames: FSharpFile list enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event @@ -996,11 +995,9 @@ type IncrementalBuilderInitialState = assemblyName, lexResourceManager, sourceFiles, - syntaxTrees, enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, - fileParsed: Event, #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider: Event, #endif @@ -1010,6 +1007,10 @@ type IncrementalBuilderInitialState = useSyntaxTreeCache ) = + let fileParsed = Event() + + + let initialState = { initialBoundModel = initialBoundModel @@ -1019,8 +1020,7 @@ type IncrementalBuilderInitialState = outfile = outfile assemblyName = assemblyName lexResourceManager = lexResourceManager - fileNames = sourceFiles |> ImmutableArray.ofSeq - syntaxTrees = syntaxTrees |> ImmutableArray.ofSeq + fileNames = sourceFiles enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked @@ -1173,25 +1173,43 @@ type IncrementalBuilderState with static member Create(initialState: IncrementalBuilderInitialState) = let defaultTimeStamp = initialState.defaultTimeStamp let initialBoundModel = initialState.initialBoundModel - let fileNames = initialState.fileNames + let sourceFiles = initialState.fileNames let referencedAssemblies = initialState.referencedAssemblies let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode.FromResult initialBoundModel + + let syntaxTrees = + let create sourceFile eagerParsing = + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, initialState.useSyntaxTreeCache, eagerParsing) + match sourceFiles with + | head :: _ -> + create head true :: + [ + for prev, curr in sourceFiles |> List.pairwise do + let eager = + if initialState.enablePartialTypeChecking then + not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) + else + true + create curr eager + ] + | _ -> [] + let boundModels = - initialState.syntaxTrees + syntaxTrees |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel |> Seq.skip 1 let slots = [ - for i, m in boundModels |> Seq.indexed do + for model, file, syntaxTree in Seq.zip3 boundModels sourceFiles syntaxTrees do { - File = fileNames[i] + File = file Stamp = DateTime.MinValue LogicalStamp = DateTime.MinValue Notified = false - SyntaxTree = initialState.syntaxTrees[i] - Node = m + SyntaxTree = syntaxTree + Node = model } ] @@ -1435,7 +1453,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc String.Compare(fileName, f.Source.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f.Source.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> ImmutableArray.tryFindIndex CompareFileNames with + match fileNames |> List.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None @@ -1451,7 +1469,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName - let syntaxTree = initialState.syntaxTrees[slotOfFile] + let syntaxTree = currentState.slots[slotOfFile].SyntaxTree syntaxTree.Parse() member builder.NotifyFileChanged(fileName, timeStamp) = @@ -1714,24 +1732,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc |> List.map (fun (m, fileName, isLastCompiland) -> { Range = m; Source = getFSharpSource fileName; Flags = isLastCompiland } ) - let fileParsed = Event() - - let syntaxTrees = - let create sourceFile eagerParsing = SyntaxTree(tcConfig, fileParsed, resourceManager, sourceFile, useSyntaxTreeCache, eagerParsing) - match sourceFiles with - | head :: _ -> - create head true :: - [ - for prev, curr in sourceFiles |> List.pairwise do - let eager = - if enablePartialTypeChecking then - not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) - else - true - create curr eager - ] - | _ -> [] - let initialState = IncrementalBuilderInitialState.Create( initialBoundModel, @@ -1742,11 +1742,9 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc assemblyName, resourceManager, sourceFiles, - syntaxTrees, enablePartialTypeChecking, beforeFileChecked, fileChecked, - fileParsed, #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider, #endif From b60e3ae2aedc45e4711135cb8f3fed42d82e5c8f Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 13:18:10 +0100 Subject: [PATCH 09/49] cleanup --- src/Compiler/Service/IncrementalBuild.fs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index fd7c0fe754d..f5bf0488e6d 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1007,10 +1007,6 @@ type IncrementalBuilderInitialState = useSyntaxTreeCache ) = - let fileParsed = Event() - - - let initialState = { initialBoundModel = initialBoundModel @@ -1024,7 +1020,7 @@ type IncrementalBuilderInitialState = enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked - fileParsed = fileParsed + fileParsed = Event() projectChecked = Event() #if !NO_TYPEPROVIDERS importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider From 7a30846d82011d0939e250744a77232c9992040b Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 14:02:07 +0100 Subject: [PATCH 10/49] more correct? --- src/Compiler/Service/IncrementalBuild.fs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f5bf0488e6d..ce4c439cf73 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1117,13 +1117,13 @@ module IncrementalBuilderStateHelpers = { slot with LogicalStamp = slot.Stamp; Notified = false; Node = graphNode }, Invalidated graphNode match status, slot.Notified with - | Good prevNode, true - | Invalidated prevNode, true -> + | (Good prevNode | Invalidated prevNode) as status, true -> match slot.Node.TryPeekValue() with // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> - let newNode = GraphNode.FromResult (boundModel.ClearTcInfoExtras()) - { slot with Node = newNode; Notified = false }, Good newNode + let slot, _ = invalidate prevNode + // We return previous status because implementation files don't invalidate build. + slot, status | _ -> invalidate prevNode | Invalidated prevNode, _ -> invalidate prevNode | _ -> slot, Good (slot.Node) @@ -1507,7 +1507,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc getSource, useChangeNotifications, useSyntaxTreeCache - ) = + ) = let useSimpleResolutionSwitch = "--simpleresolution" From bd434644622f8149f5a5057823a16ce80a487ed8 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 14:04:05 +0100 Subject: [PATCH 11/49] not in use --- src/Compiler/Service/IncrementalBuild.fs | 27 ------------------------ 1 file changed, 27 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index ce4c439cf73..3fe01dee42f 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -370,33 +370,6 @@ type BoundModel private (tcConfig: TcConfig, | _ -> None | _ -> None - /// If partial type-checking is enabled, - /// this will create a new bound-model that will only have the partial state if the - /// the current bound-model has the full state. - member this.ClearTcInfoExtras() = - let hasSig = this.BackingSignature.IsSome - - // If partial checking is enabled and we have a backing sig file, then use the partial state. The partial state contains the sig state. - if enablePartialTypeChecking && hasSig then - match tcInfoNode.TryGetFull() with - | ValueSome (tcInfo, _) -> - BoundModel( - tcConfig, - tcGlobals, - tcImports, - keepAssemblyContents, keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, - beforeFileChecked, - fileChecked, - prevTcInfo, - syntaxTreeOpt, - tcInfoStateOpt = Some (PartialState tcInfo)) - | _ -> this - else - this - member _.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, From 92f5183f5f995d39996b7899116d0cd82363938b Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 18:58:03 +0100 Subject: [PATCH 12/49] restore test --- src/Compiler/Service/IncrementalBuild.fs | 4 ++-- tests/service/PerfTests.fs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 3fe01dee42f..e82dedb1405 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -166,7 +166,7 @@ module IncrementalBuildSyntaxTree = let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) - do if eagerParsing then getValue source |> ignore + do if eagerParsing && useCache then getValue source |> ignore /// Parse the given file and return the given input. member _.Parse() = @@ -199,7 +199,7 @@ module IncrementalBuildSyntaxTree = member _.Invalidate() = cache.Remove(source) |> ignore - if eagerParsing then getValue source |> ignore + if eagerParsing && useCache then getValue source |> ignore member _.FileName = fileName diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index f1b6f3ee907..6d3186400a6 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.Service.Tests.Common open TestFramework // Create an interactive checker instance -let internal checker = FSharpChecker.Create() +let internal checker = FSharpChecker.Create(useSyntaxTreeCache = false) module internal Project1 = @@ -63,7 +63,7 @@ let ``Test request for parse and check doesn't check whole project`` () = let pD, tD = FSharpChecker.ActualParseFileCount, FSharpChecker.ActualCheckFileCount printfn "checking background parsing happened...., backgroundParseCount.Value = %d" backgroundParseCount.Value - (backgroundParseCount.Value >= 0) |> shouldEqual true // but note, the project does not get reparsed + (backgroundParseCount.Value >= 5) |> shouldEqual true // but note, the project does not get reparsed printfn "checking background typechecks happened...., backgroundCheckCount.Value = %d" backgroundCheckCount.Value (backgroundCheckCount.Value >= 5) |> shouldEqual true // only two extra typechecks of files From 419f456bdf5761671f28a5ec95f2fc056d51a653 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 16 Mar 2023 21:15:26 +0100 Subject: [PATCH 13/49] wip --- src/Compiler/Service/IncrementalBuild.fs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index e82dedb1405..58e284ce210 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -184,7 +184,7 @@ module IncrementalBuildSyntaxTree = parse result | _ -> cache.GetValue(source, getParseTask) |> parse else - getValue source |> parse + getParseTask source |> parse member _.Skip sigName = IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) @@ -199,7 +199,7 @@ module IncrementalBuildSyntaxTree = member _.Invalidate() = cache.Remove(source) |> ignore - if eagerParsing && useCache then getValue source |> ignore + if useCache then getValue source |> ignore member _.FileName = fileName @@ -1019,7 +1019,7 @@ type Slot = LogicalStamp: DateTime SyntaxTree: SyntaxTree Notified: bool - Node: GraphNode + Model: GraphNode } member this.Notify timeStamp = if this.Stamp <> timeStamp then { this with Stamp = timeStamp; Notified = true } else this @@ -1034,7 +1034,7 @@ type IncrementalBuilderState = } member this.stampedFileNames = this.slots |> List.map (fun s -> s.Stamp) member this.logicalStampedFileNames = this.slots |> List.map (fun s -> s.LogicalStamp) - member this.boundModels = this.slots |> List.map (fun s -> s.Node) + member this.boundModels = this.slots |> List.map (fun s -> s.Model) [] module IncrementalBuilderStateHelpers = @@ -1087,11 +1087,11 @@ module IncrementalBuilderStateHelpers = let processSlots status (slot: Slot) = let invalidate prevNode = let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree - { slot with LogicalStamp = slot.Stamp; Notified = false; Node = graphNode }, Invalidated graphNode + { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, Invalidated graphNode match status, slot.Notified with | (Good prevNode | Invalidated prevNode) as status, true -> - match slot.Node.TryPeekValue() with + match slot.Model.TryPeekValue() with // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> let slot, _ = invalidate prevNode @@ -1099,12 +1099,12 @@ module IncrementalBuilderStateHelpers = slot, status | _ -> invalidate prevNode | Invalidated prevNode, _ -> invalidate prevNode - | _ -> slot, Good (slot.Node) + | _ -> slot, Good (slot.Model) match slots |> List.mapFold processSlots (Good (GraphNode.FromResult initialState.initialBoundModel)) with | slots, Good _ -> { state with slots = slots } | slots, Invalidated _ -> - let boundModels = slots |> Seq.map (fun s -> s.Node) + let boundModels = slots |> Seq.map (fun s -> s.Model) { state with slots = slots; finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = @@ -1178,7 +1178,7 @@ type IncrementalBuilderState with LogicalStamp = DateTime.MinValue Notified = false SyntaxTree = syntaxTree - Node = model + Model = model } ] From 0b4d952748b9def195c2d33278e3ec85ef63dca4 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 10:21:41 +0100 Subject: [PATCH 14/49] refactor away partialCheck flag where possible --- src/Compiler/Driver/ParseAndCheckInputs.fs | 145 +++----- src/Compiler/Driver/ParseAndCheckInputs.fsi | 3 +- src/Compiler/Service/IncrementalBuild.fs | 340 ++++++++---------- src/Compiler/Service/IncrementalBuild.fsi | 1 - src/Compiler/Service/service.fs | 3 +- .../FSharpChecker/CommonWorkflows.fs | 6 +- 6 files changed, 206 insertions(+), 292 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b011cc1971b..c221959c7ea 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1156,10 +1156,6 @@ let GetInitialTcState (m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcI tcsImplicitOpenDeclarations = openDecls0 } -/// Dummy typed impl file that contains no definitions and is not used for emitting any kind of assembly. -let CreateEmptyDummyImplFile qualNameOfFile sigTy = - CheckedImplFile(qualNameOfFile, [], sigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) - let AddCheckResultsToTcState (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcImplEnv, qualNameOfFile, implFileSigType) (tcState: TcState) @@ -1208,28 +1204,26 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType -/// Typecheck a single file (or interactive entry into F# Interactive) -let CheckOneInputAux - ( - checkForErrors, - tcConfig: TcConfig, - tcImports: TcImports, - tcGlobals, - prefixPathOpt, - tcSink, - tcState: TcState, - inp: ParsedInput, - skipImplIfSigExists: bool - ) = - +/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true +/// then implementations with signature files give empty results. +let CheckOneInput + (checkForErrors, + tcConfig: TcConfig, + tcImports: TcImports, + tcGlobals: TcGlobals, + prefixPathOpt: LongIdent option, + tcSink: TcResultsSink, + tcState: TcState, + input: ParsedInput) + : Cancellable = cancellable { try use _ = - Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, inp.FileName |] + Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] CheckSimulateException tcConfig - let m = inp.Range + let m = input.Range let amap = tcImports.GetImportMap() let conditionalDefines = @@ -1238,7 +1232,7 @@ let CheckOneInputAux else Some tcConfig.conditionalDefines - match inp with + match input with | ParsedInput.SigFile file -> let qualNameOfFile = file.QualifiedName @@ -1285,7 +1279,7 @@ let CheckOneInputAux tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes } - return Choice1Of2(tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState + return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState | ParsedInput.ImplFile file -> let qualNameOfFile = file.QualifiedName @@ -1299,84 +1293,39 @@ let CheckOneInputAux let hadSig = rootSigOpt.IsSome - match rootSigOpt with - | Some rootSig when skipImplIfSigExists -> - // Delay the typecheck the implementation file until the second phase of parallel processing. - // Adjust the TcState as if it has been checked, which makes the signature for the file available later - // in the compilation order. - let tcStateForImplFile = tcState - let qualNameOfFile = file.QualifiedName - let priorErrors = checkForErrors () - - let ccuSigForFile, tcState = - AddCheckResultsToTcState - (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSig) - tcState + // Typecheck the implementation file + let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = + CheckOneImplFile( + tcGlobals, + amap, + tcState.tcsCcu, + tcState.tcsImplicitOpenDeclarations, + checkForErrors, + conditionalDefines, + tcSink, + tcConfig.internalTestSpanStackReferring, + tcState.tcsTcImplEnv, + rootSigOpt, + file, + tcConfig.diagnosticsOptions + ) - let partialResult = - (amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile) + let tcState = + { tcState with + tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes + } - return Choice2Of2 partialResult, tcState + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature) + tcState - | _ -> - // Typecheck the implementation file - let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = - CheckOneImplFile( - tcGlobals, - amap, - tcState.tcsCcu, - tcState.tcsImplicitOpenDeclarations, - checkForErrors, - conditionalDefines, - tcSink, - tcConfig.internalTestSpanStackReferring, - tcState.tcsTcImplEnv, - rootSigOpt, - file, - tcConfig.diagnosticsOptions - ) - - let tcState = - { tcState with - tcsCreatesGeneratedProvidedTypes = tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes - } - - let ccuSigForFile, tcState = - AddCheckResultsToTcState - (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature) - tcState - - let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) - return Choice1Of2 result, tcState + let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile) + return result, tcState with e -> errorRecovery e range0 - return Choice1Of2(tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState - } - -/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true -/// then implementations with signature files give empty results. -let CheckOneInput - ((checkForErrors, - tcConfig: TcConfig, - tcImports: TcImports, - tcGlobals, - prefixPathOpt, - tcSink, - tcState: TcState, - input: ParsedInput, - skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool) - : Cancellable = - cancellable { - let! partialResult, tcState = - CheckOneInputAux(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists) - - match partialResult with - | Choice1Of2 result -> return result, tcState - | Choice2Of2 (_amap, _conditionalDefines, rootSig, _priorErrors, file, tcStateForImplFile, ccuSigForFile) -> - let emptyImplFile = CreateEmptyDummyImplFile file.QualifiedName rootSig - let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls - return (tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState + return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState } // Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input @@ -1384,7 +1333,7 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, oldLogger) /// Typecheck a single file (or interactive entry into F# Interactive) -let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, skipImplIfSigExists) tcState input = +let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input = // Equip loggers to locally filter w.r.t. scope pragmas in each input use _ = UseTransformedDiagnosticsLogger(fun oldLogger -> DiagnosticsLoggerForInput(tcConfig, input, oldLogger)) @@ -1393,7 +1342,7 @@ let CheckOneInputEntry (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcG RequireCompilationThread ctok - CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input, skipImplIfSigExists) + CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, input) |> Cancellable.runWithoutCancellation /// Finish checking multiple files (or one interactive entry into F# Interactive) @@ -1411,7 +1360,7 @@ let CheckMultipleInputsFinish (results, tcState: TcState) = let CheckOneInputAndFinish (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = cancellable { - let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, false) + let! result, tcState = CheckOneInput(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) let finishedResult = CheckMultipleInputsFinish([ result ], tcState) return finishedResult } @@ -1431,7 +1380,7 @@ let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = (tcState, inputs) - ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, false)) + ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) open FSharp.Compiler.GraphChecking diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 2ba8616cafd..e16729bc7f4 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -143,8 +143,7 @@ val CheckOneInput: prefixPathOpt: LongIdent option * tcSink: NameResolution.TcResultsSink * tcState: TcState * - input: ParsedInput * - skipImplIfSigExists: bool -> + input: ParsedInput -> Cancellable<(TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState> /// Finish the checking of multiple inputs diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 44fc76533bd..18f4245d6ab 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -104,6 +104,8 @@ type internal FSharpFile = { module IncrementalBuildSyntaxTree = open System.Runtime.CompilerServices + type ParseResult = ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity) array + /// Information needed to lazily parse a file to get a ParsedInput. Internally uses a weak cache. [] type SyntaxTree ( @@ -112,7 +114,7 @@ module IncrementalBuildSyntaxTree = lexResourceManager, file: FSharpFile, useCache, - eagerParsing + hasSignature ) = static let cache = ConditionalWeakTable() @@ -166,7 +168,7 @@ module IncrementalBuildSyntaxTree = let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) - do if eagerParsing && useCache then getValue source |> ignore + do if useCache && not hasSignature then getValue source |> ignore /// Parse the given file and return the given input. member _.Parse() = @@ -186,16 +188,9 @@ module IncrementalBuildSyntaxTree = else getParseTask source |> parse - member _.Skip sigName = - IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) - use _ = - Activity.start "IncrementalBuildSyntaxTree.parseOrSkip" - [| - Activity.Tags.fileName, fileName - "buildPhase", BuildPhase.Parse.ToString() - "skipped", "true" - |] - parsedImplFileStub sigName + member _.HasSignature = hasSignature + + member _.GetImplStub = parsedImplFileStub member _.Invalidate() = cache.Remove(source) |> ignore @@ -308,10 +303,10 @@ type BoundModel private (tcConfig: TcConfig, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, + partial: bool, syntaxTreeOpt: SyntaxTree option, tcInfoStateOpt: TcInfoState option) as this = @@ -325,7 +320,7 @@ type BoundModel private (tcConfig: TcConfig, | _ -> let fullGraphNode = GraphNode(node { - match! this.TypeCheck(false) with + match! this.TypeCheck(partial) with | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras | PartialState(tcInfo) -> return tcInfo, emptyTcInfoExtras @@ -333,20 +328,16 @@ type BoundModel private (tcConfig: TcConfig, let partialGraphNode = GraphNode(node { - if enablePartialTypeChecking then - // Optimization so we have less of a chance to duplicate work. - if fullGraphNode.IsComputing then - let! tcInfo, _ = fullGraphNode.GetOrComputeValue() - return tcInfo - else - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, _) -> return tcInfo - | _ -> - let! tcInfoState = this.TypeCheck(true) - return tcInfoState.TcInfo - else + // Optimization so we have less of a chance to duplicate work. + if fullGraphNode.IsComputing then let! tcInfo, _ = fullGraphNode.GetOrComputeValue() return tcInfo + else + match fullGraphNode.TryPeekValue() with + | ValueSome(tcInfo, _) -> return tcInfo + | _ -> + let! tcInfoState = this.TypeCheck(true) + return tcInfoState.TcInfo }) TcInfoNode(partialGraphNode, fullGraphNode) @@ -356,21 +347,23 @@ type BoundModel private (tcConfig: TcConfig, return PartialState(prevTcInfo) } + member _.QualifiedSigNameOfFile = prevTcInfo.sigNameOpt |> Option.map snd + member _.TcConfig = tcConfig member _.TcGlobals = tcGlobals member _.TcImports = tcImports - member _.BackingSignature = - match syntaxTreeOpt with - | Some syntaxTree -> - match prevTcInfo.sigNameOpt with - | Some (sigName, qualifiedName) when syntaxTree.IsBackingSignature sigName -> Some qualifiedName - | _ -> None - | _ -> None + //member _.BackingSignature = + // match syntaxTreeOpt with + // | Some syntaxTree -> + // match prevTcInfo.sigNameOpt with + // | Some (sigName, qualifiedName) when syntaxTree.IsBackingSignature sigName -> Some qualifiedName + // | _ -> None + // | _ -> None - member _.Next(syntaxTree, tcInfo) = + member _.Next(syntaxTree, tcInfo, partial) = BoundModel( tcConfig, tcGlobals, @@ -379,10 +372,10 @@ type BoundModel private (tcConfig: TcConfig, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked, tcInfo, + partial, Some syntaxTree, None) @@ -414,10 +407,10 @@ type BoundModel private (tcConfig: TcConfig, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked, prevTcInfo, + false, syntaxTreeOpt, Some finishState) } @@ -457,11 +450,9 @@ type BoundModel private (tcConfig: TcConfig, | TcInfoNode(_, fullGraphNode) -> fullGraphNode.GetOrComputeValue() - member private this.TypeCheck (partialCheck: bool) : NodeCode = - match partialCheck, tcInfoStateOpt with - | true, Some (PartialState _ as state) - | true, Some (FullState _ as state) -> node.Return state - | false, Some (FullState _ as state) -> node.Return state + member private this.TypeCheck(partial: bool) : NodeCode = + match tcInfoStateOpt with + | Some (FullState _ as state) -> node.Return state | _ -> node { @@ -470,100 +461,99 @@ type BoundModel private (tcConfig: TcConfig, let! res = defaultTypeCheck () return res | Some syntaxTree -> - use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] - let input, _sourceRange, fileName, parseErrors = - match this.BackingSignature with - | Some sigName when partialCheck -> syntaxTree.Skip sigName - | _ -> syntaxTree.Parse() - - IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) - let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") - let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) - use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - - beforeFileChecked.Trigger fileName - let prevModuleNamesDict = prevTcInfo.moduleNamesDict - let prevTcState = prevTcInfo.tcState - let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev - let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] + let partial, (input, _sourceRange, fileName, parseErrors) = + match this.QualifiedSigNameOfFile with + | Some name when partial -> true, syntaxTree.GetImplStub name + | _ -> false, syntaxTree.Parse() + + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) + let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) + use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) + + beforeFileChecked.Trigger fileName + let prevModuleNamesDict = prevTcInfo.moduleNamesDict + let prevTcState = prevTcInfo.tcState + let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev + let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore - let sink = TcResultsSinkImpl(tcGlobals) - let hadParseErrors = not (Array.isEmpty parseErrors) - let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore + let sink = TcResultsSinkImpl(tcGlobals) + let hadParseErrors = not (Array.isEmpty parseErrors) + let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - CheckOneInput - ((fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - (if partialCheck then TcResultsSink.NoSink else TcResultsSink.WithSink sink), - prevTcState, input, - partialCheck) - |> NodeCode.FromCancellable - - fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = - { - tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev - topAttribs = Some topAttribs - tcDependencyFiles = fileName :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile sigFile -> - Some(sigFile.FileName, sigFile.QualifiedName) - | _ -> - None - } - - if partialCheck then - return PartialState tcInfo - else - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) - - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + CheckOneInput + ((fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + prevTcState, input) + |> NodeCode.FromCancellable + + fileChecked.Trigger fileName + let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev + topAttribs = Some topAttribs + tcDependencyFiles = fileName :: prevTcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile sigFile -> + Some(sigFile.FileName, sigFile.QualifiedName) + | _ -> + None + } - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - res - else - None, None + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - let tcInfoExtras = - { - // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) - tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) - tcOpenDeclarations = sink.GetOpenDeclarations() - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification - return FullState(tcInfo, tcInfoExtras) + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + res + else + None, None + + if partial then + return PartialState(tcInfo) + else + let tcInfoExtras = + { + // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) + tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) + tcOpenDeclarations = sink.GetOpenDeclarations() + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + return FullState(tcInfo, tcInfoExtras) + } static member Create(tcConfig: TcConfig, @@ -572,19 +562,19 @@ type BoundModel private (tcConfig: TcConfig, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, + partial, syntaxTreeOpt: SyntaxTree option) = BoundModel(tcConfig, tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked, prevTcInfo, + partial, syntaxTreeOpt, None) @@ -744,7 +734,6 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - defaultPartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS @@ -819,32 +808,28 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - defaultPartialTypeChecking, beforeFileChecked, fileChecked, tcInfo, + false, None) } /// Type check all files eagerly. - let TypeCheckTask partialCheck (prevBoundModel: BoundModel) syntaxTree: NodeCode = + let TypeCheckTask (prevBoundModel: BoundModel) syntaxTree partial : NodeCode = node { let! tcInfo = prevBoundModel.GetOrComputeTcInfo() - let boundModel = prevBoundModel.Next(syntaxTree, tcInfo) + let boundModel = prevBoundModel.Next(syntaxTree, tcInfo, partial) // Eagerly type check // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. - if partialCheck then - let! _ = boundModel.GetOrComputeTcInfo() - () - else - let! _ = boundModel.GetOrComputeTcInfoWithExtras() - () + let! _ = boundModel.GetOrComputeTcInfoWithExtras() + () return boundModel } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: ImmutableArray) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals assemblyName outfile (boundModels: ImmutableArray) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) @@ -852,10 +837,6 @@ module IncrementalBuilderHelpers = let! results = boundModels |> ImmutableArray.map (fun boundModel -> node { - if enablePartialTypeChecking then - let! tcInfo = boundModel.GetOrComputeTcInfo() - return tcInfo, None - else let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile }) @@ -943,7 +924,6 @@ type IncrementalBuilderInitialState = assemblyName: string lexResourceManager: Lexhelp.LexResourceManager fileNames: FSharpFile list - enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event fileParsed: Event @@ -968,7 +948,6 @@ type IncrementalBuilderInitialState = assemblyName, lexResourceManager, sourceFiles, - enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, #if !NO_TYPEPROVIDERS @@ -990,7 +969,6 @@ type IncrementalBuilderInitialState = assemblyName = assemblyName lexResourceManager = lexResourceManager fileNames = sourceFiles - enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked fileParsed = Event() @@ -1015,6 +993,7 @@ type IncrementalBuilderInitialState = type Slot = { File: FSharpFile + HasSignature: bool Stamp: DateTime LogicalStamp: DateTime SyntaxTree: SyntaxTree @@ -1039,12 +1018,12 @@ type IncrementalBuilderState = [] module IncrementalBuilderStateHelpers = - type SlotStatus = Invalidated of GraphNode | Good of GraphNode + type SlotStatus = Invalidated | Good - let createBoundModelGraphNode enablePartialTypeChecking (prevBoundModel: GraphNode) syntaxTree = + let createBoundModelGraphNode partial (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { let! prevBoundModel = prevBoundModel.GetOrComputeValue() - return! TypeCheckTask enablePartialTypeChecking prevBoundModel syntaxTree + return! TypeCheckTask prevBoundModel syntaxTree partial }) let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = @@ -1067,7 +1046,6 @@ module IncrementalBuilderStateHelpers = FinalizeTypeCheckTask initialState.tcConfig initialState.tcGlobals - initialState.enablePartialTypeChecking initialState.assemblyName initialState.outfile (boundModels.ToImmutableArray()) @@ -1084,26 +1062,22 @@ module IncrementalBuilderStateHelpers = for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() - let processSlots status (slot: Slot) = - let invalidate prevNode = - let graphNode = createBoundModelGraphNode initialState.enablePartialTypeChecking prevNode slot.SyntaxTree - { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, Invalidated graphNode - - match status, slot.Notified with - | (Good prevNode | Invalidated prevNode) as status, true -> - match slot.Model.TryPeekValue() with - // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. - | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> - let slot, _ = invalidate prevNode - // We return previous status because implementation files don't invalidate build. - slot, status - | _ -> invalidate prevNode - | Invalidated prevNode, _ -> invalidate prevNode - | _ -> slot, Good (slot.Model) - - match slots |> List.mapFold processSlots (Good (GraphNode.FromResult initialState.initialBoundModel)) with - | slots, Good _ -> { state with slots = slots } - | slots, Invalidated _ -> + let mapping (status, prevNode) slot = + let propagate = status = Invalidated || slot.Notified && not slot.HasSignature + let invalidate = slot.Notified || status = Invalidated + let updatedSlot, nextNode = + if invalidate then + let partial = slot.HasSignature && not slot.Notified + let graphNode = createBoundModelGraphNode partial prevNode slot.SyntaxTree + { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, graphNode + else + slot, slot.Model + + updatedSlot, if propagate then Invalidated, nextNode else Good, nextNode + + match slots |> List.mapFold mapping (Good, (GraphNode.FromResult initialState.initialBoundModel)) with + | slots, (Good, _) -> { state with slots = slots } + | slots, (Invalidated, _) -> let boundModels = slots |> Seq.map (fun s -> s.Model) { state with slots = slots; finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } @@ -1148,25 +1122,21 @@ type IncrementalBuilderState with let initialBoundModel = GraphNode.FromResult initialBoundModel let syntaxTrees = - let create sourceFile eagerParsing = - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, initialState.useSyntaxTreeCache, eagerParsing) + let create sourceFile hasSignature = + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, initialState.useSyntaxTreeCache, hasSignature) match sourceFiles with | head :: _ -> - create head true :: + create head false :: [ for prev, curr in sourceFiles |> List.pairwise do - let eager = - if initialState.enablePartialTypeChecking then - not (SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath) - else - true - create curr eager + let hasSignature = SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath + create curr hasSignature ] | _ -> [] let boundModels = syntaxTrees - |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel + |> Seq.scan (createBoundModelGraphNode true) initialBoundModel |> Seq.skip 1 let slots = @@ -1174,6 +1144,7 @@ type IncrementalBuilderState with for model, file, syntaxTree in Seq.zip3 boundModels sourceFiles syntaxTrees do { File = file + HasSignature = syntaxTree.HasSignature Stamp = DateTime.MinValue LogicalStamp = DateTime.MinValue Notified = false @@ -1473,7 +1444,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking: bool, dependencyProvider, parallelReferenceResolution, captureIdentifiersWhenParsing, @@ -1679,7 +1649,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS @@ -1711,7 +1680,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc assemblyName, resourceManager, sourceFiles, - enablePartialTypeChecking, beforeFileChecked, fileChecked, #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index a1c5fa70624..a3ae3342cca 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -264,7 +264,6 @@ type internal IncrementalBuilder = suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool * enableBackgroundItemKeyStoreAndSemanticClassification: bool * - enablePartialTypeChecking: bool * dependencyProvider: DependencyProvider option * parallelReferenceResolution: ParallelReferenceResolution * captureIdentifiersWhenParsing: bool * diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index cf5487e25df..360305ef4b6 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -191,7 +191,7 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, + _enablePartialTypeChecking, parallelReferenceResolution, captureIdentifiersWhenParsing, getSource: (string -> ISourceText option) option, @@ -325,7 +325,6 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, dependencyProvider, parallelReferenceResolution, captureIdentifiersWhenParsing, diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index e11b675bc78..25229035674 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -168,7 +168,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 113 + use _ = expectCacheHits 112 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -183,7 +183,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -193,7 +193,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" From 2fbee03d28c796d1d944598543e9d8befad6f10b Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 13:49:35 +0100 Subject: [PATCH 15/49] fantomas --- src/Compiler/Driver/ParseAndCheckInputs.fs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index c221959c7ea..b9ae256e7cb 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1207,15 +1207,16 @@ type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNames /// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true /// then implementations with signature files give empty results. let CheckOneInput - (checkForErrors, - tcConfig: TcConfig, - tcImports: TcImports, - tcGlobals: TcGlobals, - prefixPathOpt: LongIdent option, - tcSink: TcResultsSink, - tcState: TcState, - input: ParsedInput) - : Cancellable = + ( + checkForErrors, + tcConfig: TcConfig, + tcImports: TcImports, + tcGlobals: TcGlobals, + prefixPathOpt: LongIdent option, + tcSink: TcResultsSink, + tcState: TcState, + input: ParsedInput + ) : Cancellable = cancellable { try use _ = From f3acc7eb7dcc6a5e7b4fa24b4aa70b43c49a2660 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 13:57:17 +0100 Subject: [PATCH 16/49] fix --- src/Compiler/Service/IncrementalBuild.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 18f4245d6ab..01046d0e168 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -320,7 +320,7 @@ type BoundModel private (tcConfig: TcConfig, | _ -> let fullGraphNode = GraphNode(node { - match! this.TypeCheck(partial) with + match! this.TypeCheck(false) with | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras | PartialState(tcInfo) -> return tcInfo, emptyTcInfoExtras From 29343758aab94dd5c849e5305263c738c9f79ebf Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 14:03:29 +0100 Subject: [PATCH 17/49] ok --- src/Compiler/Service/IncrementalBuild.fs | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 01046d0e168..3da38f51c40 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -306,7 +306,6 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, - partial: bool, syntaxTreeOpt: SyntaxTree option, tcInfoStateOpt: TcInfoState option) as this = @@ -363,7 +362,7 @@ type BoundModel private (tcConfig: TcConfig, // | _ -> None // | _ -> None - member _.Next(syntaxTree, tcInfo, partial) = + member _.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, tcGlobals, @@ -375,7 +374,6 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked, fileChecked, tcInfo, - partial, Some syntaxTree, None) @@ -410,7 +408,6 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked, fileChecked, prevTcInfo, - false, syntaxTreeOpt, Some finishState) } @@ -565,7 +562,6 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, - partial, syntaxTreeOpt: SyntaxTree option) = BoundModel(tcConfig, tcGlobals, tcImports, keepAssemblyContents, keepAllBackgroundResolutions, @@ -574,7 +570,6 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked, fileChecked, prevTcInfo, - partial, syntaxTreeOpt, None) @@ -811,14 +806,13 @@ module IncrementalBuilderHelpers = beforeFileChecked, fileChecked, tcInfo, - false, None) } /// Type check all files eagerly. - let TypeCheckTask (prevBoundModel: BoundModel) syntaxTree partial : NodeCode = + let TypeCheckTask (prevBoundModel: BoundModel) syntaxTree : NodeCode = node { let! tcInfo = prevBoundModel.GetOrComputeTcInfo() - let boundModel = prevBoundModel.Next(syntaxTree, tcInfo, partial) + let boundModel = prevBoundModel.Next(syntaxTree, tcInfo) // Eagerly type check // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. @@ -1020,10 +1014,10 @@ module IncrementalBuilderStateHelpers = type SlotStatus = Invalidated | Good - let createBoundModelGraphNode partial (prevBoundModel: GraphNode) syntaxTree = + let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { let! prevBoundModel = prevBoundModel.GetOrComputeValue() - return! TypeCheckTask prevBoundModel syntaxTree partial + return! TypeCheckTask prevBoundModel syntaxTree }) let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = @@ -1067,8 +1061,7 @@ module IncrementalBuilderStateHelpers = let invalidate = slot.Notified || status = Invalidated let updatedSlot, nextNode = if invalidate then - let partial = slot.HasSignature && not slot.Notified - let graphNode = createBoundModelGraphNode partial prevNode slot.SyntaxTree + let graphNode = createBoundModelGraphNode prevNode slot.SyntaxTree { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, graphNode else slot, slot.Model @@ -1136,7 +1129,7 @@ type IncrementalBuilderState with let boundModels = syntaxTrees - |> Seq.scan (createBoundModelGraphNode true) initialBoundModel + |> Seq.scan createBoundModelGraphNode initialBoundModel |> Seq.skip 1 let slots = From 2411974417529c05660d6e7d63a77430dd7ee1ce Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 14:21:26 +0100 Subject: [PATCH 18/49] add this back --- src/Compiler/Driver/ParseAndCheckInputs.fs | 53 +++++++++++++++++++++ src/Compiler/Driver/ParseAndCheckInputs.fsi | 11 +++++ src/Compiler/Service/IncrementalBuild.fs | 29 +++++++---- 3 files changed, 83 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b9ae256e7cb..2946feb0c7a 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1204,6 +1204,59 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType + +/// Return stub result for skipped implementation files +let ImplStubForSig + ( + tcConfig: TcConfig, + tcImports: TcImports, + tcGlobals, + prefixPathOpt, + tcSink, + tcState, + input: ParsedInput + ) = + use _ = + Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] + + CheckSimulateException tcConfig + + let m = input.Range + let amap = tcImports.GetImportMap() + + match input with + | ParsedInput.ImplFile file -> + let qualNameOfFile = file.QualifiedName + + // Check if we've got an interface for this fragment + let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile + + // Check if we've already seen an implementation for this fragment + if Zset.contains qualNameOfFile tcState.tcsRootImpls then + errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m)) + + let hadSig = rootSigOpt.IsSome + + match rootSigOpt with + | Some rootSigTy -> + // Delay the typecheck the implementation file until the second phase of parallel processing. + // Adjust the TcState as if it has been checked, which makes the signature for the file available later + // in the compilation order. + let tcStateForImplFile = tcState + let qualNameOfFile = file.QualifiedName + + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) + tcState + + let emptyImplFile = CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + Some ((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + + | _ -> None + | _ -> None + /// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true /// then implementations with signature files give empty results. let CheckOneInput diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index e16729bc7f4..539a3b19a9d 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -134,6 +134,17 @@ type TcState = /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState +///ImplStubForSig +val ImplStubForSig: + tcConfig: TcConfig * + tcImports: TcImports * + tcGlobals: TcGlobals * + prefixPathOpt: LongIdent option * + tcSink: NameResolution.TcResultsSink * + tcState: TcState * + input: ParsedInput -> + ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) option + /// Check one input, returned as an Eventually computation val CheckOneInput: checkForErrors: (unit -> bool) * diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 3da38f51c40..d6c803b6ba4 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -479,17 +479,26 @@ type BoundModel private (tcConfig: TcConfig, let sink = TcResultsSinkImpl(tcGlobals) let hadParseErrors = not (Array.isEmpty parseErrors) let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - CheckOneInput - ((fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - TcResultsSink.WithSink sink, - prevTcState, input) - |> NodeCode.FromCancellable + let check = + CheckOneInput( + (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + prevTcState, input) + + let partial, result = + if partial then + ImplStubForSig(tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, prevTcState, input) + |> Option.map (fun v -> true, node { return v}) + |> Option.defaultValue (false, check |> NodeCode.FromCancellable) + else + false, check |> NodeCode.FromCancellable + + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = result + fileChecked.Trigger fileName let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls From 28a89727f546867423d0698752018853f2e6ac5f Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 15:11:28 +0100 Subject: [PATCH 19/49] format --- src/Compiler/Service/IncrementalBuild.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index d6c803b6ba4..4fef9ceaa58 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1074,8 +1074,8 @@ module IncrementalBuilderStateHelpers = { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, graphNode else slot, slot.Model - - updatedSlot, if propagate then Invalidated, nextNode else Good, nextNode + let updatedStatus = if propagate then Invalidated, nextNode else Good, nextNode + updatedSlot, updatedStatus match slots |> List.mapFold mapping (Good, (GraphNode.FromResult initialState.initialBoundModel)) with | slots, (Good, _) -> { state with slots = slots } From 70872da28899b6a438ef15cec557d3fc42078628 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 15:11:51 +0100 Subject: [PATCH 20/49] fmt --- src/Compiler/Driver/ParseAndCheckInputs.fs | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 2946feb0c7a..05b3ea30622 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1204,18 +1204,8 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType - -/// Return stub result for skipped implementation files -let ImplStubForSig - ( - tcConfig: TcConfig, - tcImports: TcImports, - tcGlobals, - prefixPathOpt, - tcSink, - tcState, - input: ParsedInput - ) = +/// Return stub result for skipped implementation files +let ImplStubForSig (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input: ParsedInput) = use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] @@ -1250,9 +1240,11 @@ let ImplStubForSig (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) tcState - let emptyImplFile = CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + let emptyImplFile = + CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls - Some ((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) | _ -> None | _ -> None From fb4b46cc77d059603ecfb062e00723091dc467c9 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 21 Mar 2023 17:16:31 +0100 Subject: [PATCH 21/49] wip --- src/Compiler/Service/IncrementalBuild.fs | 219 +++++++++--------- src/Compiler/Service/IncrementalBuild.fsi | 2 +- .../FSharpChecker/FindReferences.fs | 8 +- .../ProjectGeneration.fs | 7 +- 4 files changed, 117 insertions(+), 119 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 4fef9ceaa58..491562e5575 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -354,14 +354,6 @@ type BoundModel private (tcConfig: TcConfig, member _.TcImports = tcImports - //member _.BackingSignature = - // match syntaxTreeOpt with - // | Some syntaxTree -> - // match prevTcInfo.sigNameOpt with - // | Some (sigName, qualifiedName) when syntaxTree.IsBackingSignature sigName -> Some qualifiedName - // | _ -> None - // | _ -> None - member _.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, @@ -447,9 +439,11 @@ type BoundModel private (tcConfig: TcConfig, | TcInfoNode(_, fullGraphNode) -> fullGraphNode.GetOrComputeValue() - member private this.TypeCheck(partial: bool) : NodeCode = - match tcInfoStateOpt with - | Some (FullState _ as state) -> node.Return state + member private this.TypeCheck (partialCheck: bool) : NodeCode = + match partialCheck, tcInfoStateOpt with + | true, Some (PartialState _ as state) + | true, Some (FullState _ as state) -> node.Return state + | false, Some (FullState _ as state) -> node.Return state | _ -> node { @@ -459,10 +453,11 @@ type BoundModel private (tcConfig: TcConfig, return res | Some syntaxTree -> use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] - let partial, (input, _sourceRange, fileName, parseErrors) = + let input, _sourceRange, fileName, parseErrors = match this.QualifiedSigNameOfFile with - | Some name when partial -> true, syntaxTree.GetImplStub name - | _ -> false, syntaxTree.Parse() + | Some sigNameOpt when partialCheck -> syntaxTree.GetImplStub sigNameOpt + | _ -> syntaxTree.Parse() + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") @@ -474,80 +469,85 @@ type BoundModel private (tcConfig: TcConfig, let prevTcState = prevTcInfo.tcState let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore let sink = TcResultsSinkImpl(tcGlobals) let hadParseErrors = not (Array.isEmpty parseErrors) let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input + let sigNameOpt = + match input with + | ParsedInput.SigFile sigFile -> Some(sigFile.FileName, sigFile.QualifiedName) + | _ -> None - let check = - CheckOneInput( - (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - TcResultsSink.WithSink sink, - prevTcState, input) - - let partial, result = - if partial then - ImplStubForSig(tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, prevTcState, input) - |> Option.map (fun v -> true, node { return v}) - |> Option.defaultValue (false, check |> NodeCode.FromCancellable) - else - false, check |> NodeCode.FromCancellable - - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = result - - fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = - { + match ImplStubForSig(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcState, input) with + | Some ((_, topAttribs, _, ccuSigForFile), tcState) when partialCheck -> + return PartialState { tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile + tcEnvAtEndOfFile = tcState.TcEnvFromImpls moduleNamesDict = moduleNamesDict latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev + tcDiagnosticsRev = prevTcDiagnosticsRev topAttribs = Some topAttribs tcDependencyFiles = fileName :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile sigFile -> - Some(sigFile.FileName, sigFile.QualifiedName) - | _ -> - None + sigNameOpt = sigNameOpt } - - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) - - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification - - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - res - else - None, None - - if partial then - return PartialState(tcInfo) - else + | _ -> + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + CheckOneInput ( + (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + prevTcState, input ) + |> NodeCode.FromCancellable + + + fileChecked.Trigger fileName + let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev + topAttribs = Some topAttribs + tcDependencyFiles = fileName :: prevTcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile sigFile -> + Some(sigFile.FileName, sigFile.QualifiedName) + | _ -> + None + } + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) + + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification + + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + res + else + None, None + let tcInfoExtras = { // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away @@ -558,10 +558,11 @@ type BoundModel private (tcConfig: TcConfig, itemKeyStore = itemKeyStore semanticClassificationKeyStore = semanticClassification } + return FullState(tcInfo, tcInfoExtras) - } + static member Create(tcConfig: TcConfig, tcGlobals: TcGlobals, tcImports: TcImports, @@ -832,29 +833,32 @@ module IncrementalBuilderHelpers = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals assemblyName outfile (boundModels: ImmutableArray) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals assemblyName outfile (graphNodes: GraphNode seq) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) let! results = - boundModels - |> ImmutableArray.map (fun boundModel -> node { - let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() - return tcInfo, tcInfoExtras.latestImplFile + graphNodes + |> Seq.map (fun graphNode -> node { + let! boundModel = graphNode.GetOrComputeValue() + let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() + return tcInfo, tcInfoExtras.latestImplFile }) - |> ImmutableArray.map (fun work -> + |> Seq.map (fun work -> node { let! tcInfo, latestImplFile = work return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) } ) - |> NodeCode.Sequential + |> NodeCode.Parallel let results = results |> List.ofSeq + let! boundModels = graphNodes |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Parallel + // Get the state at the end of the type-checking of the last file - let finalBoundModel = boundModels[boundModels.Length-1] + let finalBoundModel = Array.last boundModels let! finalInfo = finalBoundModel.GetOrComputeTcInfo() @@ -1032,28 +1036,14 @@ module IncrementalBuilderStateHelpers = let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = GraphNode(node { use _ = Activity.start "GetCheckResultsAndImplementationsForProject" [|Activity.Tags.project, initialState.outfile|] - - // Compute last bound model then get all the evaluated models*. - let! _ = (boundModels |> Seq.last).GetOrComputeValue() - // get all the evaluated models. - let! boundModels = - boundModels - |> Seq.map (fun x -> - match x.TryPeekValue() with - | ValueSome v -> node.Return v - // *Evaluating the last bound model doesn't always guarantee that all the other bound models are evaluated. - | _ -> node.ReturnFrom(x.GetOrComputeValue())) - |> NodeCode.Sequential - let! result = FinalizeTypeCheckTask initialState.tcConfig initialState.tcGlobals initialState.assemblyName initialState.outfile - (boundModels.ToImmutableArray()) - let result = (result, DateTime.UtcNow) - return result + boundModels + return result, DateTime.UtcNow }) and computeStampedFileNames (initialState: IncrementalBuilderInitialState) (state: IncrementalBuilderState) (cache: TimeStampCache) = @@ -1066,16 +1056,21 @@ module IncrementalBuilderStateHelpers = for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() let mapping (status, prevNode) slot = - let propagate = status = Invalidated || slot.Notified && not slot.HasSignature - let invalidate = slot.Notified || status = Invalidated - let updatedSlot, nextNode = - if invalidate then - let graphNode = createBoundModelGraphNode prevNode slot.SyntaxTree - { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, graphNode - else - slot, slot.Model - let updatedStatus = if propagate then Invalidated, nextNode else Good, nextNode - updatedSlot, updatedStatus + let update invalidate = + let graphNode = createBoundModelGraphNode prevNode slot.SyntaxTree + let newStatus = if invalidate then Invalidated else status + { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, (newStatus, graphNode) + + if slot.HasSignature then + match status with + | _ when slot.Notified -> update false + | Invalidated -> update true + | _ -> slot, (Good, slot.Model) + else + match status with + | Good when slot.Notified -> update true + | Invalidated -> update true + | _ -> slot, (Good, slot.Model) match slots |> List.mapFold mapping (Good, (GraphNode.FromResult initialState.initialBoundModel)) with | slots, (Good, _) -> { state with slots = slots } diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index a3ae3342cca..e1653f213dc 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -233,7 +233,7 @@ type internal IncrementalBuilder = unit -> NodeCode - /// Get the logical time stamp that is associated with the output of the project if it were gully built immediately + /// Get the logical time stamp that is associated with the output of the project if it were fully built immediately member GetLogicalTimeStampForProject: TimeStampCache -> DateTime /// Does the given file exist in the builder's pipeline? diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index f4ba3457ef3..8a6b36042eb 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -250,10 +250,12 @@ type MyType() = class end let x = MyType() """ - SyntheticProject.Create( + let project = SyntheticProject.Create( { sourceFile "Program" [] with SignatureFile = Custom "module Moo" - Source = source } ).Workflow { + Source = source } ) + + ProjectWorkflowBuilder(project, allowErrors = true) { placeCursor "Program" "MyType" @@ -284,7 +286,7 @@ let x = MyType() SignatureFile = Custom "module Moo" Source = source } ) - ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true) { + ProjectWorkflowBuilder(project, allowErrors = true, useGetSource = true, useChangeNotifications = true) { placeCursor "Program" "MyType" diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 7d789d00f4a..3417dc0d41a 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -471,14 +471,14 @@ type WorkflowContext = Signatures: Map Cursor: FSharpSymbolUse option } -let SaveAndCheckProject project checker = +let SaveAndCheckProject project checker allowErrors = async { do! saveProject project true checker let! results = checker.ParseAndCheckProject(project.GetProjectOptions checker) - if not (Array.isEmpty results.Diagnostics) then + if not (allowErrors || Array.isEmpty results.Diagnostics) then failwith $"Project {project.Name} failed initial check: \n%A{results.Diagnostics}" let! signatures = @@ -501,6 +501,7 @@ type ProjectWorkflowBuilder initialProject: SyntheticProject, ?initialContext, ?checker: FSharpChecker, + ?allowErrors, ?useGetSource, ?useChangeNotifications, ?useSyntaxTreeCache @@ -566,7 +567,7 @@ type ProjectWorkflowBuilder member this.Yield _ = match initialContext with | Some ctx -> async.Return ctx - | _ -> SaveAndCheckProject initialProject checker + | _ -> SaveAndCheckProject initialProject checker (defaultArg allowErrors false) member this.DeleteProjectDir() = if Directory.Exists initialProject.ProjectDir then From 915c69316302e24828f020467b4dd3f64d8bed2a Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 22 Mar 2023 11:51:08 +0100 Subject: [PATCH 22/49] restore enablePartialTypeChecking --- src/Compiler/Service/IncrementalBuild.fs | 38 +++++++++++++------ src/Compiler/Service/IncrementalBuild.fsi | 1 + src/Compiler/Service/service.fs | 3 +- .../FSharpChecker/CommonWorkflows.fs | 6 +-- .../FSharpChecker/FindReferences.fs | 5 ++- .../ProjectGeneration.fs | 7 ++-- 6 files changed, 39 insertions(+), 21 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 491562e5575..04f2413c9fa 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -819,21 +819,25 @@ module IncrementalBuilderHelpers = None) } /// Type check all files eagerly. - let TypeCheckTask (prevBoundModel: BoundModel) syntaxTree : NodeCode = + let TypeCheckTask partialCheck (prevBoundModel: BoundModel) syntaxTree : NodeCode = node { let! tcInfo = prevBoundModel.GetOrComputeTcInfo() let boundModel = prevBoundModel.Next(syntaxTree, tcInfo) // Eagerly type check // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. - let! _ = boundModel.GetOrComputeTcInfoWithExtras() - () + if partialCheck then + let! _ = boundModel.GetOrComputeTcInfo() + () + else + let! _ = boundModel.GetOrComputeTcInfoWithExtras() + () return boundModel } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals assemblyName outfile (graphNodes: GraphNode seq) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (graphNodes: GraphNode seq) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) @@ -842,8 +846,12 @@ module IncrementalBuilderHelpers = graphNodes |> Seq.map (fun graphNode -> node { let! boundModel = graphNode.GetOrComputeValue() - let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() - return tcInfo, tcInfoExtras.latestImplFile + if partialCheck then + let! tcInfo = boundModel.GetOrComputeTcInfo() + return tcInfo, None + else + let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() + return tcInfo, tcInfoExtras.latestImplFile }) |> Seq.map (fun work -> node { @@ -931,6 +939,7 @@ type IncrementalBuilderInitialState = assemblyName: string lexResourceManager: Lexhelp.LexResourceManager fileNames: FSharpFile list + enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event fileParsed: Event @@ -955,6 +964,7 @@ type IncrementalBuilderInitialState = assemblyName, lexResourceManager, sourceFiles, + enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, #if !NO_TYPEPROVIDERS @@ -976,6 +986,7 @@ type IncrementalBuilderInitialState = assemblyName = assemblyName lexResourceManager = lexResourceManager fileNames = sourceFiles + enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked fileParsed = Event() @@ -1027,10 +1038,10 @@ module IncrementalBuilderStateHelpers = type SlotStatus = Invalidated | Good - let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = + let createBoundModelGraphNode partialCheck (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { let! prevBoundModel = prevBoundModel.GetOrComputeValue() - return! TypeCheckTask prevBoundModel syntaxTree + return! TypeCheckTask partialCheck prevBoundModel syntaxTree }) let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = @@ -1039,7 +1050,8 @@ module IncrementalBuilderStateHelpers = let! result = FinalizeTypeCheckTask initialState.tcConfig - initialState.tcGlobals + initialState.tcGlobals + initialState.enablePartialTypeChecking initialState.assemblyName initialState.outfile boundModels @@ -1055,9 +1067,11 @@ module IncrementalBuilderStateHelpers = for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() + let partialCheck = initialState.enablePartialTypeChecking + let mapping (status, prevNode) slot = let update invalidate = - let graphNode = createBoundModelGraphNode prevNode slot.SyntaxTree + let graphNode = createBoundModelGraphNode partialCheck prevNode slot.SyntaxTree let newStatus = if invalidate then Invalidated else status { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, (newStatus, graphNode) @@ -1133,7 +1147,7 @@ type IncrementalBuilderState with let boundModels = syntaxTrees - |> Seq.scan createBoundModelGraphNode initialBoundModel + |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel |> Seq.skip 1 let slots = @@ -1441,6 +1455,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, dependencyProvider, parallelReferenceResolution, captureIdentifiersWhenParsing, @@ -1677,6 +1692,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc assemblyName, resourceManager, sourceFiles, + enablePartialTypeChecking, beforeFileChecked, fileChecked, #if !NO_TYPEPROVIDERS diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index e1653f213dc..9ffc66a2fdb 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -264,6 +264,7 @@ type internal IncrementalBuilder = suggestNamesForErrors: bool * keepAllBackgroundSymbolUses: bool * enableBackgroundItemKeyStoreAndSemanticClassification: bool * + enablePartialTypeChecking: bool * dependencyProvider: DependencyProvider option * parallelReferenceResolution: ParallelReferenceResolution * captureIdentifiersWhenParsing: bool * diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 360305ef4b6..cf5487e25df 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -191,7 +191,7 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - _enablePartialTypeChecking, + enablePartialTypeChecking, parallelReferenceResolution, captureIdentifiersWhenParsing, getSource: (string -> ISourceText option) option, @@ -325,6 +325,7 @@ type BackgroundCompiler suggestNamesForErrors, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, dependencyProvider, parallelReferenceResolution, captureIdentifiersWhenParsing, diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 25229035674..e11b675bc78 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -168,7 +168,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 112 + use _ = expectCacheHits 113 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -183,7 +183,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 5 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -193,7 +193,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 5 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index 8a6b36042eb..ef24023a3bc 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -255,7 +255,7 @@ let x = MyType() SignatureFile = Custom "module Moo" Source = source } ) - ProjectWorkflowBuilder(project, allowErrors = true) { + ProjectWorkflowBuilder(project) { placeCursor "Program" "MyType" @@ -286,7 +286,7 @@ let x = MyType() SignatureFile = Custom "module Moo" Source = source } ) - ProjectWorkflowBuilder(project, allowErrors = true, useGetSource = true, useChangeNotifications = true) { + ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true) { placeCursor "Program" "MyType" @@ -304,3 +304,4 @@ let x = MyType() "FileProgram.fs", 6, 8, 14 ]) } + diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 3417dc0d41a..7d789d00f4a 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -471,14 +471,14 @@ type WorkflowContext = Signatures: Map Cursor: FSharpSymbolUse option } -let SaveAndCheckProject project checker allowErrors = +let SaveAndCheckProject project checker = async { do! saveProject project true checker let! results = checker.ParseAndCheckProject(project.GetProjectOptions checker) - if not (allowErrors || Array.isEmpty results.Diagnostics) then + if not (Array.isEmpty results.Diagnostics) then failwith $"Project {project.Name} failed initial check: \n%A{results.Diagnostics}" let! signatures = @@ -501,7 +501,6 @@ type ProjectWorkflowBuilder initialProject: SyntheticProject, ?initialContext, ?checker: FSharpChecker, - ?allowErrors, ?useGetSource, ?useChangeNotifications, ?useSyntaxTreeCache @@ -567,7 +566,7 @@ type ProjectWorkflowBuilder member this.Yield _ = match initialContext with | Some ctx -> async.Return ctx - | _ -> SaveAndCheckProject initialProject checker (defaultArg allowErrors false) + | _ -> SaveAndCheckProject initialProject checker member this.DeleteProjectDir() = if Directory.Exists initialProject.ProjectDir then From 11db113e9c0f636317a7aca9d1a93ff0b751bb51 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 22 Mar 2023 12:27:32 +0100 Subject: [PATCH 23/49] restore enablePartialTypeChecking --- src/Compiler/Service/IncrementalBuild.fs | 28 +++++++++++++++++------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 04f2413c9fa..93d8acc34ad 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -303,6 +303,7 @@ type BoundModel private (tcConfig: TcConfig, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, @@ -327,16 +328,20 @@ type BoundModel private (tcConfig: TcConfig, let partialGraphNode = GraphNode(node { - // Optimization so we have less of a chance to duplicate work. - if fullGraphNode.IsComputing then + if enablePartialTypeChecking then + // Optimization so we have less of a chance to duplicate work. + if fullGraphNode.IsComputing then + let! tcInfo, _ = fullGraphNode.GetOrComputeValue() + return tcInfo + else + match fullGraphNode.TryPeekValue() with + | ValueSome(tcInfo, _) -> return tcInfo + | _ -> + let! tcInfoState = this.TypeCheck(true) + return tcInfoState.TcInfo + else let! tcInfo, _ = fullGraphNode.GetOrComputeValue() return tcInfo - else - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, _) -> return tcInfo - | _ -> - let! tcInfoState = this.TypeCheck(true) - return tcInfoState.TcInfo }) TcInfoNode(partialGraphNode, fullGraphNode) @@ -363,6 +368,7 @@ type BoundModel private (tcConfig: TcConfig, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked, tcInfo, @@ -397,6 +403,7 @@ type BoundModel private (tcConfig: TcConfig, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked, prevTcInfo, @@ -569,6 +576,7 @@ type BoundModel private (tcConfig: TcConfig, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked: Event, fileChecked: Event, prevTcInfo: TcInfo, @@ -577,6 +585,7 @@ type BoundModel private (tcConfig: TcConfig, keepAssemblyContents, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked, prevTcInfo, @@ -739,6 +748,7 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS @@ -813,6 +823,7 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked, tcInfo, @@ -1661,6 +1672,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, + enablePartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS From cfc98745b3280b2ceb6aea42ee48d131c8d52dc1 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 22 Mar 2023 19:27:19 +0100 Subject: [PATCH 24/49] fix conflict --- .../FSharpChecker/FindReferences.fs | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs index ef24023a3bc..6de65276b26 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/FindReferences.fs @@ -201,12 +201,11 @@ let foo x = 5""" }) [] let ``We find values of a type that has been aliased`` () = - let project = SyntheticProject.Create("TypeAliasTest", + let project = SyntheticProject.Create( { sourceFile "First" [] with ExtraSource = "type MyInt = int32\n" + "let myNum = 7" - SignatureFile = Custom ("module TypeAliasTest.ModuleFirst\n" + - "type MyInt = int32\n" + + SignatureFile = Custom ("type MyInt = int32\n" + "val myNum: MyInt") }, { sourceFile "Second" [] with ExtraSource = "let goo x = ModuleFirst.myNum + x"}) @@ -250,12 +249,10 @@ type MyType() = class end let x = MyType() """ - let project = SyntheticProject.Create( + SyntheticProject.Create( { sourceFile "Program" [] with - SignatureFile = Custom "module Moo" - Source = source } ) - - ProjectWorkflowBuilder(project) { + SignatureFile = Custom "" + Source = source } ).Workflow { placeCursor "Program" "MyType" @@ -283,7 +280,7 @@ let x = MyType() """ let project = SyntheticProject.Create( { sourceFile "Program" [] with - SignatureFile = Custom "module Moo" + SignatureFile = Custom "" Source = source } ) ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true) { @@ -304,4 +301,3 @@ let x = MyType() "FileProgram.fs", 6, 8, 14 ]) } - From 15755590bc504d18a9d107ef3cf9755fa884fb32 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 23 Mar 2023 08:50:09 +0100 Subject: [PATCH 25/49] naming stuff --- src/Compiler/Driver/ParseAndCheckInputs.fs | 8 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 2 +- src/Compiler/Service/IncrementalBuild.fs | 119 +++++++++----------- 3 files changed, 60 insertions(+), 69 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 05b3ea30622..378d2db0b01 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1205,15 +1205,12 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType /// Return stub result for skipped implementation files -let ImplStubForSig (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input: ParsedInput) = +let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input: ParsedInput) = use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] CheckSimulateException tcConfig - let m = input.Range - let amap = tcImports.GetImportMap() - match input with | ParsedInput.ImplFile file -> let qualNameOfFile = file.QualifiedName @@ -1223,7 +1220,7 @@ let ImplStubForSig (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixP // Check if we've already seen an implementation for this fragment if Zset.contains qualNameOfFile tcState.tcsRootImpls then - errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m)) + errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), input.Range)) let hadSig = rootSigOpt.IsSome @@ -1234,6 +1231,7 @@ let ImplStubForSig (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixP // in the compilation order. let tcStateForImplFile = tcState let qualNameOfFile = file.QualifiedName + let amap = tcImports.GetImportMap() let ccuSigForFile, tcState = AddCheckResultsToTcState diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 539a3b19a9d..e42d5f8e1af 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -135,7 +135,7 @@ type TcState = val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState ///ImplStubForSig -val ImplStubForSig: +val SkippedImplFilePlaceholder: tcConfig: TcConfig * tcImports: TcImports * tcGlobals: TcGlobals * diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 93d8acc34ad..6d98ba8aa56 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -124,7 +124,7 @@ module IncrementalBuildSyntaxTree = let source = file.Source let isLastCompiland = file.Flags - let parsedImplFileStub sigName = + let skippedImplFilePlaceholder sigName = ParsedInput.ImplFile( ParsedImplFileInput( fileName, @@ -139,24 +139,25 @@ module IncrementalBuildSyntaxTree = ) ), sourceRange, fileName, [||] - let getParseTask (source: FSharpSource) = backgroundTask { - let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) - // Return the disposable object that cleans up - use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) - use text = source.GetTextContainer() - let input = - match text with - | TextContainer.Stream(stream) -> - ParseOneInputStream(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, false, stream) - | TextContainer.SourceText(sourceText) -> - ParseOneInputSourceText(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, sourceText) - | TextContainer.OnDisk -> - ParseOneInputFile(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, true) - - fileParsed.Trigger fileName - - return input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() - } + let getParseTask (source: FSharpSource) = + backgroundTask { + let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) + // Return the disposable object that cleans up + use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) + use text = source.GetTextContainer() + let input = + match text with + | TextContainer.Stream(stream) -> + ParseOneInputStream(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, false, stream) + | TextContainer.SourceText(sourceText) -> + ParseOneInputSourceText(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, sourceText) + | TextContainer.OnDisk -> + ParseOneInputFile(tcConfig, lexResourceManager, fileName, isLastCompiland, diagnosticsLogger, true) + + fileParsed.Trigger fileName + + return input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() + } //|> Async.StartAsTask let parse (parseTask: Threading.Tasks.Task<_>) = try @@ -168,8 +169,6 @@ module IncrementalBuildSyntaxTree = let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) - do if useCache && not hasSignature then getValue source |> ignore - /// Parse the given file and return the given input. member _.Parse() = IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) @@ -190,11 +189,11 @@ module IncrementalBuildSyntaxTree = member _.HasSignature = hasSignature - member _.GetImplStub = parsedImplFileStub + member _.Skip = skippedImplFilePlaceholder - member _.Invalidate() = + member _.Invalidate(partialCheck) = cache.Remove(source) |> ignore - if useCache then getValue source |> ignore + if useCache && not (hasSignature && partialCheck) then getValue source |> ignore member _.FileName = fileName @@ -462,7 +461,7 @@ type BoundModel private (tcConfig: TcConfig, use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] let input, _sourceRange, fileName, parseErrors = match this.QualifiedSigNameOfFile with - | Some sigNameOpt when partialCheck -> syntaxTree.GetImplStub sigNameOpt + | Some sigNameOpt when partialCheck -> syntaxTree.Skip sigNameOpt | _ -> syntaxTree.Parse() @@ -486,7 +485,7 @@ type BoundModel private (tcConfig: TcConfig, | ParsedInput.SigFile sigFile -> Some(sigFile.FileName, sigFile.QualifiedName) | _ -> None - match ImplStubForSig(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcState, input) with + match SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcState, input) with | Some ((_, topAttribs, _, ccuSigForFile), tcState) when partialCheck -> return PartialState { tcState = tcState @@ -848,15 +847,15 @@ module IncrementalBuilderHelpers = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (graphNodes: GraphNode seq) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (boundModels: GraphNode seq) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Parallel let! results = - graphNodes - |> Seq.map (fun graphNode -> node { - let! boundModel = graphNode.GetOrComputeValue() + computedBoundModels + |> Seq.map (fun boundModel -> node { if partialCheck then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -870,14 +869,12 @@ module IncrementalBuilderHelpers = return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) } ) - |> NodeCode.Parallel + |> NodeCode.Parallel - let results = results |> List.ofSeq - - let! boundModels = graphNodes |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Parallel + let results = results |> Array.toList // Get the state at the end of the type-checking of the last file - let finalBoundModel = Array.last boundModels + let finalBoundModel = Array.last computedBoundModels let! finalInfo = finalBoundModel.GetOrComputeTcInfo() @@ -1016,9 +1013,9 @@ type IncrementalBuilderInitialState = #endif initialState -// stampedFileNames represent the real stamps of the files. -// notifiedStampedFileNames represent the stamps of when we got notified about file changes -// logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. +// Stamp represent the real stamp of the file. +// Notified indicates that there is pending file change. +// LogicalStamp represent the stamp of the file that is used to calculate the project's logical timestamp. type Slot = { File: FSharpFile @@ -1027,7 +1024,7 @@ type Slot = LogicalStamp: DateTime SyntaxTree: SyntaxTree Notified: bool - Model: GraphNode + BoundModel: GraphNode } member this.Notify timeStamp = if this.Stamp <> timeStamp then { this with Stamp = timeStamp; Notified = true } else this @@ -1042,12 +1039,13 @@ type IncrementalBuilderState = } member this.stampedFileNames = this.slots |> List.map (fun s -> s.Stamp) member this.logicalStampedFileNames = this.slots |> List.map (fun s -> s.LogicalStamp) - member this.boundModels = this.slots |> List.map (fun s -> s.Model) + member this.boundModels = this.slots |> List.map (fun s -> s.BoundModel) [] module IncrementalBuilderStateHelpers = - type SlotStatus = Invalidated | Good + // Used to thread the status of the build in computeStampedFileNames mapFold. + type BuildStatus = Invalidated | Good let createBoundModelGraphNode partialCheck (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { @@ -1076,31 +1074,27 @@ module IncrementalBuilderStateHelpers = else [ for slot in state.slots -> cache.GetFileTimeStamp slot.File.Source.FilePath |> slot.Notify ] - for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() - let partialCheck = initialState.enablePartialTypeChecking + for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate(partialCheck) + let mapping (status, prevNode) slot = - let update invalidate = - let graphNode = createBoundModelGraphNode partialCheck prevNode slot.SyntaxTree - let newStatus = if invalidate then Invalidated else status - { slot with LogicalStamp = slot.Stamp; Notified = false; Model = graphNode }, (newStatus, graphNode) - - if slot.HasSignature then - match status with - | _ when slot.Notified -> update false - | Invalidated -> update true - | _ -> slot, (Good, slot.Model) - else - match status with - | Good when slot.Notified -> update true - | Invalidated -> update true - | _ -> slot, (Good, slot.Model) + let update newStatus = + let boundModel = createBoundModelGraphNode partialCheck prevNode slot.SyntaxTree + { slot with LogicalStamp = slot.Stamp; Notified = false; BoundModel = boundModel }, (newStatus, boundModel) + + let noChange = slot, (Good, slot.BoundModel) + + match status with + | status when slot.Notified && slot.HasSignature -> update status + | Invalidated -> update Invalidated + | Good when slot.Notified -> update Invalidated + | _ -> noChange - match slots |> List.mapFold mapping (Good, (GraphNode.FromResult initialState.initialBoundModel)) with + match slots |> List.mapFold mapping (Good, GraphNode.FromResult initialState.initialBoundModel) with | slots, (Good, _) -> { state with slots = slots } | slots, (Invalidated, _) -> - let boundModels = slots |> Seq.map (fun s -> s.Model) + let boundModels = slots |> Seq.map (fun s -> s.BoundModel) { state with slots = slots; finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = @@ -1137,11 +1131,10 @@ type IncrementalBuilderState with *) static member Create(initialState: IncrementalBuilderInitialState) = let defaultTimeStamp = initialState.defaultTimeStamp - let initialBoundModel = initialState.initialBoundModel let sourceFiles = initialState.fileNames let referencedAssemblies = initialState.referencedAssemblies let cache = TimeStampCache(defaultTimeStamp) - let initialBoundModel = GraphNode.FromResult initialBoundModel + let initialBoundModel = GraphNode.FromResult initialState.initialBoundModel let syntaxTrees = let create sourceFile hasSignature = @@ -1171,7 +1164,7 @@ type IncrementalBuilderState with LogicalStamp = DateTime.MinValue Notified = false SyntaxTree = syntaxTree - Model = model + BoundModel = model } ] From a9b18fe5079aa9f255dc0c33351268d14f39063d Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 23 Mar 2023 10:05:43 +0100 Subject: [PATCH 26/49] fix test --- .../FSharpChecker/CommonWorkflows.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index da0b40e757c..08d071d1334 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -167,7 +167,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 113 + use _ = expectCacheHits 51 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged From 9b69486892e57984c72a9a68d32da0b2bab48ae5 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 29 Mar 2023 12:58:20 +0200 Subject: [PATCH 27/49] task run --- src/Compiler/Service/IncrementalBuild.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 6d98ba8aa56..3a046bf87c4 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -140,7 +140,7 @@ module IncrementalBuildSyntaxTree = ), sourceRange, fileName, [||] let getParseTask (source: FSharpSource) = - backgroundTask { + Threading.Tasks.Task.Run( fun () -> let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) @@ -156,8 +156,8 @@ module IncrementalBuildSyntaxTree = fileParsed.Trigger fileName - return input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() - } //|> Async.StartAsTask + input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() + ) let parse (parseTask: Threading.Tasks.Task<_>) = try From e8ead2ceddef2bf159e2eca0f1dde55c077e4699 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 29 Mar 2023 13:44:53 +0200 Subject: [PATCH 28/49] update docs --- src/Compiler/Driver/ParseAndCheckInputs.fs | 5 ++--- src/Compiler/Driver/ParseAndCheckInputs.fsi | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 378d2db0b01..b935ad732bc 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1204,7 +1204,7 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType -/// Return stub result for skipped implementation files +/// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input: ParsedInput) = use _ = Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] @@ -1247,8 +1247,7 @@ let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlob | _ -> None | _ -> None -/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true -/// then implementations with signature files give empty results. +/// Typecheck a single file (or interactive entry into F# Interactive). let CheckOneInput ( checkForErrors, diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index e42d5f8e1af..86420344694 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -134,7 +134,7 @@ type TcState = /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState -///ImplStubForSig +/// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. val SkippedImplFilePlaceholder: tcConfig: TcConfig * tcImports: TcImports * From 78a0d20e97919d1f9415e98966da649a2282b5af Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 29 Mar 2023 14:46:54 +0200 Subject: [PATCH 29/49] use SemaphoreSlim --- src/Compiler/Service/IncrementalBuild.fs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 3a046bf87c4..21d2c97d23c 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -167,7 +167,15 @@ module IncrementalBuildSyntaxTree = System.Diagnostics.Debug.Assert(false, msg) failwith msg - let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) + // We control access to the cache to prevent theoretical possibility of starting the same parse job more than once. + // The semaphore instance here locks single particular cache key, not everything. + let semaphore = new SemaphoreSlim(1) + let getValue source = + try + semaphore.Wait() + cache.GetValue(source, getParseTask) + finally + semaphore.Release() |> ignore /// Parse the given file and return the given input. member _.Parse() = From 1acaa82eb9e12581a46b1581e1d992ccb797bdc5 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 29 Mar 2023 15:02:47 +0200 Subject: [PATCH 30/49] add a comment --- src/Compiler/Service/IncrementalBuild.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 21d2c97d23c..dfe2435062a 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1094,6 +1094,8 @@ module IncrementalBuilderStateHelpers = let noChange = slot, (Good, slot.BoundModel) match status with + // Modifying implementation file that has signature file does not invalidate the build. + // So we just pass along previous status. | status when slot.Notified && slot.HasSignature -> update status | Invalidated -> update Invalidated | Good when slot.Notified -> update Invalidated From 2ae1e75f7d1be8fe0f2d915af8c9a5aab9b8a94f Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 29 Mar 2023 15:11:12 +0200 Subject: [PATCH 31/49] fix --- src/Compiler/Service/IncrementalBuild.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 67f97743490..819bbe752f7 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1448,10 +1448,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let slotOfFile = builder.GetSlotOfFileName fileName let cache = TimeStampCache defaultTimeStamp let! ct = NodeCode.CancellationToken - setCurrentState - { currentState with - slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } - cache ct + do! setCurrentState + { currentState with + slots = currentState.slots |> List.updateAt slotOfFile (currentState.slots[slotOfFile].Notify timeStamp) } + cache ct } member _.SourceFiles = fileNames |> Seq.map (fun f -> f.Source.FilePath) |> List.ofSeq From 493b3b2192e99bbe9daa8984711a2efb8a98c5d7 Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 30 Mar 2023 14:49:33 +0200 Subject: [PATCH 32/49] revert to lock --- src/Compiler/Service/IncrementalBuild.fs | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 819bbe752f7..c8dc443b81c 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -168,14 +168,8 @@ module IncrementalBuildSyntaxTree = failwith msg // We control access to the cache to prevent theoretical possibility of starting the same parse job more than once. - // The semaphore instance here locks single particular cache key, not everything. - let semaphore = new SemaphoreSlim(1) - let getValue source = - try - semaphore.Wait() - cache.GetValue(source, getParseTask) - finally - semaphore.Release() |> ignore + // We lock only a single particular cache key, just to start the task, not for the duration of the task. + let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) /// Parse the given file and return the given input. member _.Parse() = From 632b3ba430e0e933c75de71518f36f2e97d22a35 Mon Sep 17 00:00:00 2001 From: majocha Date: Fri, 31 Mar 2023 09:58:47 +0200 Subject: [PATCH 33/49] make full type check more parallel --- src/Compiler/Service/IncrementalBuild.fs | 62 +++++++------------ .../FSharpChecker/CommonWorkflows.fs | 6 +- 2 files changed, 25 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index c8dc443b81c..7b87868a0ed 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -319,38 +319,29 @@ type BoundModel private (tcConfig: TcConfig, tcInfoState.TcInfoExtras.IsSome || not enableBackgroundItemKeyStoreAndSemanticClassification -> TcInfoNode.FromState(tcInfoState) | _ -> - let fullGraphNode = - GraphNode(node { - match! this.TypeCheck(false) with - | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras - | PartialState(tcInfo) -> - return tcInfo, emptyTcInfoExtras - }) - - let partialGraphNode = - GraphNode(node { - if enablePartialTypeChecking then - // Optimization so we have less of a chance to duplicate work. - if fullGraphNode.IsComputing then + match syntaxTreeOpt with + | Some syntaxTree -> + let fullGraphNode = + GraphNode(node { + match! this.TypeCheck(syntaxTree, false) with + | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras + | PartialState(tcInfo) -> + return tcInfo, emptyTcInfoExtras + }) + + let partialGraphNode = + GraphNode(node { + if syntaxTree.HasSignature then + let! tcInfoState = this.TypeCheck(syntaxTree, true) + return tcInfoState.TcInfo + else let! tcInfo, _ = fullGraphNode.GetOrComputeValue() return tcInfo - else - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, _) -> return tcInfo - | _ -> - let! tcInfoState = this.TypeCheck(true) - return tcInfoState.TcInfo - else - let! tcInfo, _ = fullGraphNode.GetOrComputeValue() - return tcInfo }) - TcInfoNode(partialGraphNode, fullGraphNode) + TcInfoNode(partialGraphNode, fullGraphNode) - let defaultTypeCheck () = - node { - return PartialState(prevTcInfo) - } + | None -> TcInfoNode(GraphNode.FromResult prevTcInfo, GraphNode.FromResult (prevTcInfo, emptyTcInfoExtras)) member _.QualifiedSigNameOfFile = prevTcInfo.sigNameOpt |> Option.map snd @@ -447,7 +438,7 @@ type BoundModel private (tcConfig: TcConfig, | TcInfoNode(_, fullGraphNode) -> fullGraphNode.GetOrComputeValue() - member private this.TypeCheck (partialCheck: bool) : NodeCode = + member private this.TypeCheck (syntaxTree: SyntaxTree, partialCheck: bool) : NodeCode = match partialCheck, tcInfoStateOpt with | true, Some (PartialState _ as state) | true, Some (FullState _ as state) -> node.Return state @@ -455,11 +446,6 @@ type BoundModel private (tcConfig: TcConfig, | _ -> node { - match syntaxTreeOpt with - | None -> - let! res = defaultTypeCheck () - return res - | Some syntaxTree -> use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] let input, _sourceRange, fileName, parseErrors = match this.QualifiedSigNameOfFile with @@ -839,13 +825,9 @@ module IncrementalBuilderHelpers = // Eagerly type check // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. - if partialCheck then - let! _ = boundModel.GetOrComputeTcInfo() - () - else - let! _ = boundModel.GetOrComputeTcInfoWithExtras() - () - + boundModel.GetOrComputeTcInfo() |> ignore + if not partialCheck then + boundModel.GetOrComputeTcInfoWithExtras() |> ignore return boundModel } diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 08d071d1334..831c4366615 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -167,7 +167,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 51 + use _ = expectCacheHits 50 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -182,7 +182,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -192,7 +192,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" From 81a5f3918046db4f10fca891bc82f7ebaed0e04b Mon Sep 17 00:00:00 2001 From: majocha Date: Fri, 31 Mar 2023 19:24:06 +0200 Subject: [PATCH 34/49] Revert "make full type check more parallel" This reverts commit 632b3ba430e0e933c75de71518f36f2e97d22a35. --- src/Compiler/Service/IncrementalBuild.fs | 62 ++++++++++++------- .../FSharpChecker/CommonWorkflows.fs | 6 +- 2 files changed, 43 insertions(+), 25 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 7b87868a0ed..c8dc443b81c 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -319,29 +319,38 @@ type BoundModel private (tcConfig: TcConfig, tcInfoState.TcInfoExtras.IsSome || not enableBackgroundItemKeyStoreAndSemanticClassification -> TcInfoNode.FromState(tcInfoState) | _ -> - match syntaxTreeOpt with - | Some syntaxTree -> - let fullGraphNode = - GraphNode(node { - match! this.TypeCheck(syntaxTree, false) with - | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras - | PartialState(tcInfo) -> - return tcInfo, emptyTcInfoExtras - }) - - let partialGraphNode = - GraphNode(node { - if syntaxTree.HasSignature then - let! tcInfoState = this.TypeCheck(syntaxTree, true) - return tcInfoState.TcInfo - else + let fullGraphNode = + GraphNode(node { + match! this.TypeCheck(false) with + | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras + | PartialState(tcInfo) -> + return tcInfo, emptyTcInfoExtras + }) + + let partialGraphNode = + GraphNode(node { + if enablePartialTypeChecking then + // Optimization so we have less of a chance to duplicate work. + if fullGraphNode.IsComputing then let! tcInfo, _ = fullGraphNode.GetOrComputeValue() return tcInfo + else + match fullGraphNode.TryPeekValue() with + | ValueSome(tcInfo, _) -> return tcInfo + | _ -> + let! tcInfoState = this.TypeCheck(true) + return tcInfoState.TcInfo + else + let! tcInfo, _ = fullGraphNode.GetOrComputeValue() + return tcInfo }) - TcInfoNode(partialGraphNode, fullGraphNode) + TcInfoNode(partialGraphNode, fullGraphNode) - | None -> TcInfoNode(GraphNode.FromResult prevTcInfo, GraphNode.FromResult (prevTcInfo, emptyTcInfoExtras)) + let defaultTypeCheck () = + node { + return PartialState(prevTcInfo) + } member _.QualifiedSigNameOfFile = prevTcInfo.sigNameOpt |> Option.map snd @@ -438,7 +447,7 @@ type BoundModel private (tcConfig: TcConfig, | TcInfoNode(_, fullGraphNode) -> fullGraphNode.GetOrComputeValue() - member private this.TypeCheck (syntaxTree: SyntaxTree, partialCheck: bool) : NodeCode = + member private this.TypeCheck (partialCheck: bool) : NodeCode = match partialCheck, tcInfoStateOpt with | true, Some (PartialState _ as state) | true, Some (FullState _ as state) -> node.Return state @@ -446,6 +455,11 @@ type BoundModel private (tcConfig: TcConfig, | _ -> node { + match syntaxTreeOpt with + | None -> + let! res = defaultTypeCheck () + return res + | Some syntaxTree -> use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] let input, _sourceRange, fileName, parseErrors = match this.QualifiedSigNameOfFile with @@ -825,9 +839,13 @@ module IncrementalBuilderHelpers = // Eagerly type check // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. - boundModel.GetOrComputeTcInfo() |> ignore - if not partialCheck then - boundModel.GetOrComputeTcInfoWithExtras() |> ignore + if partialCheck then + let! _ = boundModel.GetOrComputeTcInfo() + () + else + let! _ = boundModel.GetOrComputeTcInfoWithExtras() + () + return boundModel } diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 831c4366615..08d071d1334 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -167,7 +167,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 50 + use _ = expectCacheHits 51 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -182,7 +182,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 5 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -192,7 +192,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 5 + use _ = expectCacheHits 6 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" From 65d4f817fc27067904f5b0311669569f806656ca Mon Sep 17 00:00:00 2001 From: majocha Date: Mon, 3 Apr 2023 10:05:31 +0200 Subject: [PATCH 35/49] refactor BoundModel, parallel typecheck when possible --- src/Compiler/Service/IncrementalBuild.fs | 594 +++++++----------- .../FSharpChecker/CommonWorkflows.fs | 6 +- 2 files changed, 238 insertions(+), 362 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index c8dc443b81c..960f63aa25d 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -143,7 +143,7 @@ module IncrementalBuildSyntaxTree = Threading.Tasks.Task.Run( fun () -> let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up - use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) + use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) use text = source.GetTextContainer() let input = match text with @@ -193,9 +193,10 @@ module IncrementalBuildSyntaxTree = member _.Skip = skippedImplFilePlaceholder - member _.Invalidate(partialCheck) = - cache.Remove(source) |> ignore - if useCache && not (hasSignature && partialCheck) then getValue source |> ignore + member _.Invalidate() = + if useCache then + cache.Remove(source) |> ignore + getValue source |> ignore member _.FileName = fileName @@ -254,105 +255,153 @@ type TcInfoExtras = member x.TcSymbolUses = x.tcSymbolUses -[] -module TcInfoHelpers = - - let emptyTcInfoExtras = - { - tcResolutions = TcResolutions.Empty - tcSymbolUses = TcSymbolUses.Empty - tcOpenDeclarations = [||] - latestImplFile = None - itemKeyStore = None - semanticClassificationKeyStore = None - } - -/// Accumulated results of type checking. -[] -type TcInfoState = - | PartialState of TcInfo - | FullState of TcInfo * TcInfoExtras - - member x.TcInfo = - match x with - | PartialState tcInfo -> tcInfo - | FullState (tcInfo, _) -> tcInfo - - member x.TcInfoExtras = - match x with - | PartialState _ -> None - | FullState (_, tcInfoExtras) -> Some tcInfoExtras - -[] -type TcInfoNode = - | TcInfoNode of partial: GraphNode * full: GraphNode - - member this.TryGetFull = - match this with - | TcInfoNode(_, full) -> full.TryPeekValue +module private ValueOption = + let toOption = function + | ValueSome x -> Some x + | _ -> None - static member FromState(state: TcInfoState) = - let tcInfo = state.TcInfo - let tcInfoExtras = state.TcInfoExtras - TcInfoNode(GraphNode.FromResult tcInfo, GraphNode.FromResult (tcInfo, defaultArg tcInfoExtras emptyTcInfoExtras)) +type private TypeCheckNode = GraphNode /// Bound model of an underlying syntax and typed tree. -[] -type BoundModel private (tcConfig: TcConfig, - tcGlobals: TcGlobals, - tcImports: TcImports, - keepAssemblyContents, keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, - beforeFileChecked: Event, - fileChecked: Event, - prevTcInfo: TcInfo, - syntaxTreeOpt: SyntaxTree option, - tcInfoStateOpt: TcInfoState option) as this = - - let tcInfoNode = - match tcInfoStateOpt with - | Some tcInfoState when - // If we don't have tcInfoExtras and BackgroundItemKeyStoreAndSemanticClassification is enabled - // we need to do a type check to generate them - tcInfoState.TcInfoExtras.IsSome || not enableBackgroundItemKeyStoreAndSemanticClassification -> - TcInfoNode.FromState(tcInfoState) - | _ -> - let fullGraphNode = - GraphNode(node { - match! this.TypeCheck(false) with - | FullState(tcInfo, tcInfoExtras) -> return tcInfo, tcInfoExtras - | PartialState(tcInfo) -> - return tcInfo, emptyTcInfoExtras - }) +type BoundModel private ( + tcConfig: TcConfig, + tcGlobals, + tcImports: TcImports, + keepAssemblyContents, keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + beforeFileChecked: Event, + fileChecked: Event, + prevTcInfo: TcInfo, + syntaxTreeOpt: SyntaxTree option, + ?tcInfoOpt: GraphNode, + ?tcInfoExtrasNodeOpt: GraphNode + ) = + + let getTypeCheck (syntaxTree: SyntaxTree) : TypeCheckNode = + node { + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] + let input, _sourceRange, fileName, parseErrors = syntaxTree.Parse() - let partialGraphNode = - GraphNode(node { - if enablePartialTypeChecking then - // Optimization so we have less of a chance to duplicate work. - if fullGraphNode.IsComputing then - let! tcInfo, _ = fullGraphNode.GetOrComputeValue() - return tcInfo - else - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, _) -> return tcInfo - | _ -> - let! tcInfoState = this.TypeCheck(true) - return tcInfoState.TcInfo - else - let! tcInfo, _ = fullGraphNode.GetOrComputeValue() - return tcInfo - }) + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) + let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") + let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) + use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - TcInfoNode(partialGraphNode, fullGraphNode) + beforeFileChecked.Trigger fileName + + ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore + let sink = TcResultsSinkImpl(tcGlobals) + let hadParseErrors = not (Array.isEmpty parseErrors) + let input, moduleNamesDict = DeduplicateParsedInputModuleName prevTcInfo.moduleNamesDict input + + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = + CheckOneInput ( + (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), + tcConfig, tcImports, + tcGlobals, + None, + TcResultsSink.WithSink sink, + prevTcInfo.tcState, input ) + |> NodeCode.FromCancellable + + fileChecked.Trigger fileName + + let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) + let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls + + let tcInfo = + { + tcState = tcState + tcEnvAtEndOfFile = tcEnvAtEndOfFile + moduleNamesDict = moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcDiagnosticsRev = newErrors :: prevTcInfo.tcDiagnosticsRev + topAttribs = Some topAttribs + tcDependencyFiles = fileName :: prevTcInfo.tcDependencyFiles + sigNameOpt = + match input with + | ParsedInput.SigFile sigFile -> + Some(sigFile.FileName, sigFile.QualifiedName) + | _ -> + None + } + return tcInfo, sink, implFile, fileName + } |> GraphNode + + let skippedImplemetationTypeCheck = + match syntaxTreeOpt, prevTcInfo.sigNameOpt with + | Some syntaxTree, Some (_, sigName) when syntaxTree.HasSignature -> + let input, _, fileName, _ = syntaxTree.Skip sigName + SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcInfo.tcState, input) + |> Option.map (fun ((_, topAttribs, _, ccuSigForFile), tcState) -> + { + tcState = tcState + tcEnvAtEndOfFile = tcState.TcEnvFromImpls + moduleNamesDict = prevTcInfo.moduleNamesDict + latestCcuSigForFile = Some ccuSigForFile + tcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev + topAttribs = Some topAttribs + tcDependencyFiles = fileName :: prevTcInfo.tcDependencyFiles + sigNameOpt = Some(fileName, sigName) + }) + | _ -> None - let defaultTypeCheck () = + let getTcInfo (typeCheckNode: TypeCheckNode) = node { - return PartialState(prevTcInfo) - } + match skippedImplemetationTypeCheck with + | Some tcInfo -> return tcInfo + | _ -> + let! tcInfo , _, _, _ = typeCheckNode.GetOrComputeValue() + return tcInfo + } |> GraphNode + + let getTcInfoExtras (typeCheckNode: TypeCheckNode) = + node { + let! _ , sink, implFile, fileName = typeCheckNode.GetOrComputeValue() + // Build symbol keys + let itemKeyStore, semanticClassification = + if enableBackgroundItemKeyStoreAndSemanticClassification then + use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] + let sResolutions = sink.GetResolutions() + let builder = ItemKeyStoreBuilder() + let preventDuplicates = HashSet({ new IEqualityComparer with + member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 + member _.GetHashCode o = o.GetHashCode() }) + sResolutions.CapturedNameResolutions + |> Seq.iter (fun cnr -> + let r = cnr.Range + if preventDuplicates.Add struct(r.Start, r.End) then + builder.Write(cnr.Range, cnr.Item)) + + let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) + + let sckBuilder = SemanticClassificationKeyStoreBuilder() + sckBuilder.WriteAll semanticClassification + + let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() + res + else + None, None + + return + { + // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) + tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) + tcOpenDeclarations = sink.GetOpenDeclarations() + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + } |> GraphNode - member _.QualifiedSigNameOfFile = prevTcInfo.sigNameOpt |> Option.map snd + let defaultTypeCheck = GraphNode.FromResult (prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree") + let typeCheck = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck + + member val TcInfo = defaultArg tcInfoOpt (getTcInfo typeCheck) + + member val TcInfoExtras = defaultArg tcInfoExtrasNodeOpt (getTcInfoExtras typeCheck) member _.TcConfig = tcConfig @@ -360,41 +409,45 @@ type BoundModel private (tcConfig: TcConfig, member _.TcImports = tcImports - member _.Next(syntaxTree, tcInfo) = - BoundModel( - tcConfig, - tcGlobals, - tcImports, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, - beforeFileChecked, - fileChecked, - tcInfo, - Some syntaxTree, - None) + member this.TryPeekTcInfo() = this.TcInfo.TryPeekValue() |> ValueOption.toOption + + member this.TryPeekTcInfoWithExtras() = + (this.TcInfo.TryPeekValue(), this.TcInfoExtras.TryPeekValue()) + ||> ValueOption.map2 (fun a b -> a, b) + |> ValueOption.toOption + + member this.GetOrComputeTcInfo = this.TcInfo.GetOrComputeValue + + member this.GetOrComputeTcInfoExtras = this.TcInfoExtras.GetOrComputeValue + + member this.GetOrComputeTcInfoWithExtras() = node { + let! tcInfo = this.TcInfo.GetOrComputeValue() + let! tcInfoExtras = this.TcInfoExtras.GetOrComputeValue() + return tcInfo, tcInfoExtras + } - member _.Finish(finalTcDiagnosticsRev, finalTopAttribs) = - node { - let createFinish tcInfo = - { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } - - let! finishState = - node { - match tcInfoNode with - | TcInfoNode(partialGraphNode, fullGraphNode) -> - if fullGraphNode.HasValue then - let! tcInfo, tcInfoExtras = fullGraphNode.GetOrComputeValue() - let finishTcInfo = createFinish tcInfo - return FullState(finishTcInfo, tcInfoExtras) - else - let! tcInfo = partialGraphNode.GetOrComputeValue() - let finishTcInfo = createFinish tcInfo - return PartialState(finishTcInfo) - } + member this.Next(syntaxTree) = node { + let! tcInfo = this.TcInfo.GetOrComputeValue() + return + BoundModel( + tcConfig, + tcGlobals, + tcImports, + keepAssemblyContents, + keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + beforeFileChecked, + fileChecked, + tcInfo, + Some syntaxTree + ) + } + member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = + node { + let! tcInfo = this.TcInfo.GetOrComputeValue() + let finishState = { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } return BoundModel( tcConfig, @@ -404,194 +457,38 @@ type BoundModel private (tcConfig: TcConfig, keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked, prevTcInfo, syntaxTreeOpt, - Some finishState) + GraphNode.FromResult finishState, + this.TcInfoExtras + ) } - member _.TryPeekTcInfo() = - match tcInfoNode with - | TcInfoNode(partialGraphNode, fullGraphNode) -> - match partialGraphNode.TryPeekValue() with - | ValueSome tcInfo -> Some tcInfo - | _ -> - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, _) -> Some tcInfo - | _ -> None - - member _.TryPeekTcInfoWithExtras() = - match tcInfoNode with - | TcInfoNode(_, fullGraphNode) -> - match fullGraphNode.TryPeekValue() with - | ValueSome(tcInfo, tcInfoExtras) -> Some(tcInfo, tcInfoExtras) - | _ -> None - - member _.GetOrComputeTcInfo() = - match tcInfoNode with - | TcInfoNode(partialGraphNode, _) -> - partialGraphNode.GetOrComputeValue() - - member _.GetOrComputeTcInfoExtras() : NodeCode = - match tcInfoNode with - | TcInfoNode(_, fullGraphNode) -> - node { - let! _, tcInfoExtras = fullGraphNode.GetOrComputeValue() - return tcInfoExtras - } - - member _.GetOrComputeTcInfoWithExtras() = - match tcInfoNode with - | TcInfoNode(_, fullGraphNode) -> - fullGraphNode.GetOrComputeValue() - - member private this.TypeCheck (partialCheck: bool) : NodeCode = - match partialCheck, tcInfoStateOpt with - | true, Some (PartialState _ as state) - | true, Some (FullState _ as state) -> node.Return state - | false, Some (FullState _ as state) -> node.Return state - | _ -> - - node { - match syntaxTreeOpt with - | None -> - let! res = defaultTypeCheck () - return res - | Some syntaxTree -> - use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] - let input, _sourceRange, fileName, parseErrors = - match this.QualifiedSigNameOfFile with - | Some sigNameOpt when partialCheck -> syntaxTree.Skip sigNameOpt - | _ -> syntaxTree.Parse() - - - IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) - let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") - let diagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, input.ScopedPragmas, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) - use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - - beforeFileChecked.Trigger fileName - let prevModuleNamesDict = prevTcInfo.moduleNamesDict - let prevTcState = prevTcInfo.tcState - let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev - let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles - - ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore - let sink = TcResultsSinkImpl(tcGlobals) - let hadParseErrors = not (Array.isEmpty parseErrors) - let input, moduleNamesDict = DeduplicateParsedInputModuleName prevModuleNamesDict input - let sigNameOpt = - match input with - | ParsedInput.SigFile sigFile -> Some(sigFile.FileName, sigFile.QualifiedName) - | _ -> None - - match SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcState, input) with - | Some ((_, topAttribs, _, ccuSigForFile), tcState) when partialCheck -> - return PartialState { - tcState = tcState - tcEnvAtEndOfFile = tcState.TcEnvFromImpls - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = prevTcDiagnosticsRev - topAttribs = Some topAttribs - tcDependencyFiles = fileName :: prevTcDependencyFiles - sigNameOpt = sigNameOpt - } - | _ -> - let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = - CheckOneInput ( - (fun () -> hadParseErrors || diagnosticsLogger.ErrorCount > 0), - tcConfig, tcImports, - tcGlobals, - None, - TcResultsSink.WithSink sink, - prevTcState, input ) - |> NodeCode.FromCancellable - - - fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) - let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls - - let tcInfo = - { - tcState = tcState - tcEnvAtEndOfFile = tcEnvAtEndOfFile - moduleNamesDict = moduleNamesDict - latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev - topAttribs = Some topAttribs - tcDependencyFiles = fileName :: prevTcDependencyFiles - sigNameOpt = - match input with - | ParsedInput.SigFile sigFile -> - Some(sigFile.FileName, sigFile.QualifiedName) - | _ -> - None - } - // Build symbol keys - let itemKeyStore, semanticClassification = - if enableBackgroundItemKeyStoreAndSemanticClassification then - use _ = Activity.start "IncrementalBuild.CreateItemKeyStoreAndSemanticClassification" [|Activity.Tags.fileName, fileName|] - let sResolutions = sink.GetResolutions() - let builder = ItemKeyStoreBuilder() - let preventDuplicates = HashSet({ new IEqualityComparer with - member _.Equals((s1, e1): struct(pos * pos), (s2, e2): struct(pos * pos)) = Position.posEq s1 s2 && Position.posEq e1 e2 - member _.GetHashCode o = o.GetHashCode() }) - sResolutions.CapturedNameResolutions - |> Seq.iter (fun cnr -> - let r = cnr.Range - if preventDuplicates.Add struct(r.Start, r.End) then - builder.Write(cnr.Range, cnr.Item)) - - let semanticClassification = sResolutions.GetSemanticClassification(tcGlobals, tcImports.GetImportMap(), sink.GetFormatSpecifierLocations(), None) - - let sckBuilder = SemanticClassificationKeyStoreBuilder() - sckBuilder.WriteAll semanticClassification - - let res = builder.TryBuildAndReset(), sckBuilder.TryBuildAndReset() - res - else - None, None - - let tcInfoExtras = - { - // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) - tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) - tcOpenDeclarations = sink.GetOpenDeclarations() - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } - - return FullState(tcInfo, tcInfoExtras) - } - + static member Create( + tcConfig: TcConfig, + tcGlobals: TcGlobals, + tcImports: TcImports, + keepAssemblyContents, keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + beforeFileChecked: Event, + fileChecked: Event, + prevTcInfo: TcInfo, + syntaxTreeOpt: SyntaxTree option + ) = + BoundModel( + tcConfig, tcGlobals, tcImports, + keepAssemblyContents, keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + beforeFileChecked, + fileChecked, + prevTcInfo, + syntaxTreeOpt + ) - static member Create(tcConfig: TcConfig, - tcGlobals: TcGlobals, - tcImports: TcImports, - keepAssemblyContents, keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, - beforeFileChecked: Event, - fileChecked: Event, - prevTcInfo: TcInfo, - syntaxTreeOpt: SyntaxTree option) = - BoundModel(tcConfig, tcGlobals, tcImports, - keepAssemblyContents, keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, - beforeFileChecked, - fileChecked, - prevTcInfo, - syntaxTreeOpt, - None) /// Global service state type FrameworkImportsCacheKey = FrameworkImportsCacheKey of resolvedpath: string list * assemblyName: string * targetFrameworkDirectories: string list * fsharpBinaries: string * langVersion: decimal @@ -750,7 +647,6 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS @@ -825,61 +721,43 @@ module IncrementalBuilderHelpers = keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked, tcInfo, None) } - /// Type check all files eagerly. - let TypeCheckTask partialCheck (prevBoundModel: BoundModel) syntaxTree : NodeCode = - node { - let! tcInfo = prevBoundModel.GetOrComputeTcInfo() - let boundModel = prevBoundModel.Next(syntaxTree, tcInfo) - - // Eagerly type check - // We need to do this to keep the expected behavior of events (namely fileChecked) when checking a file/project. - if partialCheck then - let! _ = boundModel.GetOrComputeTcInfo() - () - else - let! _ = boundModel.GetOrComputeTcInfoWithExtras() - () - - return boundModel - } - /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (boundModels: GraphNode seq) = node { let diagnosticsLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.TypeCheck) - let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Parallel - let! results = - computedBoundModels + let! computedBoundModels = boundModels |> Seq.map (fun g -> g.GetOrComputeValue()) |> NodeCode.Sequential + + let! tcInfos = + computedBoundModels + |> Seq.map (fun boundModel -> node { return! boundModel.GetOrComputeTcInfo() }) + |> NodeCode.Sequential + + // tcInfoExtras can be computed in parallel. This will check any previously skipped implementation files in parallel, too. + let! latestImplFiles = + computedBoundModels |> Seq.map (fun boundModel -> node { - if partialCheck then - let! tcInfo = boundModel.GetOrComputeTcInfo() - return tcInfo, None - else - let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() - return tcInfo, tcInfoExtras.latestImplFile - }) - |> Seq.map (fun work -> - node { - let! tcInfo, latestImplFile = work - return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) - } - ) - |> NodeCode.Parallel + if partialCheck then + return None + else + let! tcInfoExtras = boundModel.GetOrComputeTcInfoExtras() + return tcInfoExtras.latestImplFile + }) + |> NodeCode.Parallel - let results = results |> Array.toList + let results = [ + for tcInfo, latestImplFile in Seq.zip tcInfos latestImplFiles -> + tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile + ] // Get the state at the end of the type-checking of the last file - let finalBoundModel = Array.last computedBoundModels - - let! finalInfo = finalBoundModel.GetOrComputeTcInfo() + let finalInfo = Array.last tcInfos // Finish the checking let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = @@ -934,6 +812,7 @@ module IncrementalBuilderHelpers = errorRecoveryNoRange exn mkSimpleAssemblyRef assemblyName, ProjectAssemblyDataResult.Unavailable true, None + let finalBoundModel = Array.last computedBoundModels let diagnostics = diagnosticsLogger.GetDiagnostics() :: finalInfo.tcDiagnosticsRev let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors @@ -1050,10 +929,10 @@ module IncrementalBuilderStateHelpers = // Used to thread the status of the build in computeStampedFileNames mapFold. type BuildStatus = Invalidated | Good - let createBoundModelGraphNode partialCheck (prevBoundModel: GraphNode) syntaxTree = + let createBoundModelGraphNode (prevBoundModel: GraphNode) syntaxTree = GraphNode(node { let! prevBoundModel = prevBoundModel.GetOrComputeValue() - return! TypeCheckTask partialCheck prevBoundModel syntaxTree + return! prevBoundModel.Next(syntaxTree) }) let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: GraphNode seq) = @@ -1077,13 +956,11 @@ module IncrementalBuilderStateHelpers = else [ for slot in state.slots -> cache.GetFileTimeStamp slot.File.Source.FilePath |> slot.Notify ] - let partialCheck = initialState.enablePartialTypeChecking - - for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate(partialCheck) + for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() let mapping (status, prevNode) slot = let update newStatus = - let boundModel = createBoundModelGraphNode partialCheck prevNode slot.SyntaxTree + let boundModel = createBoundModelGraphNode prevNode slot.SyntaxTree { slot with LogicalStamp = slot.Stamp; Notified = false; BoundModel = boundModel }, (newStatus, boundModel) let noChange = slot, (Good, slot.BoundModel) @@ -1156,7 +1033,7 @@ type IncrementalBuilderState with let boundModels = syntaxTrees - |> Seq.scan (createBoundModelGraphNode initialState.enablePartialTypeChecking) initialBoundModel + |> Seq.scan createBoundModelGraphNode initialBoundModel |> Seq.skip 1 let slots = @@ -1402,7 +1279,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let slot = builder.GetSlotOfFileName(filename) builder.GetLogicalTimeStampForFileInProject(slot) - member builder.GetLogicalTimeStampForFileInProject(slotOfFile: int) = + member _.GetLogicalTimeStampForFileInProject(slotOfFile: int) = let cache = TimeStampCache defaultTimeStamp let tmpState = computeStampedFileNames initialState currentState cache computeProjectTimeStamp tmpState slotOfFile @@ -1675,7 +1552,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc keepAllBackgroundResolutions, keepAllBackgroundSymbolUses, enableBackgroundItemKeyStoreAndSemanticClassification, - enablePartialTypeChecking, beforeFileChecked, fileChecked #if !NO_TYPEPROVIDERS diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 08d071d1334..831c4366615 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -167,7 +167,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 51 + use _ = expectCacheHits 50 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -182,7 +182,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -192,7 +192,7 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = [] let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 6 + use _ = expectCacheHits 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" From 59c3407cfc3b8796be67eaa07b0453b54e7c6f58 Mon Sep 17 00:00:00 2001 From: majocha Date: Mon, 3 Apr 2023 21:06:00 +0200 Subject: [PATCH 36/49] use GraphNode to keep parsing result --- src/Compiler/Driver/ParseAndCheckInputs.fs | 59 ++++---- src/Compiler/Driver/ParseAndCheckInputs.fsi | 2 - src/Compiler/Service/IncrementalBuild.fs | 136 ++++++++---------- .../FSharpChecker/CommonWorkflows.fs | 25 ++-- 4 files changed, 96 insertions(+), 126 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b935ad732bc..8129be0197e 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1205,46 +1205,37 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType /// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. -let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input: ParsedInput) = +let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, tcState, input: ParsedInput) = use _ = - Activity.start "ParseAndCheckInputs.CheckOneInput" [| Activity.Tags.fileName, input.FileName |] + Activity.start "ParseAndCheckInputs.SkippedImplFilePlaceholder" [| Activity.Tags.fileName, input.FileName |] CheckSimulateException tcConfig + let qualNameOfFile = input.QualifiedName - match input with - | ParsedInput.ImplFile file -> - let qualNameOfFile = file.QualifiedName - - // Check if we've got an interface for this fragment - let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile - - // Check if we've already seen an implementation for this fragment - if Zset.contains qualNameOfFile tcState.tcsRootImpls then - errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), input.Range)) - - let hadSig = rootSigOpt.IsSome - - match rootSigOpt with - | Some rootSigTy -> - // Delay the typecheck the implementation file until the second phase of parallel processing. - // Adjust the TcState as if it has been checked, which makes the signature for the file available later - // in the compilation order. - let tcStateForImplFile = tcState - let qualNameOfFile = file.QualifiedName - let amap = tcImports.GetImportMap() - - let ccuSigForFile, tcState = - AddCheckResultsToTcState - (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) - tcState - - let emptyImplFile = - CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + // Check if we've got an interface for this fragment + let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile - let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls - Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + // Check if we've already seen an implementation for this fragment + if Zset.contains qualNameOfFile tcState.tcsRootImpls then + errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), input.Range)) - | _ -> None + match rootSigOpt with + | Some rootSigTy -> + // Delay the typecheck the implementation file until the second phase of parallel processing. + // Adjust the TcState as if it has been checked, which makes the signature for the file available later + // in the compilation order. + let amap = tcImports.GetImportMap() + + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, true, None, TcResultsSink.NoSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) + tcState + + let emptyImplFile = + CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + + let tcEnvAtEnd = tcState.TcEnvFromImpls + Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) | _ -> None /// Typecheck a single file (or interactive entry into F# Interactive). diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 86420344694..0b753c1e0dd 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -139,8 +139,6 @@ val SkippedImplFilePlaceholder: tcConfig: TcConfig * tcImports: TcImports * tcGlobals: TcGlobals * - prefixPathOpt: LongIdent option * - tcSink: NameResolution.TcResultsSink * tcState: TcState * input: ParsedInput -> ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) option diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 960f63aa25d..7909a7ed487 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -102,7 +102,6 @@ type internal FSharpFile = { // This module is only here to contain the SyntaxTree type as to avoid ambiguity with the module FSharp.Compiler.Syntax. [] module IncrementalBuildSyntaxTree = - open System.Runtime.CompilerServices type ParseResult = ParsedInput * range * string * (PhasedDiagnostic * FSharpDiagnosticSeverity) array @@ -113,12 +112,9 @@ module IncrementalBuildSyntaxTree = fileParsed: Event, lexResourceManager, file: FSharpFile, - useCache, - hasSignature + eagerParse ) = - static let cache = ConditionalWeakTable() - let fileName = file.Source.FilePath let sourceRange = file.Range let source = file.Source @@ -139,8 +135,16 @@ module IncrementalBuildSyntaxTree = ) ), sourceRange, fileName, [||] - let getParseTask (source: FSharpSource) = - Threading.Tasks.Task.Run( fun () -> + let parse (source: FSharpSource) = + IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) + use _ = + Activity.start "IncrementalBuildSyntaxTree.parse" + [| + Activity.Tags.fileName, fileName + Activity.Tags.buildPhase, BuildPhase.Parse.ToString() + |] + + try let diagnosticsLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(diagnosticsLogger, BuildPhase.Parse) @@ -157,57 +161,31 @@ module IncrementalBuildSyntaxTree = fileParsed.Trigger fileName input, sourceRange, fileName, diagnosticsLogger.GetDiagnostics() - ) - - let parse (parseTask: Threading.Tasks.Task<_>) = - try - parseTask.Result - with exn -> + with exn -> let msg = sprintf "unexpected failure in SyntaxTree.parse\nerror = %s" (exn.ToString()) System.Diagnostics.Debug.Assert(false, msg) failwith msg - // We control access to the cache to prevent theoretical possibility of starting the same parse job more than once. - // We lock only a single particular cache key, just to start the task, not for the duration of the task. - let getValue source = lock source <| fun () -> cache.GetValue(source, getParseTask) + let resultNode = + if eagerParse then + Threading.Tasks.Task.Run( fun () -> parse source) + |> NodeCode.AwaitTask + |> GraphNode + else + node { return parse source } + |> GraphNode /// Parse the given file and return the given input. - member _.Parse() = - IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBEParsed fileName) - use _ = - Activity.start "IncrementalBuildSyntaxTree.parseOrSkip" - [| - Activity.Tags.fileName, fileName - Activity.Tags.buildPhase, BuildPhase.Parse.ToString() - |] - if useCache then - match cache.TryGetValue source with - | true, result -> - Activity.addEvent Activity.Events.cacheHit - parse result - | _ -> cache.GetValue(source, getParseTask) |> parse - else - getParseTask source |> parse + member val ParseNode : GraphNode = resultNode - member _.HasSignature = hasSignature + member _.Invalidate() = + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, eagerParse) member _.Skip = skippedImplFilePlaceholder - - member _.Invalidate() = - if useCache then - cache.Remove(source) |> ignore - getValue source |> ignore member _.FileName = fileName - member _.IsBackingSignature sigName = SyntaxTree.isBackingSignature fileName sigName - - static member isImplFile fileName = FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) - - static member isBackingSignature fileName sigName = - SyntaxTree.isImplFile fileName && - FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix sigName) && - FileSystemUtils.fileNameWithoutExtension sigName = FileSystemUtils.fileNameWithoutExtension fileName + member _.SourceRange = sourceRange /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] @@ -280,8 +258,8 @@ type BoundModel private ( let getTypeCheck (syntaxTree: SyntaxTree) : TypeCheckNode = node { - use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, syntaxTree.FileName|] - let input, _sourceRange, fileName, parseErrors = syntaxTree.Parse() + let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() + use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") @@ -331,9 +309,9 @@ type BoundModel private ( let skippedImplemetationTypeCheck = match syntaxTreeOpt, prevTcInfo.sigNameOpt with - | Some syntaxTree, Some (_, sigName) when syntaxTree.HasSignature -> - let input, _, fileName, _ = syntaxTree.Skip sigName - SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, None, TcResultsSink.NoSink, prevTcInfo.tcState, input) + | Some syntaxTree, Some (_, qualifiedName) -> + let input, _, fileName, _ = syntaxTree.Skip qualifiedName + SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, prevTcInfo.tcState, input) |> Option.map (fun ((_, topAttribs, _, ccuSigForFile), tcState) -> { tcState = tcState @@ -343,7 +321,7 @@ type BoundModel private ( tcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev topAttribs = Some topAttribs tcDependencyFiles = fileName :: prevTcInfo.tcDependencyFiles - sigNameOpt = Some(fileName, sigName) + sigNameOpt = Some(fileName, qualifiedName) }) | _ -> None @@ -900,7 +878,6 @@ type IncrementalBuilderInitialState = // LogicalStamp represent the stamp of the file that is used to calculate the project's logical timestamp. type Slot = { - File: FSharpFile HasSignature: bool Stamp: DateTime LogicalStamp: DateTime @@ -954,14 +931,20 @@ module IncrementalBuilderStateHelpers = if initialState.useChangeNotifications then state.slots else - [ for slot in state.slots -> cache.GetFileTimeStamp slot.File.Source.FilePath |> slot.Notify ] + [ for slot in state.slots -> cache.GetFileTimeStamp slot.SyntaxTree.FileName |> slot.Notify ] - for slot in slots do if slot.Notified then slot.SyntaxTree.Invalidate() + let slots = + [ for slot in slots do + if slot.Notified then { slot with SyntaxTree = slot.SyntaxTree.Invalidate() } else slot ] let mapping (status, prevNode) slot = let update newStatus = let boundModel = createBoundModelGraphNode prevNode slot.SyntaxTree - { slot with LogicalStamp = slot.Stamp; Notified = false; BoundModel = boundModel }, (newStatus, boundModel) + { slot with + LogicalStamp = slot.Stamp + Notified = false + BoundModel = boundModel }, + (newStatus, boundModel) let noChange = slot, (Good, slot.BoundModel) @@ -977,7 +960,9 @@ module IncrementalBuilderStateHelpers = | slots, (Good, _) -> { state with slots = slots } | slots, (Invalidated, _) -> let boundModels = slots |> Seq.map (fun s -> s.BoundModel) - { state with slots = slots; finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } + { state with + slots = slots + finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() @@ -1013,23 +998,27 @@ type IncrementalBuilderState with *) static member Create(initialState: IncrementalBuilderInitialState) = let defaultTimeStamp = initialState.defaultTimeStamp - let sourceFiles = initialState.fileNames let referencedAssemblies = initialState.referencedAssemblies let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode.FromResult initialState.initialBoundModel + let hasSignature = + let isImplFile fileName = FSharpImplFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) + let isSigFile fileName = FSharpSigFileSuffixes |> List.exists (FileSystemUtils.checkSuffix fileName) + let isBackingSignature fileName sigName = + isImplFile fileName && isSigFile sigName && + FileSystemUtils.fileNameWithoutExtension sigName = FileSystemUtils.fileNameWithoutExtension fileName + [ + false + for prev, file in initialState.fileNames |> List.pairwise do + isBackingSignature file.Source.FilePath prev.Source.FilePath + ] + let syntaxTrees = - let create sourceFile hasSignature = - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, initialState.useSyntaxTreeCache, hasSignature) - match sourceFiles with - | head :: _ -> - create head false :: - [ - for prev, curr in sourceFiles |> List.pairwise do - let hasSignature = SyntaxTree.isBackingSignature curr.Source.FilePath prev.Source.FilePath - create curr hasSignature - ] - | _ -> [] + [ + for sourceFile, canSkip in Seq.zip initialState.fileNames hasSignature -> + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, eagerParse = not canSkip) + ] let boundModels = syntaxTrees @@ -1038,10 +1027,9 @@ type IncrementalBuilderState with let slots = [ - for model, file, syntaxTree in Seq.zip3 boundModels sourceFiles syntaxTrees do + for model, syntaxTree, hasSignature in Seq.zip3 boundModels syntaxTrees hasSignature do { - File = file - HasSignature = syntaxTree.HasSignature + HasSignature = hasSignature Stamp = DateTime.MinValue LogicalStamp = DateTime.MinValue Notified = false @@ -1312,7 +1300,9 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName let syntaxTree = currentState.slots[slotOfFile].SyntaxTree - syntaxTree.Parse() + syntaxTree.ParseNode.GetOrComputeValue() + |> Async.AwaitNodeCode + |> Async.RunSynchronously member builder.NotifyFileChanged(fileName, timeStamp) = node { diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 831c4366615..9e14d4db723 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -12,19 +12,19 @@ open FSharp.Compiler.CodeAnalysis module FcsDiagnostics = FSharp.Compiler.Diagnostics.Activity -let expectCacheHits n = - let events = ResizeArray() +let expectParseCount n = + let mutable count = 0 let listener = new ActivityListener( ShouldListenTo = (fun s -> s.Name = FcsDiagnostics.FscSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> events.AddRange a.Events) + ActivityStopped = (fun a -> if a.OperationName = "IncrementalBuildSyntaxTree.parse" then count <- count + 1) ) ActivitySource.AddActivityListener listener { new IDisposable with member this.Dispose() = listener.Dispose() - Assert.Equal(n, events |> Seq.filter (fun e -> e.Name = FcsDiagnostics.Events.cacheHit) |> Seq.length) } + Assert.Equal(n, count) } let makeTestProject () = SyntheticProject.Create( @@ -167,7 +167,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let middle = $"File%03d{size / 2}" let last = $"File%03d{size}" - use _ = expectCacheHits 50 + use _ = expectParseCount 44 ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged @@ -182,7 +182,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching [] let ``Edit file, check it, then check dependent file with parse caching`` () = - use _ = expectCacheHits 5 + use _ = expectParseCount 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged @@ -191,19 +191,10 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = } [] -let ``Edit file, don't check it, check dependent file with parse caching `` () = - use _ = expectCacheHits 5 +let ``Edit file, don't check it, check dependent file with parse caching`` () = + use _ = expectParseCount 5 ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { updateFile "First" breakDependentFiles saveFile "First" checkFile "Second" expectErrors } - -[] -let ``Parse cache not used when not enabled`` () = - use _ = expectCacheHits 0 - ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = false) { - updateFile "First" breakDependentFiles - saveFile "First" - checkFile "Second" expectErrors - } \ No newline at end of file From e1f5c6e25802fcaf71a28b6046197908da5fcc8f Mon Sep 17 00:00:00 2001 From: majocha Date: Mon, 3 Apr 2023 21:52:15 +0200 Subject: [PATCH 37/49] fantomas --- src/Compiler/Driver/ParseAndCheckInputs.fsi | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 0b753c1e0dd..d31a91c74a2 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -136,11 +136,7 @@ val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv /// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. val SkippedImplFilePlaceholder: - tcConfig: TcConfig * - tcImports: TcImports * - tcGlobals: TcGlobals * - tcState: TcState * - input: ParsedInput -> + tcConfig: TcConfig * tcImports: TcImports * tcGlobals: TcGlobals * tcState: TcState * input: ParsedInput -> ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) option /// Check one input, returned as an Eventually computation From 5af0d9de4ad71e9f6b0270ba933426c422eb3876 Mon Sep 17 00:00:00 2001 From: majocha Date: Mon, 3 Apr 2023 22:43:33 +0200 Subject: [PATCH 38/49] commited too much, fix --- src/Compiler/Driver/ParseAndCheckInputs.fs | 54 +++++++++++++--------- src/Compiler/Service/IncrementalBuild.fs | 15 ++++-- 2 files changed, 41 insertions(+), 28 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 8129be0197e..0d5ca56631d 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1210,32 +1210,40 @@ let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlob Activity.start "ParseAndCheckInputs.SkippedImplFilePlaceholder" [| Activity.Tags.fileName, input.FileName |] CheckSimulateException tcConfig - let qualNameOfFile = input.QualifiedName - // Check if we've got an interface for this fragment - let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile + match input with + | ParsedInput.ImplFile file -> + let qualNameOfFile = file.QualifiedName - // Check if we've already seen an implementation for this fragment - if Zset.contains qualNameOfFile tcState.tcsRootImpls then - errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), input.Range)) + // Check if we've got an interface for this fragment + let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile - match rootSigOpt with - | Some rootSigTy -> - // Delay the typecheck the implementation file until the second phase of parallel processing. - // Adjust the TcState as if it has been checked, which makes the signature for the file available later - // in the compilation order. - let amap = tcImports.GetImportMap() - - let ccuSigForFile, tcState = - AddCheckResultsToTcState - (tcGlobals, amap, true, None, TcResultsSink.NoSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) - tcState - - let emptyImplFile = - CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) - - let tcEnvAtEnd = tcState.TcEnvFromImpls - Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + // Check if we've already seen an implementation for this fragment + if Zset.contains qualNameOfFile tcState.tcsRootImpls then + errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), input.Range)) + + let hadSig = rootSigOpt.IsSome + + match rootSigOpt with + | Some rootSigTy -> + // Delay the typecheck the implementation file until the second phase of parallel processing. + // Adjust the TcState as if it has been checked, which makes the signature for the file available later + // in the compilation order. + let tcStateForImplFile = tcState + let amap = tcImports.GetImportMap() + + let ccuSigForFile, tcState = + AddCheckResultsToTcState + (tcGlobals, amap, hadSig, None, TcResultsSink.NoSink, tcState.tcsTcImplEnv, qualNameOfFile, rootSigTy) + tcState + + let emptyImplFile = + CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) + + let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls + Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + + | _ -> None | _ -> None /// Typecheck a single file (or interactive entry into F# Interactive). diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 7909a7ed487..b6d2668aaad 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -112,6 +112,7 @@ module IncrementalBuildSyntaxTree = fileParsed: Event, lexResourceManager, file: FSharpFile, + hasSignature, eagerParse ) = @@ -179,12 +180,14 @@ module IncrementalBuildSyntaxTree = member val ParseNode : GraphNode = resultNode member _.Invalidate() = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, eagerParse) + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse) member _.Skip = skippedImplFilePlaceholder member _.FileName = fileName + member _.HasSignature = hasSignature + member _.SourceRange = sourceRange /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. @@ -309,7 +312,7 @@ type BoundModel private ( let skippedImplemetationTypeCheck = match syntaxTreeOpt, prevTcInfo.sigNameOpt with - | Some syntaxTree, Some (_, qualifiedName) -> + | Some syntaxTree, Some (_, qualifiedName) when syntaxTree.HasSignature -> let input, _, fileName, _ = syntaxTree.Skip qualifiedName SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, prevTcInfo.tcState, input) |> Option.map (fun ((_, topAttribs, _, ccuSigForFile), tcState) -> @@ -702,7 +705,9 @@ module IncrementalBuilderHelpers = beforeFileChecked, fileChecked, tcInfo, - None) } + None + ) + } /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals partialCheck assemblyName outfile (boundModels: GraphNode seq) = @@ -1016,8 +1021,8 @@ type IncrementalBuilderState with let syntaxTrees = [ - for sourceFile, canSkip in Seq.zip initialState.fileNames hasSignature -> - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, eagerParse = not canSkip) + for sourceFile, hasSignature in Seq.zip initialState.fileNames hasSignature -> + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, eagerParse = not hasSignature) ] let boundModels = From 2b04ab544ff645a5c24aa8403dbc6e6d10b8a0b0 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 00:13:54 +0200 Subject: [PATCH 39/49] fix bug, fix tests --- src/Compiler/Service/IncrementalBuild.fs | 13 +++++++------ .../FSharpChecker/CommonWorkflows.fs | 14 +++++++------- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index b6d2668aaad..1b5ef2c1da6 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -169,7 +169,7 @@ module IncrementalBuildSyntaxTree = let resultNode = if eagerParse then - Threading.Tasks.Task.Run( fun () -> parse source) + Threading.Tasks.Task.Run(fun () -> parse source) |> NodeCode.AwaitTask |> GraphNode else @@ -180,7 +180,7 @@ module IncrementalBuildSyntaxTree = member val ParseNode : GraphNode = resultNode member _.Invalidate() = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse) + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse = false) member _.Skip = skippedImplFilePlaceholder @@ -961,13 +961,14 @@ module IncrementalBuilderStateHelpers = | Good when slot.Notified -> update Invalidated | _ -> noChange - match slots |> List.mapFold mapping (Good, GraphNode.FromResult initialState.initialBoundModel) with - | slots, (Good, _) -> { state with slots = slots } - | slots, (Invalidated, _) -> + if slots |> List.exists (fun s -> s.Notified) then + let slots, _ = slots |> List.mapFold mapping (Good, GraphNode.FromResult initialState.initialBoundModel) let boundModels = slots |> Seq.map (fun s -> s.BoundModel) { state with slots = slots finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels } + else + state and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() @@ -1022,7 +1023,7 @@ type IncrementalBuilderState with let syntaxTrees = [ for sourceFile, hasSignature in Seq.zip initialState.fileNames hasSignature -> - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, eagerParse = not hasSignature) + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, false) ] let boundModels = diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 7a56fcf78e8..284621cb31e 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -19,7 +19,7 @@ let expectParseCount n = new ActivityListener( ShouldListenTo = (fun s -> s.Name = FscActivityNames.FscSourceName), Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStopped = (fun a -> if a.OperationName = "IncrementalBuildSyntaxTree.parse" then count <- count + 1) + ActivityStarted = (fun a -> if a.OperationName = "IncrementalBuildSyntaxTree.parse" then count <- count + 1) ) ActivitySource.AddActivityListener listener { new IDisposable with @@ -151,7 +151,7 @@ let ``Using getSource and notifications instead of filesystem`` () = } [] -let ``Using getSource and notifications instead of filesystem with parse caching`` () = +let ``Using getSource and notifications instead of filesystem, count parses`` () = let size = 20 @@ -169,7 +169,7 @@ let ``Using getSource and notifications instead of filesystem with parse caching let last = $"File%03d{size}" use _ = expectParseCount 44 - ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true, useSyntaxTreeCache = true) { + ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true) { updateFile first updatePublicSurface checkFile first expectSignatureChanged checkFile last expectSignatureChanged @@ -182,9 +182,9 @@ let ``Using getSource and notifications instead of filesystem with parse caching } [] -let ``Edit file, check it, then check dependent file with parse caching`` () = +let ``Edit file, check it, then check dependent file, count parses`` () = use _ = expectParseCount 5 - ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { + ProjectWorkflowBuilder(makeTestProject()) { updateFile "First" breakDependentFiles checkFile "First" expectSignatureChanged saveFile "First" @@ -192,9 +192,9 @@ let ``Edit file, check it, then check dependent file with parse caching`` () = } [] -let ``Edit file, don't check it, check dependent file with parse caching`` () = +let ``Edit file, don't check it, check dependent file, count parses`` () = use _ = expectParseCount 5 - ProjectWorkflowBuilder(makeTestProject(), useSyntaxTreeCache = true) { + ProjectWorkflowBuilder(makeTestProject()) { updateFile "First" breakDependentFiles saveFile "First" checkFile "Second" expectErrors From aeeb9e3204e568cf05538b616993700c182bd086 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 09:40:45 +0200 Subject: [PATCH 40/49] eager parsing --- src/Compiler/Service/IncrementalBuild.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 1b5ef2c1da6..f7b11ecc153 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -180,7 +180,7 @@ module IncrementalBuildSyntaxTree = member val ParseNode : GraphNode = resultNode member _.Invalidate() = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse = false) + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse = not hasSignature) member _.Skip = skippedImplFilePlaceholder @@ -1023,7 +1023,7 @@ type IncrementalBuilderState with let syntaxTrees = [ for sourceFile, hasSignature in Seq.zip initialState.fileNames hasSignature -> - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, false) + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, eagerParse = false) ] let boundModels = From 637e549e7e32905b2895062b952efb91a98e077f Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 10:46:19 +0200 Subject: [PATCH 41/49] not useful and not deterministic --- .../FSharpChecker/CommonWorkflows.fs | 66 ------------------- 1 file changed, 66 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs index 284621cb31e..7aa8dfc25a3 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/CommonWorkflows.fs @@ -10,23 +10,6 @@ open FSharp.Test.ProjectGeneration open FSharp.Compiler.Text open FSharp.Compiler.CodeAnalysis -module FcsDiagnostics = FSharp.Compiler.Diagnostics.Activity -module FscActivityNames = FSharp.Compiler.Diagnostics.ActivityNames - -let expectParseCount n = - let mutable count = 0 - let listener = - new ActivityListener( - ShouldListenTo = (fun s -> s.Name = FscActivityNames.FscSourceName), - Sample = (fun _ -> ActivitySamplingResult.AllData), - ActivityStarted = (fun a -> if a.OperationName = "IncrementalBuildSyntaxTree.parse" then count <- count + 1) - ) - ActivitySource.AddActivityListener listener - { new IDisposable with - member this.Dispose() = - listener.Dispose() - Assert.Equal(n, count) } - let makeTestProject () = SyntheticProject.Create( sourceFile "First" [], @@ -150,52 +133,3 @@ let ``Using getSource and notifications instead of filesystem`` () = checkFile last expectSignatureChanged } -[] -let ``Using getSource and notifications instead of filesystem, count parses`` () = - - let size = 20 - - let project = - { SyntheticProject.Create() with - SourceFiles = [ - sourceFile $"File%03d{0}" [] - for i in 1..size do - sourceFile $"File%03d{i}" [$"File%03d{i-1}"] - ] - } - - let first = "File001" - let middle = $"File%03d{size / 2}" - let last = $"File%03d{size}" - - use _ = expectParseCount 44 - ProjectWorkflowBuilder(project, useGetSource = true, useChangeNotifications = true) { - updateFile first updatePublicSurface - checkFile first expectSignatureChanged - checkFile last expectSignatureChanged - updateFile middle updatePublicSurface - checkFile last expectSignatureChanged - addFileAbove middle (sourceFile "addedFile" [first]) - updateFile middle (addDependency "addedFile") - checkFile middle expectSignatureChanged - checkFile last expectSignatureChanged - } - -[] -let ``Edit file, check it, then check dependent file, count parses`` () = - use _ = expectParseCount 5 - ProjectWorkflowBuilder(makeTestProject()) { - updateFile "First" breakDependentFiles - checkFile "First" expectSignatureChanged - saveFile "First" - checkFile "Second" expectErrors - } - -[] -let ``Edit file, don't check it, check dependent file, count parses`` () = - use _ = expectParseCount 5 - ProjectWorkflowBuilder(makeTestProject()) { - updateFile "First" breakDependentFiles - saveFile "First" - checkFile "Second" expectErrors - } From e5480b57525ef8944c0c98ac9fcb818a811f14eb Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 11:21:22 +0200 Subject: [PATCH 42/49] remove eager parsing --- src/Compiler/Service/IncrementalBuild.fs | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f7b11ecc153..c77c5d2d669 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -112,8 +112,7 @@ module IncrementalBuildSyntaxTree = fileParsed: Event, lexResourceManager, file: FSharpFile, - hasSignature, - eagerParse + hasSignature ) = let fileName = file.Source.FilePath @@ -167,20 +166,11 @@ module IncrementalBuildSyntaxTree = System.Diagnostics.Debug.Assert(false, msg) failwith msg - let resultNode = - if eagerParse then - Threading.Tasks.Task.Run(fun () -> parse source) - |> NodeCode.AwaitTask - |> GraphNode - else - node { return parse source } - |> GraphNode - /// Parse the given file and return the given input. - member val ParseNode : GraphNode = resultNode + member val ParseNode : GraphNode = node { return parse source } |> GraphNode member _.Invalidate() = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature, eagerParse = not hasSignature) + SyntaxTree(tcConfig, fileParsed, lexResourceManager, file, hasSignature) member _.Skip = skippedImplFilePlaceholder @@ -1023,7 +1013,7 @@ type IncrementalBuilderState with let syntaxTrees = [ for sourceFile, hasSignature in Seq.zip initialState.fileNames hasSignature -> - SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature, eagerParse = false) + SyntaxTree(initialState.tcConfig, initialState.fileParsed, initialState.lexResourceManager, sourceFile, hasSignature) ] let boundModels = From 15a3d9483eb9f643da5d2610a3f3fc221be48656 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 15:26:51 +0200 Subject: [PATCH 43/49] oh, well --- .../LegacyLanguageService/Tests.LanguageService.Completion.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index a6202350d0d..e724edbad09 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -4444,7 +4444,7 @@ let x = query { for bbbb in abbbbc(*D0*) do let file3 = OpenFile(project,"File3.fs") TakeCoffeeBreak(this.VS) - gpatcc.AssertExactly(notAA[file2; file3], notAA[file2;file3]) + gpatcc.AssertExactly(notAA[file2], notAA[file2;file3]) /// FEATURE: References added to the project bring corresponding new .NET and F# items into scope. [] From 77ca7db478bf72109510b4d71adf42d428b7607e Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 4 Apr 2023 18:29:12 +0200 Subject: [PATCH 44/49] cleanup --- src/Compiler/Driver/ParseAndCheckInputs.fs | 2 +- src/Compiler/Driver/ParseAndCheckInputs.fsi | 2 +- tests/service/PerfTests.fs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 0d5ca56631d..4b48a89ab71 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1204,7 +1204,7 @@ let AddCheckResultsToTcState type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType -/// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. +/// Returns partial type check result for skipped implementation files. let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlobals, tcState, input: ParsedInput) = use _ = Activity.start "ParseAndCheckInputs.SkippedImplFilePlaceholder" [| Activity.Tags.fileName, input.FileName |] diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index d31a91c74a2..745afa51be4 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -134,7 +134,7 @@ type TcState = /// Get the initial type checking state for a set of inputs val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState -/// Returns empty result for skipped implementation files. This function is used when enablePartialTypeChecking is true. +/// Returns partial type check result for skipped implementation files. val SkippedImplFilePlaceholder: tcConfig: TcConfig * tcImports: TcImports * tcGlobals: TcGlobals * tcState: TcState * input: ParsedInput -> ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) option diff --git a/tests/service/PerfTests.fs b/tests/service/PerfTests.fs index 6d3186400a6..b3c47903283 100644 --- a/tests/service/PerfTests.fs +++ b/tests/service/PerfTests.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.Service.Tests.Common open TestFramework // Create an interactive checker instance -let internal checker = FSharpChecker.Create(useSyntaxTreeCache = false) +let internal checker = FSharpChecker.Create() module internal Project1 = From 144c26fbad9ec80a9623ae90a5e8ee76c6668acb Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 11 Apr 2023 16:09:03 +0200 Subject: [PATCH 45/49] do not compute temp states --- src/Compiler/Service/IncrementalBuild.fs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index c77c5d2d669..10295f36306 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -1125,6 +1125,11 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc do! setCurrentState currentState cache ct } + let checkFileTimeStampsSynchronously cache = + checkFileTimeStamps cache + |> Async.AwaitNodeCode + |> Async.RunSynchronously + do IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBECreated) member _.TcConfig = tcConfig @@ -1180,10 +1185,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member builder.TryGetCheckResultsBeforeFileInProject fileName = let cache = TimeStampCache defaultTimeStamp - let tmpState = computeStampedFileNames initialState currentState cache + checkFileTimeStampsSynchronously cache let slotOfFile = builder.GetSlotOfFileName fileName - match tryGetBeforeSlot tmpState slotOfFile with + match tryGetBeforeSlot currentState slotOfFile with | Some(boundModel, timestamp) -> let projectTimeStamp = builder.GetLogicalTimeStampForFileInProject(fileName) Some (PartialCheckResults (boundModel, timestamp, projectTimeStamp)) @@ -1265,12 +1270,12 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc member _.GetLogicalTimeStampForFileInProject(slotOfFile: int) = let cache = TimeStampCache defaultTimeStamp - let tmpState = computeStampedFileNames initialState currentState cache - computeProjectTimeStamp tmpState slotOfFile + checkFileTimeStampsSynchronously cache + computeProjectTimeStamp currentState slotOfFile member _.GetLogicalTimeStampForProject(cache) = - let tmpState = computeStampedFileNames initialState currentState cache - computeProjectTimeStamp tmpState -1 + checkFileTimeStampsSynchronously cache + computeProjectTimeStamp currentState -1 member _.TryGetSlotOfFileName(fileName: string) = // Get the slot of the given file and force it to build. From 902e2c4d97b2cdf114feb091189bf4e330eba856 Mon Sep 17 00:00:00 2001 From: majocha Date: Tue, 11 Apr 2023 18:34:43 +0200 Subject: [PATCH 46/49] remove private --- src/Compiler/Service/IncrementalBuild.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 10295f36306..31d536d7470 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -226,7 +226,7 @@ type TcInfoExtras = member x.TcSymbolUses = x.tcSymbolUses -module private ValueOption = +module ValueOption = let toOption = function | ValueSome x -> Some x | _ -> None From d9a8def25581ef71691812aff1ab410af7a703ed Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 12 Apr 2023 18:20:41 +0200 Subject: [PATCH 47/49] reclaim type check memory faster --- src/Compiler/Service/IncrementalBuild.fs | 79 ++++++++++++++---------- 1 file changed, 45 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 31d536d7470..cc8d3a8c699 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -231,7 +231,7 @@ module ValueOption = | ValueSome x -> Some x | _ -> None -type private TypeCheckNode = GraphNode +type private TypeCheck = TcInfo * TcResultsSinkImpl * CheckedImplFile option * string /// Bound model of an underlying syntax and typed tree. type BoundModel private ( @@ -249,7 +249,7 @@ type BoundModel private ( ?tcInfoExtrasNodeOpt: GraphNode ) = - let getTypeCheck (syntaxTree: SyntaxTree) : TypeCheckNode = + let getTypeCheck (syntaxTree: SyntaxTree) : NodeCode = node { let! input, _sourceRange, fileName, parseErrors = syntaxTree.ParseNode.GetOrComputeValue() use _ = Activity.start "BoundModel.TypeCheck" [|Activity.Tags.fileName, fileName|] @@ -298,7 +298,7 @@ type BoundModel private ( None } return tcInfo, sink, implFile, fileName - } |> GraphNode + } let skippedImplemetationTypeCheck = match syntaxTreeOpt, prevTcInfo.sigNameOpt with @@ -318,18 +318,12 @@ type BoundModel private ( }) | _ -> None - let getTcInfo (typeCheckNode: TypeCheckNode) = - node { - match skippedImplemetationTypeCheck with - | Some tcInfo -> return tcInfo - | _ -> - let! tcInfo , _, _, _ = typeCheckNode.GetOrComputeValue() - return tcInfo - } |> GraphNode - - let getTcInfoExtras (typeCheckNode: TypeCheckNode) = - node { - let! _ , sink, implFile, fileName = typeCheckNode.GetOrComputeValue() + let getTcInfo (typeCheck: TypeCheck) = + let tcInfo , _, _, _ = typeCheck + tcInfo + + let getTcInfoExtras (typeCheck: TypeCheck) = + let _ , sink, implFile, fileName = typeCheck // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then @@ -354,25 +348,42 @@ type BoundModel private ( res else None, None - - return - { - // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) - tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) - tcOpenDeclarations = sink.GetOpenDeclarations() - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } - } |> GraphNode - - let defaultTypeCheck = GraphNode.FromResult (prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree") - let typeCheck = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck - - member val TcInfo = defaultArg tcInfoOpt (getTcInfo typeCheck) - - member val TcInfoExtras = defaultArg tcInfoExtrasNodeOpt (getTcInfoExtras typeCheck) + + { + // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) + tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) + tcOpenDeclarations = sink.GetOpenDeclarations() + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + + let tcInfo, tcInfoExtras = + let defaultTypeCheck = node { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree" } + let typeCheckNode = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck + + match skippedImplemetationTypeCheck with + | Some info -> + // For skipped implementation sources do full type check only when requested. + let extras = + node { + let! typeCheck = typeCheckNode + return getTcInfoExtras typeCheck + } |> GraphNode + (GraphNode.FromResult info), extras + | _ -> + // compute type check once + let typeCheck = typeCheckNode |> Async.AwaitNodeCode |> Async.RunSynchronously + let tcInfo = GraphNode.FromResult (getTcInfo typeCheck) + let tcInfoExtras = node { return getTcInfoExtras typeCheck } |> GraphNode + // start computing extras, so that typeCheck can be GC'd quickly + tcInfoExtras.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start + tcInfo, tcInfoExtras + + member val TcInfo = defaultArg tcInfoOpt tcInfo + + member val TcInfoExtras = defaultArg tcInfoExtrasNodeOpt tcInfoExtras member _.TcConfig = tcConfig From 1a2ca9e6b4a5f52f8bc414d000b0da891c3eabc6 Mon Sep 17 00:00:00 2001 From: majocha Date: Wed, 12 Apr 2023 21:03:59 +0200 Subject: [PATCH 48/49] dont check when state is given --- src/Compiler/Service/IncrementalBuild.fs | 46 ++++++++++++------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index cc8d3a8c699..80081d64476 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -245,8 +245,7 @@ type BoundModel private ( fileChecked: Event, prevTcInfo: TcInfo, syntaxTreeOpt: SyntaxTree option, - ?tcInfoOpt: GraphNode, - ?tcInfoExtrasNodeOpt: GraphNode + ?tcStateOpt: GraphNode * GraphNode ) = let getTypeCheck (syntaxTree: SyntaxTree) : NodeCode = @@ -362,28 +361,30 @@ type BoundModel private ( let tcInfo, tcInfoExtras = let defaultTypeCheck = node { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree" } let typeCheckNode = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck - - match skippedImplemetationTypeCheck with - | Some info -> - // For skipped implementation sources do full type check only when requested. - let extras = - node { - let! typeCheck = typeCheckNode - return getTcInfoExtras typeCheck - } |> GraphNode - (GraphNode.FromResult info), extras + match tcStateOpt with + | Some tcState -> tcState | _ -> - // compute type check once - let typeCheck = typeCheckNode |> Async.AwaitNodeCode |> Async.RunSynchronously - let tcInfo = GraphNode.FromResult (getTcInfo typeCheck) - let tcInfoExtras = node { return getTcInfoExtras typeCheck } |> GraphNode - // start computing extras, so that typeCheck can be GC'd quickly - tcInfoExtras.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start - tcInfo, tcInfoExtras + match skippedImplemetationTypeCheck with + | Some info -> + // For skipped implementation sources do full type check only when requested. + let extras = + node { + let! typeCheck = typeCheckNode + return getTcInfoExtras typeCheck + } |> GraphNode + GraphNode.FromResult info, extras + | _ -> + // compute type check once + let typeCheck = typeCheckNode |> Async.AwaitNodeCode |> Async.RunSynchronously + let tcInfo = getTcInfo typeCheck |> GraphNode.FromResult + let tcInfoExtras = node { return getTcInfoExtras typeCheck } |> GraphNode + // start computing extras, so that typeCheck can be GC'd quickly + tcInfoExtras.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start + tcInfo, tcInfoExtras - member val TcInfo = defaultArg tcInfoOpt tcInfo + member val TcInfo = tcInfo - member val TcInfoExtras = defaultArg tcInfoExtrasNodeOpt tcInfoExtras + member val TcInfoExtras = tcInfoExtras member _.TcConfig = tcConfig @@ -443,8 +444,7 @@ type BoundModel private ( fileChecked, prevTcInfo, syntaxTreeOpt, - GraphNode.FromResult finishState, - this.TcInfoExtras + (GraphNode.FromResult finishState, this.TcInfoExtras) ) } From 0119b13a3c90d7b1869de02fac9e604592acebda Mon Sep 17 00:00:00 2001 From: majocha Date: Thu, 13 Apr 2023 07:45:45 +0200 Subject: [PATCH 49/49] less ugly --- src/Compiler/Service/IncrementalBuild.fs | 52 +++++++++++------------- 1 file changed, 24 insertions(+), 28 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 80081d64476..4d88e39c428 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -317,12 +317,15 @@ type BoundModel private ( }) | _ -> None - let getTcInfo (typeCheck: TypeCheck) = - let tcInfo , _, _, _ = typeCheck - tcInfo + let getTcInfo (typeCheck: GraphNode) = + node { + let! tcInfo , _, _, _ = typeCheck.GetOrComputeValue() + return tcInfo + } |> GraphNode - let getTcInfoExtras (typeCheck: TypeCheck) = - let _ , sink, implFile, fileName = typeCheck + let getTcInfoExtras (typeCheck: GraphNode) = + node { + let! _ , sink, implFile, fileName = typeCheck.GetOrComputeValue() // Build symbol keys let itemKeyStore, semanticClassification = if enableBackgroundItemKeyStoreAndSemanticClassification then @@ -347,40 +350,33 @@ type BoundModel private ( res else None, None - - { - // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - latestImplFile = if keepAssemblyContents then implFile else None - tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) - tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) - tcOpenDeclarations = sink.GetOpenDeclarations() - itemKeyStore = itemKeyStore - semanticClassificationKeyStore = semanticClassification - } + return + { + // Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away + latestImplFile = if keepAssemblyContents then implFile else None + tcResolutions = (if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty) + tcSymbolUses = (if keepAllBackgroundSymbolUses then sink.GetSymbolUses() else TcSymbolUses.Empty) + tcOpenDeclarations = sink.GetOpenDeclarations() + itemKeyStore = itemKeyStore + semanticClassificationKeyStore = semanticClassification + } + } |> GraphNode let tcInfo, tcInfoExtras = let defaultTypeCheck = node { return prevTcInfo, TcResultsSinkImpl(tcGlobals), None, "default typecheck - no syntaxTree" } - let typeCheckNode = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck + let typeCheckNode = syntaxTreeOpt |> Option.map getTypeCheck |> Option.defaultValue defaultTypeCheck |> GraphNode match tcStateOpt with | Some tcState -> tcState | _ -> match skippedImplemetationTypeCheck with | Some info -> // For skipped implementation sources do full type check only when requested. - let extras = - node { - let! typeCheck = typeCheckNode - return getTcInfoExtras typeCheck - } |> GraphNode - GraphNode.FromResult info, extras + GraphNode.FromResult info, getTcInfoExtras typeCheckNode | _ -> - // compute type check once - let typeCheck = typeCheckNode |> Async.AwaitNodeCode |> Async.RunSynchronously - let tcInfo = getTcInfo typeCheck |> GraphNode.FromResult - let tcInfoExtras = node { return getTcInfoExtras typeCheck } |> GraphNode - // start computing extras, so that typeCheck can be GC'd quickly + let tcInfoExtras = getTcInfoExtras typeCheckNode + // start computing extras, so that typeCheckNode can be GC'd quickly tcInfoExtras.GetOrComputeValue() |> Async.AwaitNodeCode |> Async.Ignore |> Async.Start - tcInfo, tcInfoExtras + getTcInfo typeCheckNode, tcInfoExtras member val TcInfo = tcInfo